![[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.