% 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