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