⟦aad80f9c9⟧

TextFile

% Physical screen hacking cluster, for editors, etc.

# extend

screen = cluster is

	% mode changing and initialization functions
	init,			% sets up (first time, or new terminal)
	enter_image_mode,	% set up terminal
	leave_image_mode,	% restores the terminal
	destroy,		% finishes up

	% option setting functions
	set_padding,		% pad output
	set_scroll,		% do scrolling (if poss)
	set_keypad_mode,	% enter/exit alternate keypad mode
	set_highlight,		% underline/invert
	recolor,		% change colors

	% display functions
	clear,			% clear screen and home up
	display_line,		% display a line of an environment
	redisplay_line,		% redisplay line as is
	display_chars,		% display chars at end of line
	update_line,		% update data to correspond with screen
	set_cursor_pos,		% set the cursor position
	get_cursor_pos,		% get the cursor position
	scroll,			% scroll a region
	full_scroll,		% scroll entire screen
	bell,			% bell
	highlight,		% highlight
	redisplay,		% hack redisplay
	unmapped,		% hack icon

	% information returning functions
	position,		% pixel -> char coordinates
	get_padding,		% padding on ?
	get_screen_size,	% returns length and width of screen
	fetch,			% fetch a line
	id_lines_poss,		% ins/del lines possible ?
	scrolling_poss,		% full screen scrolling possible ?
	should_id_lines,	% makes decision about ins/del lines
	should_scroll		% makes decision about scrolling

    ldata = record[line: act,          % screen line, as chars
		   len:  int,          % len of real string
		   lim:  int,          % pos of last non-space char in line
		   str:  string]       % the actual string

    % invariant property of ldatas:
    %	size(line) = hsize - 1
    %	len = _calc_hpos(str, string$size(str) + 1)
    %	lim < i < hsize  =>  line[i] = ' '
    %	the chars in line correspond to the chars in str
    %	the chars in lines[j] correspond to the chars on the
    %	    screen on line j (the presence of an ! determined by len)

    rep     = null
    al      = array[ldata]

    qi      = sequence[int]
    qs      = sequence[string]
    zapc    = array_zap[char]
    shiftc  = array_shift[char]
    shiftl  = array_shift[ldata]
    repll   = array_replace[ldata]

    events = KeyPressed + ButtonPressed + ButtonReleased +
	     ExposeRegion + ExposeCopy + UnmapWindow

    own done: bool := false

    % screen data base

    own lines: al			    % array of line data
    own holder: act			    % for display_line (new line)
    own hlim: int			    % limit for holder
    own temp: al			    % for scrolling
    own xline: act			    % display_chars hack
    own xvpos: int
    own xhpos: int
    own xmpos: int

    own image: bool			    % in image mode?
    own f: x_font
    own fheight: int
    own fwidth: int
    own of: x_font
    own oheight: int
    own owidth: int
    own textpix: int
    own clearpix: int
    own planemask: int
    own nobit: x_bitmap
    own w: x_window
    own ow: x_window
    own mousepix: int
    own mousefunc: int
    own chpos: int
    own cdisp: bool
    own crcols: colordeflist
    own hlcols: colordeflist
    own hlmode: bool
    own high: bool
    own hvpos: int
    own hhpos: int

    % terminal properties

    own vsize: int                          % # of lines (0 to vsize-1)
    own hsize: int                          % # of cols  (0 to hsize-1)
    own vsize1: int                         % vsize-1
    own hsize1: int                         % hsize-1

    % cursor info (-1 means unknown)

    own vpos: int                           % current vertical pos
    own hpos: int                           % current horizontal pos

    init = proc (options: qs)
	if ~done
	   then lines := al$create(0)
		holder := act$create(0)
		hlim := -1
		temp := al$create(0)
		xhpos := 0
		xmpos := -1
		image := false
		display: string := ""
		myname: string := _get_xjname()
		font: string := x_default(myname, "BodyFont")
		   except when not_found: font := "8x13" end
		revvid: bool := x_default(myname, "ReverseVideo") = "on"
		   except when not_found: revvid := false end
		bwidth: int := int$parse(x_default(myname, "BorderWidth"))
		   except when not_found, overflow, bad_format: bwidth := 2 end
		spec: string := "=80x24"
		cfore: string := x_default(myname, "Foreground")
		   except when not_found: cfore := "" end
		cback: string := x_default(myname, "Background")
		   except when not_found: cback := "" end
		ccurs: string := x_default(myname, "Cursor")
		   except when not_found: ccurs := "" end
		chigh: string := x_default(myname, "Highlight")
		   except when not_found: chigh := "" end
		cbdr: string := x_default(myname, "Border")
		   except when not_found: cbdr := "" end
		mfore: string := x_default(myname, "Mouse")
		   except when not_found: mfore := "" end
		mousefunc := int$parse(x_default(myname, "MouseFunction"))
		   except when not_found, overflow, bad_format: mousefunc := GXcopy end
		icon: bool := x_default(myname, "BitmapIcon") = "on"
		   except when not_found: icon := false end
		for opt: string in qs$elements(options) do
		    if opt = "-rv"
		       then revvid := true
		     elseif opt = "-i"
		       then icon := true
		     elseif string$indexs("-fn=", opt) = 1
		       then font := string$rest(opt, 5)
		     elseif string$indexs("-fg=", opt) = 1
		       then cfore := string$rest(opt, 5)
		     elseif string$indexs("-bg=", opt) = 1
		       then cback := string$rest(opt, 5)
		     elseif string$indexs("-cr=", opt) = 1
		       then ccurs := string$rest(opt, 5)
		     elseif string$indexs("-hl=", opt) = 1
		       then chigh := string$rest(opt, 5)
		     elseif string$indexs("-bd=", opt) = 1
		       then cbdr := string$rest(opt, 5)
		     elseif string$indexs("-ms=", opt) = 1
		       then mfore := string$rest(opt, 5)
		     elseif opt[1] = '='
		       then spec := opt
		     else if opt[1] = '-'
			     then opt := string$rest(opt, 2) end
			  if string$indexc(':', opt) ~= 0
			     then display := opt
			     else font := opt
			     end
		     end
		    end
		x_display$init(display)
		   except when error, failure (why: string):
			       _chan$puts(_chan$error_output(), why || "\r\n",
					  false)
			       quit_()
			  end
		f := x_font$create(font)
		   except when error (*):
			       _chan$puts(_chan$error_output(), "bad font\r\n",
					  false)
			       quit_()
			  end
		clearmap, bdrmap: x_pixmap
		if revvid
		   then textpix := WhitePixel
			bdrmap := x_display$white()
			clearpix := BlackPixel
			clearmap := x_display$black()
		   else textpix := BlackPixel
			bdrmap := x_display$black()
			clearpix := WhitePixel
			clearmap := x_display$white()
		   end
		mousepix := textpix
		crcols := colordeflist$new()
		hlcols := colordeflist$new()
		begin
		if x_display$cells() > 2  cand
		   (~string$empty(cfore)  cor  ~string$empty(cback) cor
		    ~string$empty(ccurs)  cor  ~string$empty(chigh))
		   then pixs: pixellist
			if string$empty(ccurs)  cand  string$empty(chigh)
			   then pixs, planemask := x_display$alloc_cells(
						       1, 1, false)
				clearpix := pixs[1]
				textpix := clearpix + planemask
			   else pixs, planemask := x_display$alloc_cells(
						       2, 1, false)
				clearpix := pixs[1]
				textpix := pixs[2]
			   end
			mousepix := textpix
			r, g, b: int
			if string$empty(cback)
			   then r, g, b := x_display$query_color(clearpix)
			   else r, g, b := x_parse_color(cback)
			   end
			x_display$store_color(clearpix, r, g, b)
			if ~string$empty(ccurs)  cor  ~string$empty(chigh)
			   then x_display$store_color(textpix + planemask,
						      r, g, b)
			   end
			clearmap := x_pixmap$tile(clearpix)
			if string$empty(cfore)
			   then r, g, b := x_display$query_color(textpix)
			   else r, g, b := x_parse_color(cfore)
			   end
			x_display$store_color(textpix, r, g, b)
			if ~string$empty(chigh)
			   then hr, hg, hb: int := x_parse_color(chigh)
				colordeflist$addh(hlcols,
						  colordef${pixel: clearpix +
								   planemask,
							    red:   hr,
							    green: hg,
							    blue:  hb})
			   end
			if ~string$empty(ccurs)
			   then r, g, b := x_parse_color(ccurs) end
			colordeflist$addh(crcols,
					  colordef${pixel: clearpix +
							   planemask,
						    red:   r,
						    green: g,
						    blue:  b})
			if ~string$empty(ccurs)  cor  ~string$empty(chigh)
			   then x_display$store_color(clearpix + planemask,
						      r, g, b)
			   end
		   else planemask := 1
		   end
		if x_display$cells() > 2
		   then if ~string$empty(cbdr)
			   then r, g, b: int := x_parse_color(cbdr)
				bdrmap := x_pixmap$tile(x_display$alloc_color(
							    r, g, b))
			   end
			if ~string$empty(mfore)
			   then r, g, b: int := x_parse_color(mfore)
				mousepix := x_display$alloc_color(r, g, b)
			   end
		   end
		end except when undefined, bad_format:
				_chan$puts(_chan$error_output(), "bad color\r\n",
					   false)
				quit_()
			   end
		first, last: char
		base: int
		fixed: bool
		fwidth, fheight, first, last, base, fixed := x_font$query(f)
		w, hsize, vsize := x_tcons(myname, clearmap, bdrmap,
					   spec, "=80x24+1+1",
					   f, fwidth, fheight, 2,
					   6, 6, bwidth)
		if icon
		   then of := x_font$create("nil2")
			owidth, oheight, first, last, base, fixed :=
			    x_font$query(of)
			ow := x_window$create(0, 0, hsize * owidth + 2,
					      vsize * oheight + 2, clearmap,
					      x_display$root(), 2, bdrmap)
			ow.input := events
			w.icon := ow
		   else ow := x_window$none()
		   end except when error (*):
				   _chan$puts(_chan$error_output(), "bad font\r\n",
					      false)
				   quit_()
			      end
		w.name := myname
		x_window$set_resize(w, 2, fwidth, 2, fheight)
		w.input := events - ExposeRegion
		x_window$map(w)
		w.input := events
		new_cursor()
		nobit := x_bitmap$none()
		vsize1 := vsize - 1
		hsize1 := hsize - 1
		chpos := 0
		cdisp := false
		hlmode := false
		high := false
		done := true
	   else leave_image_mode()
	   end
	enter_image_mode()
	end init

    enter_image_mode = proc ()
	if image
	   then return end
	sx, sy, sw, sh, wb, ms, wk: int, iw: x_window := x_window$query(w)
	hsize := int$max((sw + fwidth - 3) / fwidth, 6)
	hsize1 := hsize - 1
	vsize := int$max((sh + fheight - 3) / fheight, 6)
	vsize1 := vsize - 1
	nw: int := hsize * fwidth + 2
	nh: int := vsize * fheight + 2
	if nh ~= sh  cor  nw ~= sw
	   then x_window$change(w, nw, nh)
		if ow ~= x_window$none()
		   then x_window$change(ow, hsize * owidth + 2,
					vsize * oheight + 2)
		   end
	   end
	output$reset()
	vpos := -1        % force positioning
	hpos := -1
	image := true
	end enter_image_mode

    leave_image_mode = proc ()
	if image
	   then input$reset()
		image := false
	   end
	end leave_image_mode

    destroy = proc ()
	leave_image_mode()
	x_window$destroy(w)
	done := false
	end destroy

    set_padding = proc (b: bool)
	end set_padding

    set_scroll = proc (b: bool)
	end set_scroll

    set_keypad_mode = proc (b: bool) returns (bool)
	return(false)
	end set_keypad_mode

    set_highlight = proc (h, b: bool)
	hlmode := b
	if h
	   then w.input := events + MouseMoved
		if ~colordeflist$empty(hlcols)
		   then x_display$store_colors(hlcols) end
	   else w.input := events
		if ~colordeflist$empty(hlcols)
		   then x_display$store_colors(crcols) end
	   end
	end set_highlight

    recolor = proc (white: bool) returns (bool)
	if textpix > WhitePixel
	   then return(false) end
	if white
	   then textpix := BlackPixel
		clearpix := WhitePixel
		w.background := x_display$white()
		w.border := x_display$black()
	   else textpix := WhitePixel
		clearpix := BlackPixel
		w.background := x_display$black()
		w.border := x_display$white()
	   end
	mousepix := textpix
	x_window$clear(w)
	new_cursor()
	return(true)
	end recolor

    clear = proc ()
	ovsize: int := al$size(lines)
	x_window$clear(w)
	x_flush()
	deltav: int := vsize - ovsize
	deltah: int := hsize1 - act$size(holder)
	limit: int := ovsize - 1
	if deltav < 0
	   then limit := vsize1 end
	% clear out char arrays, and auxiliary info
	for i: int in int$from_to(0, limit) do
	    line: ldata := lines[i]
	    lim: int := line.lim
	    chars: act := line.line
	    zapc(chars, 0, lim+1, ' ')
	    if deltah < 0
	       then act$trim(chars, 0, hsize1)
	       else for j: int in int$from_to_by(deltah, 1, -1) do
			act$addh(chars, ' ')
			end
	       end
	    line.lim := -1
	    line.len := 0
	    line.str := ""
	    end
	if deltav < 0
	   then al$trim(lines, 0, vsize)
	   else for i: int in int$from_to_by(deltav, 1, -1) do
		    line: ldata :=
			ldata${line: act$fill(0, hsize1, ' '),
			       lim:  -1,
			       len:  0,
			       str:  ""}
		    al$addh(lines, line)
		    end
	   end
	if deltah < 0
	   then act$trim(holder, 0, hsize1)
		if hlim >= hsize1
		   then hlim := hsize - 2 end
	   else for i: int in int$from_to_by(deltah, 1, -1) do
		    act$addh(holder, ' ')
		    end
	   end
	vpos := -1   % force positioning
	cdisp := false
	set_cursor_pos(0, 0, true)
	end clear

    display_line = proc (s: string, lpos: int) returns (bool) signals (bounds)
	line: ldata := lines[lpos]
	   resignal bounds
	if s = line.str
	   then return(false) end
	if cdisp
	   then forget_cursor() end
	new: act := holder
	nlim, newlen: int := _calc_hpos_copy(s, new)
	if hlim >= newlen
	   then zapc(new, newlen, hlim - newlen + 1, ' ') end
	old: act := line.line
	oldlen: int := line.len
	olim: int := line.lim
	excl: char := ' '
	if oldlen >= hsize
	   then excl := '!' end
	mlim: int := nlim
	mpos: int := _diff_scan(new, old, 0, mlim)
	if hpos ~= mpos cor vpos ~= lpos  cor  cdisp
	   then reposition(lpos, mpos) end
	outa(new, mpos, mlim - mpos + 1)
	hpos := mlim + 1
	mpos := hpos

	if mlim < olim
	   then % keol needed
		vpos := lpos
		hpos := mpos
		chpos := mpos
		if excl = ' '
		   then mlim := olim + 1
		   else mlim := hsize
			excl := ' '
		   end
		clear_region(lpos, mpos, 1, mlim - mpos)
	   end
	dexcl: char := ' '      % desired excl place char
	if newlen >= hsize
	   then dexcl := '!' end
	if dexcl ~= excl
	   then reposition(lpos, hsize1)
		outc(dexcl)
		hpos := hsize
		reposition(lpos, hsize1)
	   end
	holder := old
	hlim := olim
	line.line := new
	line.lim := nlim
	line.len := newlen
	line.str := s
	return(true)
	end display_line

    redisplay_line = proc (lpos: int)
	line: ldata := lines[lpos]
	   except when bounds: return end
	if cdisp
	   then forget_cursor() end
	vpos := -1
	s: string := line.str
	zapc(line.line, 0, hsize1, '\177')
	if line.len >= hsize
	   then line.len := hsize1
	   else line.len := hsize
	   end
	line.lim := hsize1
	line.str := "\177"
	display_line(s, lpos)
	end redisplay_line

    display_chars = proc (nvpos, ohpos, nhpos: int, chars: act, mhpos: int)
	xline := chars
	xvpos := nvpos
	if xhpos > xmpos
	   then xhpos := ohpos end
	xmpos := nhpos
	reposition(nvpos, ohpos)
	outa(chars, ohpos, nhpos - ohpos)
	hpos := nhpos
	if nhpos < mhpos
	   then clear_region(nvpos, nhpos, 1, mhpos - nhpos) end
	display_cursor()
	end display_chars

    update_line = proc (s: string, lpos: int) signals (bounds)
	xmpos := -1
	line: ldata := lines[lpos]
	   resignal bounds
	nlim, newlen: int := _calc_hpos_copy(s, line.line)
	if line.lim >= newlen
	   then zapc(line.line, newlen, line.lim - newlen + 1, ' ') end
	line.lim := nlim
	line.len := newlen
	line.str := s
	end update_line

    reposition = proc (nvpos, nhpos: int)
	if nhpos >= hsize
	   then nhpos := hsize1 end
	if cdisp
	   then forget_cursor() end
	if vpos ~= nvpos cor hpos ~= nhpos
	   then vpos := nvpos
		hpos := nhpos
		chpos := hpos
	   end
	end reposition

    set_cursor_pos = proc (nvpos, nhpos: int, doit: bool)
	if nhpos >= hsize
	   then nhpos := hsize1 end
	if nvpos ~= vpos  cor  nhpos ~= hpos
	   then if cdisp
		   then forget_cursor() end
		vpos := nvpos
		hpos := nhpos
		chpos := hpos
	   end
	if ~cdisp
	   then display_cursor() end
	if doit
	   then x_flush() end
	end set_cursor_pos

    forget_cursor = proc ()
	x_window$pix_fill(w, 0, nobit, 1 + hpos * fwidth, 1 + vpos * fheight,
			  fwidth, fheight, GXinvert, planemask)
	cdisp := false
	end forget_cursor

    display_cursor = proc ()
	x_window$pix_fill(w, 0, nobit, 1 + hpos * fwidth, 1 + vpos * fheight,
			  fwidth, fheight, GXinvert, planemask)
	cdisp := true
	end display_cursor

    get_cursor_pos = proc () returns (int, int)
	return(vpos, hpos)
	end get_cursor_pos

    position = proc (x, y: int) returns (int, int)
	return((x - 1) / fwidth, (y - 1) / fheight)
	end position

    get_padding = proc () returns (bool)
	return(false)
	end get_padding

    get_screen_size = proc () returns (int, int)
	return(vsize, hsize)
	end get_screen_size

    fetch = proc (lpos: int) returns (string) signals (bounds)
	return(lines[lpos].str)
	   resignal bounds
	end fetch

    id_lines_poss = proc () returns (bool)
	return(true)
	end id_lines_poss

    scrolling_poss = proc () returns (bool)
	return(false)
	end scrolling_poss

    should_id_lines = proc (top, bot, delta, num_saved: int) returns (bool)
	return(num_saved > 0)
	end should_id_lines

    scroll = proc (top, bot, delta: int)
	d: int := int$abs(delta)
	topd: int := top + d
	pos: int := bot - d + 1
	numshift: int := pos - top
	input$copy_wait()
	if cdisp
	   then forget_cursor() end
	max: int := 0
	for i: int in int$from_to(top, bot) do
	    line: ldata := lines[i]
	    if lines[i].len >= hsize
	       then max := hsize
		    break
	       end
	    max := int$max(max, line.lim)
	    end
	max := max + 1
	vpos := -1
	if delta < 0
	   then % are scrolling up
		copy_region(topd, 0, top, 0, pos - top, max)
		clear_region(pos, 0, d, max)
		repll(temp, 0, al$size(temp), lines, top, d)
		for ltemp: ldata in al$elements(temp) do
		    zapc(ltemp.line, 0, ltemp.lim+1, ' ')
		    ltemp.lim := -1
		    ltemp.len := 0
		    ltemp.str := ""
		    end
		shiftl(lines, topd, numshift, delta)
		repll(lines, pos, d, temp, 0, d)
	   else % scrolling down
		copy_region(top, 0, topd, 0, pos - top, max)
		clear_region(top, 0, d, max)
		repll(temp, 0, al$size(temp), lines, pos, d)
		for ltemp: ldata in al$elements(temp) do
		    zapc(ltemp.line, 0, ltemp.lim+1, ' ')
		    ltemp.lim := -1
		    ltemp.len := 0
		    ltemp.str := ""
		    end
		shiftl(lines, top, numshift, delta)
		repll(lines, top, d, temp, 0, d)
	   end
	end scroll

    should_scroll = proc (delta, num_saved, num_saved0: int) returns (bool)
		      signals (clear, id_lines)
	return(false)
	end should_scroll

    full_scroll = proc (delta: int) returns (bool)
	return(false)
	end full_scroll

    bell = proc ()
	x_feep(0)
	end bell

    highlight = proc (flag: bool)
	if ~cdisp
	   then return end
	if ~flag
	   then if high
		   then dohigh(vpos, hpos, hvpos, hhpos)
			high := false
		   end
		return
	   end
	h, v: int, sw: x_window := x_window$query_mouse(w)
	h := int$min(int$max(0, (h - 1) / fwidth), hsize)
	v := int$min(int$max(0, (v - 1) / fheight), vsize)
	if h > 0  cand  ~(v = xvpos  cand  xmpos > xhpos  cand  h > xhpos)
	   then l: ldata := lines[v]
		if h < l.len  cand  string$indexc(l.line[h - 1], " ^&!") > 0
		   then i: int := int$max(h + 2, string$size(l.str) + 1)
			oh: int := h
			while true do
			    h := _calc_hpos(l.str, i)
			    if h <= oh
			       then break end
			    i := i - 1
			    end
		   end
	   end except when bounds: end
	if ~high
	   then dohigh(vpos, hpos, v, h)
	 elseif v = hvpos  cand  h = hhpos
	   then return
	 elseif (v > vpos  cor  (v = vpos  cand  h > hpos))  cand
		(hvpos > vpos  cor  (hvpos = vpos  cand  hhpos > hpos))
	   then dohigh(hvpos, hhpos, v, h)
	 elseif (v < vpos  cor  (v = vpos  cand  h < hpos))  cand
		(hvpos < vpos  cor  (hvpos = vpos  cand  hhpos < hpos))
	   then dohigh(v, h, hvpos, hhpos)
	 else dohigh(vpos, hpos, hvpos, hhpos)
	      dohigh(vpos, hpos, v, h)
	 end
	high := true
	hvpos := v
	hhpos := h
	end highlight

    dohigh = proc (v1, h1, v2, h2: int)
	if v1 = v2
	   then if h1 > h2
		   then h1, h2 := h2, h1 end
	 elseif v1 > v2
	   then v1, v2 := v2, v1
		h1, h2 := h2, h1
	 end
	if h1 < 0
	   then h1 := 0
	 elseif h1 > hsize1
	   then v1 := v1 + 1
		h1 := 0
	 end
	if v1 < 0
	   then v1 := 0
		h1 := 0
	 elseif v1 > vsize1
	   then v1 := vsize1
		h1 := hsize1
	 elseif v1 = vpos  cand  h1 = hpos
	   then h1 := h1 + 1 end
	if v2 > vsize1
	   then v2 := vsize1
		h2 := hsize1
	 elseif h2 > hsize
	   then h2 := hsize end
	v: int
	if hlmode
	   then v := 1 + v1 * fheight
	   else v := (v1 + 1) * fheight
	   end
	while v1 < v2 do
	    h: int := lines[v1].len
	    if v1 = xvpos  cand  xmpos > xhpos
	       then h := xmpos end
	    if h1 < h
	       then dohigh1(v, h1, h) end
	    v := v + fheight
	    v1 := v1 + 1
	    h1 := 0
	    end
	h2 := int$min(h2, lines[v2].len)
	if v2 = xvpos  cand  xmpos > xhpos
	   then h2 := xmpos end
	if h1 < h2
	   then dohigh1(v, h1, h2) end
	end dohigh

    dohigh1 = proc (v, h1, h2: int)
	if hlmode
	   then x_window$pix_fill(w, 0, nobit, 1 + h1 * fwidth, v,
				  (h2 - h1) * fwidth, fheight, GXinvert,
				  planemask)
	   else x_window$line(w, 0, 1, 1,
			      1 + h1 * fwidth, v, h2 * fwidth, v, GXinvert,
			      planemask)
	   end
	end dohigh1

    redisplay = proc (win: x_window, x, y, width, height: int)
	if win ~= w
	   then return end
	h1: int := int$max(0, (x - 1) / fwidth)
	h2: int := (x + width - 2) / fwidth
	if h2 < h1
	   then return end
	v1: int := int$max(0, (y - 1) / fheight)
	v2: int := (y + height - 2) / fheight
	if cdisp  cand
	   vpos >= v1  cand  vpos <= v2  cand  hpos >= h1  cand  hpos <= h2
	   then clear_region(vpos, hpos, 1, 1)
		cdisp := false
	   end
	ovpos: int := vpos
	ohpos: int := hpos
	for lpos: int in int$from_to(v1, v2) do
	    line: ldata := lines[lpos]
	    if line.lim < h1
	       then continue end
	    reposition(lpos, h1)
	    outa(line.line, h1, int$min(line.lim, h2) - h1 + 1)
	    if h2 >= hsize1  cand  line.len >= hsize
	       then reposition(lpos, hsize1)
		    outc('!')
	       end
	    end except when bounds: end
	if xmpos > xhpos  cand  xmpos > h1  cand  xhpos <= h2  cand
	   xvpos >= v1  cand  xvpos <= v2
	   then pos: int := int$max(xhpos, h1)
		reposition(xvpos, pos)
		outa(xline, pos, int$min(xmpos - 1, h2) - pos + 1)
	   end
	set_cursor_pos(ovpos, ohpos, true)
	end redisplay

    unmapped = proc (win: x_window)
	if win = w  cand  ow ~= x_window$none()
	   then w, ow := ow, w
		f, of := of, f
		fheight, oheight := oheight, fheight
		fwidth, owidth := owidth, fwidth
		redisplay(w, 1, 1, fwidth * hsize, fheight * vsize)
	   end
	end unmapped

    copy_region = proc (ovpos, ohpos, nvpos, nhpos, height, width: int)
	x_window$move_area(w, 1 + ohpos * fwidth, 1 + ovpos * fheight,
			   width * fwidth, height * fheight,
			   1 + nhpos * fwidth, 1 + nvpos * fheight)
	end copy_region

    clear_region = proc (nvpos, nhpos, height, width: int)
	x_window$pix_set(w, clearpix, 1 + nhpos * fwidth, 1 + nvpos * fheight,
			 width * fwidth, height * fheight)
	end clear_region

    outc = proc (c: char)
	x_window$text(w, string$c2s(c), f, textpix, clearpix,
		      1 + chpos * fwidth, 1 + vpos * fheight)
	chpos := chpos + 1
	end outc

    outa = proc (a: act, i, z: int) signals (bounds, negative_size)
	x_window$texta(w, a, i, z, f, textpix, clearpix,
		       1 + chpos * fwidth, 1 + vpos * fheight)
	chpos := chpos + z
	end outa

    new_cursor = proc ()
	cursbits = "\003\000\005\000\011\000\021\000\041\000\101\000" ||
		   "\201\000\001\001\001\002\301\003\111\000\225\000" ||
		   "\223\000\040\001\040\001\300\000"
	maskbits = "\003\000\007\000\017\000\037\000\077\000\177\000" ||
		   "\377\000\377\001\377\003\377\003\177\000\367\000" ||
		   "\363\000\340\001\340\001\300\000"

	cursor: x_cursor := x_cursor$scons(11, 16,
					   cursbits, maskbits,
					   clearpix, mousepix, 1, 1, mousefunc)
	w.cursor := cursor
	if ow ~= x_window$none()
	   then ow.cursor := cursor end
	x_cursor$destroy(cursor)
	end new_cursor

    end screen
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦aad80f9c9⟧ TextFile

Derivation

TextFile
