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