DataMuseum.dk

top - download

    Length: 2990 (0xbae)
    Types: TextFile
    Names: »circles.clu«

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

TextFile

% from Lucasfilm Ltd.

circlesdemo = proc ()
    size = 64
    bwidth: int := int$parse(xdemo_default("circles", "BorderWidth"))
       except when not_found, overflow, bad_format: bwidth := 2 end
    back: x_pixmap := x_display$white()
    bdr: x_pixmap := x_display$black()
    plane: int := 1
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("circles", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    cback: string := xdemo_default("circles", "Background")
	       except when not_found: cback := "" end
	    cfore: string := xdemo_default("circles", "Foreground")
	       except when not_found: cfore := "" end
	    if string$empty(cback)  cand  string$empty(cfore)
	       then exit done end
	    pixs: pixellist
	    pixs, plane := x_display$alloc_cells(1, 1, false)
	    back := x_pixmap$tile(pixs[1])
	    r, g, b: int
	    if string$empty(cback)
	       then r, g, b := x_display$query_color(WhitePixel)
	       else r, g, b := x_parse_color(cback)
	       end
	    x_display$store_color(pixs[1], r, g, b)
	    if string$empty(cfore)
	       then r, g, b := x_display$query_color(BlackPixel)
	       else r, g, b := x_parse_color(cfore)
	       end
	    x_display$store_color(pixs[1] + plane, r, g, b)
       end except when done: end
    w: x_window, wid0, hgt0: int := x_cons("circles", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "circles"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    ev: event := x_input$empty_event()
    nobit: x_bitmap := x_bitmap$none()
    while true do
	x_window$clear(w)
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	width := width / size
	height := height / size
	if width <= 0  cor  height <= 0
	   then break end
	x: int := random$next(width - 1) + 1
	y: int := random$next(height - 1) + 1
	vx: int := random$next(3) - 1
	vy: int := random$next(3) - 1
	while ~x_input$pending() do
	    x0: int := x * size
	    y0: int := y * size
	    xx: int := 1
	    while true do
		yy: int := isqrt(size * size - xx * xx)
		if yy < xx
		   then break end
		x_window$pix_fill(w, 0, nobit, x0 - xx, y0 - yy,
				  2 * xx, 2 * yy, GXinvert, plane)
		if yy = xx
		   then break end
		x_window$pix_fill(w, 0, nobit, x0 - yy, y0 - xx,
				  2 * yy, 2 * xx, GXinvert, plane)
		xx := xx + 1
		end
	    while true do
		vx := int$max(-1, int$min(vx + random$next(3) - 1, 1))
		vy := int$max(-1, int$min(vy + random$next(3) - 1, 1))
		if vx = 0  cand  vy = 0
		   then continue end
		break
		end
	    x := x + vx
	    if x <= 0  cor  x >= width
	       then x := x - 2 * vx
		    vx := -vx
	       end
	    y := y + vy
	    if y <= 0  cor  y >= height
	       then y := y - 2 * vy
		    vy := -vy
	       end
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    x_window$destroy(w)
    end circlesdemo