DataMuseum.dk

top - download

    Length: 6781 (0x1a7d)
    Types: TextFile
    Names: »x_cons.clu«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z« 
        └─⟦2109abc41⟧ 
            └─ ⟦this⟧ »./X.V10R4/CLUlib/x_cons.clu« 

TextFile

% Copyright    Barbara Liskov    1985, 1986

x_cons = proc (name: string, back, border: x_pixmap, spec, defspec: string,
	       minwidth, minheight, bwidth: int) returns (x_window, int, int)
    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 ~defxplus
       then defx := sw - defx - defwidth - 2 * bwidth end
    if ~defyplus
       then defy := sh - defy - defheight - 2 * bwidth end
    if place
       then x: x_window := x_window$create(defx, defy, defwidth, defheight,
					   back, root, bwidth, border)
	    return(x, defwidth, defheight)
       end
    prog: string := _get_xjname()
    fn: string := x_default(prog, "MakeWindow.BodyFont")
       except when not_found: fn := "8x13" end
    font: x_font := x_font$create(fn)
    fwidth, fheight: int, f, l: char, bs: int, x: bool := x_font$query(font)
    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
    popw: int := x_font$width(font, name) + 2 * ibw
    poph: int := fheight + 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
    box: x_vlist := x_vlist$create(count)
    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)
    x_window$text(pop, name, font, pfore, pback, ibw, ibw)
    x1, y1: int, bw: x_window := x_window$query_mouse(root)
    mindim: int := 2 * bwidth - 1
    minwidth := minwidth + mindim
    minheight := minheight + mindim
    x2: int := x1 + minwidth
    y2: int := y1 + minheight
    width: int := minwidth
    height: int := minheight
    but: int := -1
    stop: bool := false
    xa: int := -1
    ya: int := -1
    xb: int := -1
    yb: int := -1
    e: event := x_input$empty_event()
    doit: bool := true
    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 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 but < 0  cand  e.kind = ButtonPressed
		   then but := e.value
			if but = LeftButton
			   then x1 := defx
				y1 := defy
			   else x1 := x2
				y1 := y2
			   end
		 elseif but >= 0  cand  e.kind = ButtonReleased  cand
			e.value = but
		   then stop := true
		 else x2, y2, bw := x_window$query_mouse(root) end
	   else x2, y2, bw := x_window$query_mouse(root)
	   end
	if but < 0  cor  but = RightButton
	   then x1 := x2
		y1 := y2
	   end
	if but = LeftButton  cor  but = RightButton
	   then if clip
		   then x2 := int$min(int$max(sw - x1 - mindim - 1, 0), defwidth)
			y2 := int$min(int$max(sh - y1 - mindim - 1, 0), defheight)
		   else x2 := defwidth
			y2 := defheight
		   end
		x2 := x1 + x2 + mindim
		y2 := y1 + y2 + mindim
	   end
	width := int$max(int$abs(x2 - x1), minwidth)
	if x2 < x1
	   then x2 := x1 - width
	   else x2 := x1 + width
	   end
	height := int$max(int$abs(y2 - y1), minheight)
	if y2 < y1
	   then y2 := y1 - height
	   else y2 := y1 + height
	   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_font$destroy(font)
    x_cursor$destroy(cr)
    x_pixmap$destroy(backmap)
    x_pixmap$destroy(bdrmap)
    width := width - mindim
    height := height - mindim
    w: x_window := x_window$create(int$min(x1, x2), int$min(y1, y2),
				   width, height, back, root, bwidth, border)
    return(w, width, height)
    end x_cons