4.3BSD/usr/contrib/X/CLUlib/x_tcons.clu
% Copyright Barbara Liskov 1985, 1986
x_tcons = proc (name: string, back, border: x_pixmap, spec, defspec: string,
f: x_font, fwidth, fheight: int,
add, minwidth, minheight, bwidth: int)
returns (x_window, int, int)
zero = char$c2i('0')
dcount = 2
vcount = 1 + (4 * 2 * dcount)
fcount = 1 + 4
root: x_window := x_display$root()
sw: int := x_display$width()
sh: int := x_display$height()
defwidth, defheight, defx, defy: int, defxplus, defyplus, place: bool :=
x_geometry(spec, defspec)
defwidth := int$max(defwidth, minwidth)
defheight := int$max(defheight, minheight)
if place
then if ~defxplus
then defx := sw - defx - defwidth * fwidth - 2 * bwidth - add
end
if ~defyplus
then defy := sh - defy - defheight * fheight - 2 * bwidth - add
end
x: x_window := x_window$create(defx, defy,
defwidth * fwidth + add,
defheight * fheight + add,
back, root, bwidth, border)
return(x, defwidth, defheight)
end
prog: string := _get_xjname()
pfont: x_font := x_font$create(x_default(prog, "MakeWindow.BodyFont"))
except when not_found: pfont := f end
pfore: int := WhitePixel
pback: int := BlackPixel
if x_default(prog, "MakeWindow.ReverseVideo") = "on"
then pfore := BlackPixel
pback := WhitePixel
end except when not_found: end
bpix: int := pback
mfore: int := pback
mback: int := pfore
pbw: int := int$parse(x_default(prog, "MakeWindow.BorderWidth"))
except when not_found, overflow, bad_format: pbw := 1 end
ibw: int := int$parse(x_default(prog, "MakeWindow.InternalBorder"))
except when not_found, overflow, bad_format: ibw := 1 end
freeze: bool := x_default(prog, "MakeWindow.Freeze") = "on"
except when not_found: freeze := false end
clip: bool := x_default(prog, "MakeWindow.ClipToScreen") = "on"
except when not_found: clip := false end
if x_display$cells() > 2
then begin
r, g, b: int := x_parse_color(
x_default(prog, "MakeWindow.Foreground"))
pfore := x_display$alloc_color(r, g, b)
end except others: end
begin
r, g, b: int := x_parse_color(
x_default(prog, "MakeWindow.Background"))
pback := x_display$alloc_color(r, g, b)
end except others: end
begin
r, g, b: int := x_parse_color(
x_default(prog, "MakeWindow.Border"))
bpix := x_display$alloc_color(r, g, b)
end except others: end
begin
r, g, b: int := x_parse_color(
x_default(prog, "MakeWindow.Mouse"))
mfore := x_display$alloc_color(r, g, b)
end except others: end
begin
r, g, b: int := x_parse_color(
x_default(prog, "MakeWindow.MouseMask"))
mback := x_display$alloc_color(r, g, b)
end except others: end
end
cr: x_cursor := x_cursor$scons(cross_width, cross_height,
cross, cross_mask, mback, mfore,
cross_x, cross_y, GXcopy)
events: int := ButtonPressed + ButtonReleased
if freeze
then events := events + MouseMoved end
while true do
x_window$grab_mouse(root, events, cr)
except when error (*):
sleep(1)
continue
end
break
end
fw, fh: int, fc, lc: char, bl: int, fx: bool := x_font$query(pfont)
nz: int := string$size(name) + 9
popw: int := nz * fw + 2 * ibw
poph: int := fh + 2 * ibw
count: int := vcount
save: x_pixmap := x_pixmap$none()
if freeze
then x_display$grab()
count := fcount
save := x_window$save_region(root, 0, 0,
popw + 2 * pbw, poph + 2 * pbw)
except when error (*): end
end
backmap: x_pixmap := x_pixmap$tile(pback)
bdrmap: x_pixmap := x_pixmap$tile(bpix)
pop: x_window := x_window$create(0, 0, popw, poph, backmap,
root, pbw, bdrmap)
x_window$map(pop)
xadd: int := fwidth / 2 - add
yadd: int := fheight / 2 - add
x1, y1: int, bw: x_window := x_window$query_mouse(root)
box: x_vlist := x_vlist$create(count)
but: int
x2: int := x1 + minwidth * fwidth + add + 2 * bwidth - 1
y2: int := y1 + minheight * fheight + add + 2 * bwidth - 1
chosen: int := -1
stop: bool := false
hsize: int := minwidth
vsize: int := minheight
text: _bytevec := _cvt[string, _bytevec](name || ": 000x000")
changed: bool := true
xa: int := -1
ya: int := -1
xb: int := -1
yb: int := -1
e: event := x_input$empty_event()
doit: bool := true
mindim: int := add + 2 * bwidth
while ~stop do
if xb ~= int$max(x1, x2) cor yb ~= int$max(y1, y2) cor
xa ~= int$min(x1, x2) cor ya ~= int$min(y1, y2)
then if freeze cand ~doit
then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1)
end
xa := int$min(x1, x2)
ya := int$min(y1, y2)
xb := int$max(x1, x2)
yb := int$max(y1, y2)
for i: int in int$from_to_by(1, count, 4) do
x_vlist$store(box, i, xa, ya, 0)
if i = count
then break end
x_vlist$store(box, i + 1, xb, ya, 0)
x_vlist$store(box, i + 2, xb, yb, 0)
x_vlist$store(box, i + 3, xa, yb, 0)
end
doit := true
end
if changed
then changed := false
text[nz - 6] := char$i2c(hsize / 100 + zero)
text[nz - 5] := char$i2c((hsize / 10) // 10 + zero)
text[nz - 4] := char$i2c(hsize // 10 + zero)
text[nz - 2] := char$i2c(vsize / 100 + zero)
text[nz - 1] := char$i2c((vsize / 10) // 10 + zero)
text[nz] := char$i2c(vsize // 10 + zero)
x_window$text(pop, _cvt[_bytevec, string](text), pfont,
pfore, pback, ibw, ibw)
end
if doit
then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1)
doit := ~freeze
end
if freeze cor x_input$pending()
then x_input$deq(e)
x2 := e.x
y2 := e.y
if chosen < 0 cand e.kind = ButtonPressed
then x1 := x2
y1 := y2
chosen := e.value
elseif e.kind = ButtonReleased cand e.value = chosen
then stop := true
else x2, y2, bw := x_window$query_mouse(root) end
else x2, y2, bw := x_window$query_mouse(root)
end
if chosen ~= MiddleButton
then x1 := x2
y1 := y2
if chosen >= 0
then x2 := defwidth
if chosen = LeftButton
then y2 := defheight
else y2 := (sh - mindim - cross_y) / fheight
end
if clip
then x2 := int$min(int$max((sw - x1 - mindim) / fwidth, 0), x2)
y2 := int$min(int$max((sh - y1 - mindim) / fheight, 0), y2)
end
x2 := x1 + x2 * fwidth + add - 1
y2 := y1 + y2 * fheight + add - 1
end
end
d: int := int$max((int$abs(x2 - x1) + xadd) / fwidth, minwidth)
if d ~= hsize
then hsize := d
changed := true
end
d := d * fwidth + mindim - 1
if x2 < x1
then x2 := x1 - d
else x2 := x1 + d
end
d := int$max((int$abs(y2 - y1) + yadd) / fheight, minheight)
if d ~= vsize
then vsize := d
changed := true
end
d := d * fheight + mindim - 1
if y2 < y1
then y2 := y1 - d
else y2 := y1 + d
end
end
if freeze
then x_window$draw(root, box, count, 0, 1, 1, GXinvert, 1) end
x_window$ungrab_mouse()
if save ~= x_pixmap$none()
then x_window$unmap_transparent(pop)
x_window$pixmap_put(root, save, 0, 0, popw + 2 * pbw,
poph + 2 * pbw, 0, 0, GXcopy, -1)
x_pixmap$destroy(save)
end
x_window$destroy(pop)
if freeze
then x_display$ungrab() end
x_cursor$destroy(cr)
if pfont ~= f
then x_font$destroy(pfont) end
x_pixmap$destroy(backmap)
x_pixmap$destroy(bdrmap)
w: x_window := x_window$create(int$min(x1, x2), int$min(y1, y2),
hsize * fwidth + add, vsize * fheight + add,
back, root, bwidth, border)
return(w, hsize, vsize)
end x_tcons