+% 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
projects / unix-history / commitdiff