![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to x_tcons.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 / CLUlib|
Return to x_tcons.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / CLUlib |
1.1 ! root 1: % Copyright Barbara Liskov 1985, 1986 ! 2: ! 3: x_tcons = proc (name: string, back, border: x_pixmap, spec, defspec: string, ! 4: f: x_font, fwidth, fheight: int, ! 5: add, minwidth, minheight, bwidth: int) ! 6: returns (x_window, int, int) ! 7: zero = char$c2i('0') ! 8: dcount = 2 ! 9: vcount = 1 + (4 * 2 * dcount) ! 10: fcount = 1 + 4 ! 11: root: x_window := x_display$root() ! 12: sw: int := x_display$width() ! 13: sh: int := x_display$height() ! 14: defwidth, defheight, defx, defy: int, defxplus, defyplus, place: bool := ! 15: x_geometry(spec, defspec) ! 16: defwidth := int$max(defwidth, minwidth) ! 17: defheight := int$max(defheight, minheight) ! 18: if place ! 19: then if ~defxplus ! 20: then defx := sw - defx - defwidth * fwidth - 2 * bwidth - add ! 21: end ! 22: if ~defyplus ! 23: then defy := sh - defy - defheight * fheight - 2 * bwidth - add ! 24: end ! 25: x: x_window := x_window$create(defx, defy, ! 26: defwidth * fwidth + add, ! 27: defheight * fheight + add, ! 28: back, root, bwidth, border) ! 29: return(x, defwidth, defheight) ! 30: end ! 31: prog: string := _get_xjname() ! 32: pfont: x_font := x_font$create(x_default(prog, "MakeWindow.BodyFont")) ! 33: except when not_found: pfont := f end ! 34: pfore: int := WhitePixel ! 35: pback: int := BlackPixel ! 36: if x_default(prog, "MakeWindow.ReverseVideo") = "on" ! 37: then pfore := BlackPixel ! 38: pback := WhitePixel ! 39: end except when not_found: end ! 40: bpix: int := pback ! 41: mfore: int := pback ! 42: mback: int := pfore ! 43: pbw: int := int$parse(x_default(prog, "MakeWindow.BorderWidth")) ! 44: except when not_found, overflow, bad_format: pbw := 1 end ! 45: ibw: int := int$parse(x_default(prog, "MakeWindow.InternalBorder")) ! 46: except when not_found, overflow, bad_format: ibw := 1 end ! 47: freeze: bool := x_default(prog, "MakeWindow.Freeze") = "on" ! 48: except when not_found: freeze := false end ! 49: clip: bool := x_default(prog, "MakeWindow.ClipToScreen") = "on" ! 50: except when not_found: clip := false end ! 51: if x_display$cells() > 2 ! 52: then begin ! 53: r, g, b: int := x_parse_color( ! 54: x_default(prog, "MakeWindow.Foreground")) ! 55: pfore := x_display$alloc_color(r, g, b) ! 56: end except others: end ! 57: begin ! 58: r, g, b: int := x_parse_color( ! 59: x_default(prog, "MakeWindow.Background")) ! 60: pback := x_display$alloc_color(r, g, b) ! 61: end except others: end ! 62: begin ! 63: r, g, b: int := x_parse_color( ! 64: x_default(prog, "MakeWindow.Border")) ! 65: bpix := x_display$alloc_color(r, g, b) ! 66: end except others: end ! 67: begin ! 68: r, g, b: int := x_parse_color( ! 69: x_default(prog, "MakeWindow.Mouse")) ! 70: mfore := x_display$alloc_color(r, g, b) ! 71: end except others: end ! 72: begin ! 73: r, g, b: int := x_parse_color( ! 74: x_default(prog, "MakeWindow.MouseMask")) ! 75: mback := x_display$alloc_color(r, g, b) ! 76: end except others: end ! 77: end ! 78: cr: x_cursor := x_cursor$scons(cross_width, cross_height, ! 79: cross, cross_mask, mback, mfore, ! 80: cross_x, cross_y, GXcopy) ! 81: events: int := ButtonPressed + ButtonReleased ! 82: if freeze ! 83: then events := events + MouseMoved end ! 84: while true do ! 85: x_window$grab_mouse(root, events, cr) ! 86: except when error (*): ! 87: sleep(1) ! 88: continue ! 89: end ! 90: break ! 91: end ! 92: fw, fh: int, fc, lc: char, bl: int, fx: bool := x_font$query(pfont) ! 93: nz: int := string$size(name) + 9 ! 94: popw: int := nz * fw + 2 * ibw ! 95: poph: int := fh + 2 * ibw ! 96: count: int := vcount ! 97: save: x_pixmap := x_pixmap$none() ! 98: if freeze ! 99: then x_display$grab() ! 100: count := fcount ! 101: save := x_window$save_region(root, 0, 0, ! 102: popw + 2 * pbw, poph + 2 * pbw) ! 103: except when error (*): end ! 104: end ! 105: backmap: x_pixmap := x_pixmap$tile(pback) ! 106: bdrmap: x_pixmap := x_pixmap$tile(bpix) ! 107: pop: x_window := x_window$create(0, 0, popw, poph, backmap, ! 108: root, pbw, bdrmap) ! 109: x_window$map(pop) ! 110: xadd: int := fwidth / 2 - add ! 111: yadd: int := fheight / 2 - add ! 112: x1, y1: int, bw: x_window := x_window$query_mouse(root) ! 113: box: x_vlist := x_vlist$create(count) ! 114: but: int ! 115: x2: int := x1 + minwidth * fwidth + add + 2 * bwidth - 1 ! 116: y2: int := y1 + minheight * fheight + add + 2 * bwidth - 1 ! 117: chosen: int := -1 ! 118: stop: bool := false ! 119: hsize: int := minwidth ! 120: vsize: int := minheight ! 121: text: _bytevec := _cvt[string, _bytevec](name || ": 000x000") ! 122: changed: bool := true ! 123: xa: int := -1 ! 124: ya: int := -1 ! 125: xb: int := -1 ! 126: yb: int := -1 ! 127: e: event := x_input$empty_event() ! 128: doit: bool := true ! 129: mindim: int := add + 2 * bwidth ! 130: while ~stop do ! 131: if xb ~= int$max(x1, x2) cor yb ~= int$max(y1, y2) cor ! 132: xa ~= int$min(x1, x2) cor ya ~= int$min(y1, y2) ! 133: then if freeze cand ~doit ! 134: then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1) ! 135: end ! 136: xa := int$min(x1, x2) ! 137: ya := int$min(y1, y2) ! 138: xb := int$max(x1, x2) ! 139: yb := int$max(y1, y2) ! 140: for i: int in int$from_to_by(1, count, 4) do ! 141: x_vlist$store(box, i, xa, ya, 0) ! 142: if i = count ! 143: then break end ! 144: x_vlist$store(box, i + 1, xb, ya, 0) ! 145: x_vlist$store(box, i + 2, xb, yb, 0) ! 146: x_vlist$store(box, i + 3, xa, yb, 0) ! 147: end ! 148: doit := true ! 149: end ! 150: if changed ! 151: then changed := false ! 152: text[nz - 6] := char$i2c(hsize / 100 + zero) ! 153: text[nz - 5] := char$i2c((hsize / 10) // 10 + zero) ! 154: text[nz - 4] := char$i2c(hsize // 10 + zero) ! 155: text[nz - 2] := char$i2c(vsize / 100 + zero) ! 156: text[nz - 1] := char$i2c((vsize / 10) // 10 + zero) ! 157: text[nz] := char$i2c(vsize // 10 + zero) ! 158: x_window$text(pop, _cvt[_bytevec, string](text), pfont, ! 159: pfore, pback, ibw, ibw) ! 160: end ! 161: if doit ! 162: then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1) ! 163: doit := ~freeze ! 164: end ! 165: if freeze cor x_input$pending() ! 166: then x_input$deq(e) ! 167: x2 := e.x ! 168: y2 := e.y ! 169: if chosen < 0 cand e.kind = ButtonPressed ! 170: then x1 := x2 ! 171: y1 := y2 ! 172: chosen := e.value ! 173: elseif e.kind = ButtonReleased cand e.value = chosen ! 174: then stop := true ! 175: else x2, y2, bw := x_window$query_mouse(root) end ! 176: else x2, y2, bw := x_window$query_mouse(root) ! 177: end ! 178: if chosen ~= MiddleButton ! 179: then x1 := x2 ! 180: y1 := y2 ! 181: if chosen >= 0 ! 182: then x2 := defwidth ! 183: if chosen = LeftButton ! 184: then y2 := defheight ! 185: else y2 := (sh - mindim - cross_y) / fheight ! 186: end ! 187: if clip ! 188: then x2 := int$min(int$max((sw - x1 - mindim) / fwidth, 0), x2) ! 189: y2 := int$min(int$max((sh - y1 - mindim) / fheight, 0), y2) ! 190: end ! 191: x2 := x1 + x2 * fwidth + add - 1 ! 192: y2 := y1 + y2 * fheight + add - 1 ! 193: end ! 194: end ! 195: d: int := int$max((int$abs(x2 - x1) + xadd) / fwidth, minwidth) ! 196: if d ~= hsize ! 197: then hsize := d ! 198: changed := true ! 199: end ! 200: d := d * fwidth + mindim - 1 ! 201: if x2 < x1 ! 202: then x2 := x1 - d ! 203: else x2 := x1 + d ! 204: end ! 205: d := int$max((int$abs(y2 - y1) + yadd) / fheight, minheight) ! 206: if d ~= vsize ! 207: then vsize := d ! 208: changed := true ! 209: end ! 210: d := d * fheight + mindim - 1 ! 211: if y2 < y1 ! 212: then y2 := y1 - d ! 213: else y2 := y1 + d ! 214: end ! 215: end ! 216: if freeze ! 217: then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1) end ! 218: x_window$ungrab_mouse() ! 219: if save ~= x_pixmap$none() ! 220: then x_window$unmap_transparent(pop) ! 221: x_window$pixmap_put(root, save, 0, 0, popw + 2 * pbw, ! 222: poph + 2 * pbw, 0, 0, GXcopy, -1) ! 223: x_pixmap$destroy(save) ! 224: end ! 225: x_window$destroy(pop) ! 226: if freeze ! 227: then x_display$ungrab() end ! 228: x_cursor$destroy(cr) ! 229: if pfont ~= f ! 230: then x_font$destroy(pfont) end ! 231: x_pixmap$destroy(backmap) ! 232: x_pixmap$destroy(bdrmap) ! 233: w: x_window := x_window$create(int$min(x1, x2), int$min(y1, y2), ! 234: hsize * fwidth + add, vsize * fheight + add, ! 235: back, root, bwidth, border) ! 236: return(w, hsize, vsize) ! 237: end x_tcons
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.