![[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] / 43BSDTahoe / new / X / xted|
Return to screen.clu CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / 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.