![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to screen.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / xted|
Return to screen.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xted |
1.1 root 1: % Physical screen hacking cluster, for editors, etc.
2:
3: # extend
4:
5: screen = cluster is
6:
7: % mode changing and initialization functions
8: init, % sets up (first time, or new terminal)
9: enter_image_mode, % set up terminal
10: leave_image_mode, % restores the terminal
11: destroy, % finishes up
12:
13: % option setting functions
14: set_padding, % pad output
15: set_scroll, % do scrolling (if poss)
16: set_keypad_mode, % enter/exit alternate keypad mode
17: set_highlight, % underline/invert
18: recolor, % change colors
19:
20: % display functions
21: clear, % clear screen and home up
22: display_line, % display a line of an environment
23: redisplay_line, % redisplay line as is
24: display_chars, % display chars at end of line
25: update_line, % update data to correspond with screen
26: set_cursor_pos, % set the cursor position
27: get_cursor_pos, % get the cursor position
28: scroll, % scroll a region
29: full_scroll, % scroll entire screen
30: bell, % bell
31: highlight, % highlight
32: redisplay, % hack redisplay
33: unmapped, % hack icon
34:
35: % information returning functions
36: position, % pixel -> char coordinates
37: get_padding, % padding on ?
38: get_screen_size, % returns length and width of screen
39: fetch, % fetch a line
40: id_lines_poss, % ins/del lines possible ?
41: scrolling_poss, % full screen scrolling possible ?
42: should_id_lines, % makes decision about ins/del lines
43: should_scroll % makes decision about scrolling
44:
45: ldata = record[line: act, % screen line, as chars
46: len: int, % len of real string
47: lim: int, % pos of last non-space char in line
48: str: string] % the actual string
49:
50: % invariant property of ldatas:
51: % size(line) = hsize - 1
52: % len = _calc_hpos(str, string$size(str) + 1)
53: % lim < i < hsize => line[i] = ' '
54: % the chars in line correspond to the chars in str
55: % the chars in lines[j] correspond to the chars on the
56: % screen on line j (the presence of an ! determined by len)
57:
58: rep = null
59: al = array[ldata]
60:
61: qi = sequence[int]
62: qs = sequence[string]
63: zapc = array_zap[char]
64: shiftc = array_shift[char]
65: shiftl = array_shift[ldata]
66: repll = array_replace[ldata]
67:
68: events = KeyPressed + ButtonPressed + ButtonReleased +
69: ExposeRegion + ExposeCopy + UnmapWindow
70:
71: own done: bool := false
72:
73: % screen data base
74:
75: own lines: al % array of line data
76: own holder: act % for display_line (new line)
77: own hlim: int % limit for holder
78: own temp: al % for scrolling
79: own xline: act % display_chars hack
80: own xvpos: int
81: own xhpos: int
82: own xmpos: int
83:
84: own image: bool % in image mode?
85: own f: x_font
86: own fheight: int
87: own fwidth: int
88: own of: x_font
89: own oheight: int
90: own owidth: int
91: own textpix: int
92: own clearpix: int
93: own planemask: int
94: own nobit: x_bitmap
95: own w: x_window
96: own ow: x_window
97: own mousepix: int
98: own mousefunc: int
99: own chpos: int
100: own cdisp: bool
101: own crcols: colordeflist
102: own hlcols: colordeflist
103: own hlmode: bool
104: own high: bool
105: own hvpos: int
106: own hhpos: int
107:
108: % terminal properties
109:
110: own vsize: int % # of lines (0 to vsize-1)
111: own hsize: int % # of cols (0 to hsize-1)
112: own vsize1: int % vsize-1
113: own hsize1: int % hsize-1
114:
115: % cursor info (-1 means unknown)
116:
117: own vpos: int % current vertical pos
118: own hpos: int % current horizontal pos
119:
120: init = proc (options: qs)
121: if ~done
122: then lines := al$create(0)
123: holder := act$create(0)
124: hlim := -1
125: temp := al$create(0)
126: xhpos := 0
127: xmpos := -1
128: image := false
129: display: string := ""
130: myname: string := _get_xjname()
131: font: string := x_default(myname, "BodyFont")
132: except when not_found: font := "8x13" end
133: revvid: bool := x_default(myname, "ReverseVideo") = "on"
134: except when not_found: revvid := false end
135: bwidth: int := int$parse(x_default(myname, "BorderWidth"))
136: except when not_found, overflow, bad_format: bwidth := 2 end
137: spec: string := "=80x24"
138: cfore: string := x_default(myname, "Foreground")
139: except when not_found: cfore := "" end
140: cback: string := x_default(myname, "Background")
141: except when not_found: cback := "" end
142: ccurs: string := x_default(myname, "Cursor")
143: except when not_found: ccurs := "" end
144: chigh: string := x_default(myname, "Highlight")
145: except when not_found: chigh := "" end
146: cbdr: string := x_default(myname, "Border")
147: except when not_found: cbdr := "" end
148: mfore: string := x_default(myname, "Mouse")
149: except when not_found: mfore := "" end
150: mousefunc := int$parse(x_default(myname, "MouseFunction"))
151: except when not_found, overflow, bad_format: mousefunc := GXcopy end
152: icon: bool := x_default(myname, "BitmapIcon") = "on"
153: except when not_found: icon := false end
154: for opt: string in qs$elements(options) do
155: if opt = "-rv"
156: then revvid := true
157: elseif opt = "-i"
158: then icon := true
159: elseif string$indexs("-fn=", opt) = 1
160: then font := string$rest(opt, 5)
161: elseif string$indexs("-fg=", opt) = 1
162: then cfore := string$rest(opt, 5)
163: elseif string$indexs("-bg=", opt) = 1
164: then cback := string$rest(opt, 5)
165: elseif string$indexs("-cr=", opt) = 1
166: then ccurs := string$rest(opt, 5)
167: elseif string$indexs("-hl=", opt) = 1
168: then chigh := string$rest(opt, 5)
169: elseif string$indexs("-bd=", opt) = 1
170: then cbdr := string$rest(opt, 5)
171: elseif string$indexs("-ms=", opt) = 1
172: then mfore := string$rest(opt, 5)
173: elseif opt[1] = '='
174: then spec := opt
175: else if opt[1] = '-'
176: then opt := string$rest(opt, 2) end
177: if string$indexc(':', opt) ~= 0
178: then display := opt
179: else font := opt
180: end
181: end
182: end
183: x_display$init(display)
184: except when error, failure (why: string):
185: _chan$puts(_chan$error_output(), why || "\r\n",
186: false)
187: quit_()
188: end
189: f := x_font$create(font)
190: except when error (*):
191: _chan$puts(_chan$error_output(), "bad font\r\n",
192: false)
193: quit_()
194: end
195: clearmap, bdrmap: x_pixmap
196: if revvid
197: then textpix := WhitePixel
198: bdrmap := x_display$white()
199: clearpix := BlackPixel
200: clearmap := x_display$black()
201: else textpix := BlackPixel
202: bdrmap := x_display$black()
203: clearpix := WhitePixel
204: clearmap := x_display$white()
205: end
206: mousepix := textpix
207: crcols := colordeflist$new()
208: hlcols := colordeflist$new()
209: begin
210: if x_display$cells() > 2 cand
211: (~string$empty(cfore) cor ~string$empty(cback) cor
212: ~string$empty(ccurs) cor ~string$empty(chigh))
213: then pixs: pixellist
214: if string$empty(ccurs) cand string$empty(chigh)
215: then pixs, planemask := x_display$alloc_cells(
216: 1, 1, false)
217: clearpix := pixs[1]
218: textpix := clearpix + planemask
219: else pixs, planemask := x_display$alloc_cells(
220: 2, 1, false)
221: clearpix := pixs[1]
222: textpix := pixs[2]
223: end
224: mousepix := textpix
225: r, g, b: int
226: if string$empty(cback)
227: then r, g, b := x_display$query_color(clearpix)
228: else r, g, b := x_parse_color(cback)
229: end
230: x_display$store_color(clearpix, r, g, b)
231: if ~string$empty(ccurs) cor ~string$empty(chigh)
232: then x_display$store_color(textpix + planemask,
233: r, g, b)
234: end
235: clearmap := x_pixmap$tile(clearpix)
236: if string$empty(cfore)
237: then r, g, b := x_display$query_color(textpix)
238: else r, g, b := x_parse_color(cfore)
239: end
240: x_display$store_color(textpix, r, g, b)
241: if ~string$empty(chigh)
242: then hr, hg, hb: int := x_parse_color(chigh)
243: colordeflist$addh(hlcols,
244: colordef${pixel: clearpix +
245: planemask,
246: red: hr,
247: green: hg,
248: blue: hb})
249: end
250: if ~string$empty(ccurs)
251: then r, g, b := x_parse_color(ccurs) end
252: colordeflist$addh(crcols,
253: colordef${pixel: clearpix +
254: planemask,
255: red: r,
256: green: g,
257: blue: b})
258: if ~string$empty(ccurs) cor ~string$empty(chigh)
259: then x_display$store_color(clearpix + planemask,
260: r, g, b)
261: end
262: else planemask := 1
263: end
264: if x_display$cells() > 2
265: then if ~string$empty(cbdr)
266: then r, g, b: int := x_parse_color(cbdr)
267: bdrmap := x_pixmap$tile(x_display$alloc_color(
268: r, g, b))
269: end
270: if ~string$empty(mfore)
271: then r, g, b: int := x_parse_color(mfore)
272: mousepix := x_display$alloc_color(r, g, b)
273: end
274: end
275: end except when undefined, bad_format:
276: _chan$puts(_chan$error_output(), "bad color\r\n",
277: false)
278: quit_()
279: end
280: first, last: char
281: base: int
282: fixed: bool
283: fwidth, fheight, first, last, base, fixed := x_font$query(f)
284: w, hsize, vsize := x_tcons(myname, clearmap, bdrmap,
285: spec, "=80x24+1+1",
286: f, fwidth, fheight, 2,
287: 6, 6, bwidth)
288: if icon
289: then of := x_font$create("nil2")
290: owidth, oheight, first, last, base, fixed :=
291: x_font$query(of)
292: ow := x_window$create(0, 0, hsize * owidth + 2,
293: vsize * oheight + 2, clearmap,
294: x_display$root(), 2, bdrmap)
295: ow.input := events
296: w.icon := ow
297: else ow := x_window$none()
298: end except when error (*):
299: _chan$puts(_chan$error_output(), "bad font\r\n",
300: false)
301: quit_()
302: end
303: w.name := myname
304: x_window$set_resize(w, 2, fwidth, 2, fheight)
305: w.input := events - ExposeRegion
306: x_window$map(w)
307: w.input := events
308: new_cursor()
309: nobit := x_bitmap$none()
310: vsize1 := vsize - 1
311: hsize1 := hsize - 1
312: chpos := 0
313: cdisp := false
314: hlmode := false
315: high := false
316: done := true
317: else leave_image_mode()
318: end
319: enter_image_mode()
320: end init
321:
322: enter_image_mode = proc ()
323: if image
324: then return end
325: sx, sy, sw, sh, wb, ms, wk: int, iw: x_window := x_window$query(w)
326: hsize := int$max((sw + fwidth - 3) / fwidth, 6)
327: hsize1 := hsize - 1
328: vsize := int$max((sh + fheight - 3) / fheight, 6)
329: vsize1 := vsize - 1
330: nw: int := hsize * fwidth + 2
331: nh: int := vsize * fheight + 2
332: if nh ~= sh cor nw ~= sw
333: then x_window$change(w, nw, nh)
334: if ow ~= x_window$none()
335: then x_window$change(ow, hsize * owidth + 2,
336: vsize * oheight + 2)
337: end
338: end
339: output$reset()
340: vpos := -1 % force positioning
341: hpos := -1
342: image := true
343: end enter_image_mode
344:
345: leave_image_mode = proc ()
346: if image
347: then input$reset()
348: image := false
349: end
350: end leave_image_mode
351:
352: destroy = proc ()
353: leave_image_mode()
354: x_window$destroy(w)
355: done := false
356: end destroy
357:
358: set_padding = proc (b: bool)
359: end set_padding
360:
361: set_scroll = proc (b: bool)
362: end set_scroll
363:
364: set_keypad_mode = proc (b: bool) returns (bool)
365: return(false)
366: end set_keypad_mode
367:
368: set_highlight = proc (h, b: bool)
369: hlmode := b
370: if h
371: then w.input := events + MouseMoved
372: if ~colordeflist$empty(hlcols)
373: then x_display$store_colors(hlcols) end
374: else w.input := events
375: if ~colordeflist$empty(hlcols)
376: then x_display$store_colors(crcols) end
377: end
378: end set_highlight
379:
380: recolor = proc (white: bool) returns (bool)
381: if textpix > WhitePixel
382: then return(false) end
383: if white
384: then textpix := BlackPixel
385: clearpix := WhitePixel
386: w.background := x_display$white()
387: w.border := x_display$black()
388: else textpix := WhitePixel
389: clearpix := BlackPixel
390: w.background := x_display$black()
391: w.border := x_display$white()
392: end
393: mousepix := textpix
394: x_window$clear(w)
395: new_cursor()
396: return(true)
397: end recolor
398:
399: clear = proc ()
400: ovsize: int := al$size(lines)
401: x_window$clear(w)
402: x_flush()
403: deltav: int := vsize - ovsize
404: deltah: int := hsize1 - act$size(holder)
405: limit: int := ovsize - 1
406: if deltav < 0
407: then limit := vsize1 end
408: % clear out char arrays, and auxiliary info
409: for i: int in int$from_to(0, limit) do
410: line: ldata := lines[i]
411: lim: int := line.lim
412: chars: act := line.line
413: zapc(chars, 0, lim+1, ' ')
414: if deltah < 0
415: then act$trim(chars, 0, hsize1)
416: else for j: int in int$from_to_by(deltah, 1, -1) do
417: act$addh(chars, ' ')
418: end
419: end
420: line.lim := -1
421: line.len := 0
422: line.str := ""
423: end
424: if deltav < 0
425: then al$trim(lines, 0, vsize)
426: else for i: int in int$from_to_by(deltav, 1, -1) do
427: line: ldata :=
428: ldata${line: act$fill(0, hsize1, ' '),
429: lim: -1,
430: len: 0,
431: str: ""}
432: al$addh(lines, line)
433: end
434: end
435: if deltah < 0
436: then act$trim(holder, 0, hsize1)
437: if hlim >= hsize1
438: then hlim := hsize - 2 end
439: else for i: int in int$from_to_by(deltah, 1, -1) do
440: act$addh(holder, ' ')
441: end
442: end
443: vpos := -1 % force positioning
444: cdisp := false
445: set_cursor_pos(0, 0, true)
446: end clear
447:
448: display_line = proc (s: string, lpos: int) returns (bool) signals (bounds)
449: line: ldata := lines[lpos]
450: resignal bounds
451: if s = line.str
452: then return(false) end
453: if cdisp
454: then forget_cursor() end
455: new: act := holder
456: nlim, newlen: int := _calc_hpos_copy(s, new)
457: if hlim >= newlen
458: then zapc(new, newlen, hlim - newlen + 1, ' ') end
459: old: act := line.line
460: oldlen: int := line.len
461: olim: int := line.lim
462: excl: char := ' '
463: if oldlen >= hsize
464: then excl := '!' end
465: mlim: int := nlim
466: mpos: int := _diff_scan(new, old, 0, mlim)
467: if hpos ~= mpos cor vpos ~= lpos cor cdisp
468: then reposition(lpos, mpos) end
469: outa(new, mpos, mlim - mpos + 1)
470: hpos := mlim + 1
471: mpos := hpos
472:
473: if mlim < olim
474: then % keol needed
475: vpos := lpos
476: hpos := mpos
477: chpos := mpos
478: if excl = ' '
479: then mlim := olim + 1
480: else mlim := hsize
481: excl := ' '
482: end
483: clear_region(lpos, mpos, 1, mlim - mpos)
484: end
485: dexcl: char := ' ' % desired excl place char
486: if newlen >= hsize
487: then dexcl := '!' end
488: if dexcl ~= excl
489: then reposition(lpos, hsize1)
490: outc(dexcl)
491: hpos := hsize
492: reposition(lpos, hsize1)
493: end
494: holder := old
495: hlim := olim
496: line.line := new
497: line.lim := nlim
498: line.len := newlen
499: line.str := s
500: return(true)
501: end display_line
502:
503: redisplay_line = proc (lpos: int)
504: line: ldata := lines[lpos]
505: except when bounds: return end
506: if cdisp
507: then forget_cursor() end
508: vpos := -1
509: s: string := line.str
510: zapc(line.line, 0, hsize1, '\177')
511: if line.len >= hsize
512: then line.len := hsize1
513: else line.len := hsize
514: end
515: line.lim := hsize1
516: line.str := "\177"
517: display_line(s, lpos)
518: end redisplay_line
519:
520: display_chars = proc (nvpos, ohpos, nhpos: int, chars: act, mhpos: int)
521: xline := chars
522: xvpos := nvpos
523: if xhpos > xmpos
524: then xhpos := ohpos end
525: xmpos := nhpos
526: reposition(nvpos, ohpos)
527: outa(chars, ohpos, nhpos - ohpos)
528: hpos := nhpos
529: if nhpos < mhpos
530: then clear_region(nvpos, nhpos, 1, mhpos - nhpos) end
531: display_cursor()
532: end display_chars
533:
534: update_line = proc (s: string, lpos: int) signals (bounds)
535: xmpos := -1
536: line: ldata := lines[lpos]
537: resignal bounds
538: nlim, newlen: int := _calc_hpos_copy(s, line.line)
539: if line.lim >= newlen
540: then zapc(line.line, newlen, line.lim - newlen + 1, ' ') end
541: line.lim := nlim
542: line.len := newlen
543: line.str := s
544: end update_line
545:
546: reposition = proc (nvpos, nhpos: int)
547: if nhpos >= hsize
548: then nhpos := hsize1 end
549: if cdisp
550: then forget_cursor() end
551: if vpos ~= nvpos cor hpos ~= nhpos
552: then vpos := nvpos
553: hpos := nhpos
554: chpos := hpos
555: end
556: end reposition
557:
558: set_cursor_pos = proc (nvpos, nhpos: int, doit: bool)
559: if nhpos >= hsize
560: then nhpos := hsize1 end
561: if nvpos ~= vpos cor nhpos ~= hpos
562: then if cdisp
563: then forget_cursor() end
564: vpos := nvpos
565: hpos := nhpos
566: chpos := hpos
567: end
568: if ~cdisp
569: then display_cursor() end
570: if doit
571: then x_flush() end
572: end set_cursor_pos
573:
574: forget_cursor = proc ()
575: x_window$pix_fill(w, 0, nobit, 1 + hpos * fwidth, 1 + vpos * fheight,
576: fwidth, fheight, GXinvert, planemask)
577: cdisp := false
578: end forget_cursor
579:
580: display_cursor = proc ()
581: x_window$pix_fill(w, 0, nobit, 1 + hpos * fwidth, 1 + vpos * fheight,
582: fwidth, fheight, GXinvert, planemask)
583: cdisp := true
584: end display_cursor
585:
586: get_cursor_pos = proc () returns (int, int)
587: return(vpos, hpos)
588: end get_cursor_pos
589:
590: position = proc (x, y: int) returns (int, int)
591: return((x - 1) / fwidth, (y - 1) / fheight)
592: end position
593:
594: get_padding = proc () returns (bool)
595: return(false)
596: end get_padding
597:
598: get_screen_size = proc () returns (int, int)
599: return(vsize, hsize)
600: end get_screen_size
601:
602: fetch = proc (lpos: int) returns (string) signals (bounds)
603: return(lines[lpos].str)
604: resignal bounds
605: end fetch
606:
607: id_lines_poss = proc () returns (bool)
608: return(true)
609: end id_lines_poss
610:
611: scrolling_poss = proc () returns (bool)
612: return(false)
613: end scrolling_poss
614:
615: should_id_lines = proc (top, bot, delta, num_saved: int) returns (bool)
616: return(num_saved > 0)
617: end should_id_lines
618:
619: scroll = proc (top, bot, delta: int)
620: d: int := int$abs(delta)
621: topd: int := top + d
622: pos: int := bot - d + 1
623: numshift: int := pos - top
624: input$copy_wait()
625: if cdisp
626: then forget_cursor() end
627: max: int := 0
628: for i: int in int$from_to(top, bot) do
629: line: ldata := lines[i]
630: if lines[i].len >= hsize
631: then max := hsize
632: break
633: end
634: max := int$max(max, line.lim)
635: end
636: max := max + 1
637: vpos := -1
638: if delta < 0
639: then % are scrolling up
640: copy_region(topd, 0, top, 0, pos - top, max)
641: clear_region(pos, 0, d, max)
642: repll(temp, 0, al$size(temp), lines, top, d)
643: for ltemp: ldata in al$elements(temp) do
644: zapc(ltemp.line, 0, ltemp.lim+1, ' ')
645: ltemp.lim := -1
646: ltemp.len := 0
647: ltemp.str := ""
648: end
649: shiftl(lines, topd, numshift, delta)
650: repll(lines, pos, d, temp, 0, d)
651: else % scrolling down
652: copy_region(top, 0, topd, 0, pos - top, max)
653: clear_region(top, 0, d, max)
654: repll(temp, 0, al$size(temp), lines, pos, d)
655: for ltemp: ldata in al$elements(temp) do
656: zapc(ltemp.line, 0, ltemp.lim+1, ' ')
657: ltemp.lim := -1
658: ltemp.len := 0
659: ltemp.str := ""
660: end
661: shiftl(lines, top, numshift, delta)
662: repll(lines, top, d, temp, 0, d)
663: end
664: end scroll
665:
666: should_scroll = proc (delta, num_saved, num_saved0: int) returns (bool)
667: signals (clear, id_lines)
668: return(false)
669: end should_scroll
670:
671: full_scroll = proc (delta: int) returns (bool)
672: return(false)
673: end full_scroll
674:
675: bell = proc ()
676: x_feep(0)
677: end bell
678:
679: highlight = proc (flag: bool)
680: if ~cdisp
681: then return end
682: if ~flag
683: then if high
684: then dohigh(vpos, hpos, hvpos, hhpos)
685: high := false
686: end
687: return
688: end
689: h, v: int, sw: x_window := x_window$query_mouse(w)
690: h := int$min(int$max(0, (h - 1) / fwidth), hsize)
691: v := int$min(int$max(0, (v - 1) / fheight), vsize)
692: if h > 0 cand ~(v = xvpos cand xmpos > xhpos cand h > xhpos)
693: then l: ldata := lines[v]
694: if h < l.len cand string$indexc(l.line[h - 1], " ^&!") > 0
695: then i: int := int$max(h + 2, string$size(l.str) + 1)
696: oh: int := h
697: while true do
698: h := _calc_hpos(l.str, i)
699: if h <= oh
700: then break end
701: i := i - 1
702: end
703: end
704: end except when bounds: end
705: if ~high
706: then dohigh(vpos, hpos, v, h)
707: elseif v = hvpos cand h = hhpos
708: then return
709: elseif (v > vpos cor (v = vpos cand h > hpos)) cand
710: (hvpos > vpos cor (hvpos = vpos cand hhpos > hpos))
711: then dohigh(hvpos, hhpos, v, h)
712: elseif (v < vpos cor (v = vpos cand h < hpos)) cand
713: (hvpos < vpos cor (hvpos = vpos cand hhpos < hpos))
714: then dohigh(v, h, hvpos, hhpos)
715: else dohigh(vpos, hpos, hvpos, hhpos)
716: dohigh(vpos, hpos, v, h)
717: end
718: high := true
719: hvpos := v
720: hhpos := h
721: end highlight
722:
723: dohigh = proc (v1, h1, v2, h2: int)
724: if v1 = v2
725: then if h1 > h2
726: then h1, h2 := h2, h1 end
727: elseif v1 > v2
728: then v1, v2 := v2, v1
729: h1, h2 := h2, h1
730: end
731: if h1 < 0
732: then h1 := 0
733: elseif h1 > hsize1
734: then v1 := v1 + 1
735: h1 := 0
736: end
737: if v1 < 0
738: then v1 := 0
739: h1 := 0
740: elseif v1 > vsize1
741: then v1 := vsize1
742: h1 := hsize1
743: elseif v1 = vpos cand h1 = hpos
744: then h1 := h1 + 1 end
745: if v2 > vsize1
746: then v2 := vsize1
747: h2 := hsize1
748: elseif h2 > hsize
749: then h2 := hsize end
750: v: int
751: if hlmode
752: then v := 1 + v1 * fheight
753: else v := (v1 + 1) * fheight
754: end
755: while v1 < v2 do
756: h: int := lines[v1].len
757: if v1 = xvpos cand xmpos > xhpos
758: then h := xmpos end
759: if h1 < h
760: then dohigh1(v, h1, h) end
761: v := v + fheight
762: v1 := v1 + 1
763: h1 := 0
764: end
765: h2 := int$min(h2, lines[v2].len)
766: if v2 = xvpos cand xmpos > xhpos
767: then h2 := xmpos end
768: if h1 < h2
769: then dohigh1(v, h1, h2) end
770: end dohigh
771:
772: dohigh1 = proc (v, h1, h2: int)
773: if hlmode
774: then x_window$pix_fill(w, 0, nobit, 1 + h1 * fwidth, v,
775: (h2 - h1) * fwidth, fheight, GXinvert,
776: planemask)
777: else x_window$line(w, 0, 1, 1,
778: 1 + h1 * fwidth, v, h2 * fwidth, v, GXinvert,
779: planemask)
780: end
781: end dohigh1
782:
783: redisplay = proc (win: x_window, x, y, width, height: int)
784: if win ~= w
785: then return end
786: h1: int := int$max(0, (x - 1) / fwidth)
787: h2: int := (x + width - 2) / fwidth
788: if h2 < h1
789: then return end
790: v1: int := int$max(0, (y - 1) / fheight)
791: v2: int := (y + height - 2) / fheight
792: if cdisp cand
793: vpos >= v1 cand vpos <= v2 cand hpos >= h1 cand hpos <= h2
794: then clear_region(vpos, hpos, 1, 1)
795: cdisp := false
796: end
797: ovpos: int := vpos
798: ohpos: int := hpos
799: for lpos: int in int$from_to(v1, v2) do
800: line: ldata := lines[lpos]
801: if line.lim < h1
802: then continue end
803: reposition(lpos, h1)
804: outa(line.line, h1, int$min(line.lim, h2) - h1 + 1)
805: if h2 >= hsize1 cand line.len >= hsize
806: then reposition(lpos, hsize1)
807: outc('!')
808: end
809: end except when bounds: end
810: if xmpos > xhpos cand xmpos > h1 cand xhpos <= h2 cand
811: xvpos >= v1 cand xvpos <= v2
812: then pos: int := int$max(xhpos, h1)
813: reposition(xvpos, pos)
814: outa(xline, pos, int$min(xmpos - 1, h2) - pos + 1)
815: end
816: set_cursor_pos(ovpos, ohpos, true)
817: end redisplay
818:
819: unmapped = proc (win: x_window)
820: if win = w cand ow ~= x_window$none()
821: then w, ow := ow, w
822: f, of := of, f
823: fheight, oheight := oheight, fheight
824: fwidth, owidth := owidth, fwidth
825: redisplay(w, 1, 1, fwidth * hsize, fheight * vsize)
826: end
827: end unmapped
828:
829: copy_region = proc (ovpos, ohpos, nvpos, nhpos, height, width: int)
830: x_window$move_area(w, 1 + ohpos * fwidth, 1 + ovpos * fheight,
831: width * fwidth, height * fheight,
832: 1 + nhpos * fwidth, 1 + nvpos * fheight)
833: end copy_region
834:
835: clear_region = proc (nvpos, nhpos, height, width: int)
836: x_window$pix_set(w, clearpix, 1 + nhpos * fwidth, 1 + nvpos * fheight,
837: width * fwidth, height * fheight)
838: end clear_region
839:
840: outc = proc (c: char)
841: x_window$text(w, string$c2s(c), f, textpix, clearpix,
842: 1 + chpos * fwidth, 1 + vpos * fheight)
843: chpos := chpos + 1
844: end outc
845:
846: outa = proc (a: act, i, z: int) signals (bounds, negative_size)
847: x_window$texta(w, a, i, z, f, textpix, clearpix,
848: 1 + chpos * fwidth, 1 + vpos * fheight)
849: chpos := chpos + z
850: end outa
851:
852: new_cursor = proc ()
853: cursbits = "\003\000\005\000\011\000\021\000\041\000\101\000" ||
854: "\201\000\001\001\001\002\301\003\111\000\225\000" ||
855: "\223\000\040\001\040\001\300\000"
856: maskbits = "\003\000\007\000\017\000\037\000\077\000\177\000" ||
857: "\377\000\377\001\377\003\377\003\177\000\367\000" ||
858: "\363\000\340\001\340\001\300\000"
859:
860: cursor: x_cursor := x_cursor$scons(11, 16,
861: cursbits, maskbits,
862: clearpix, mousepix, 1, 1, mousefunc)
863: w.cursor := cursor
864: if ow ~= x_window$none()
865: then ow.cursor := cursor end
866: x_cursor$destroy(cursor)
867: end new_cursor
868:
869: end screen
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.