4.3BSD/usr/contrib/X/xdemo/circle.clu

% from Lucasfilm Ltd.

circledemo = proc ()
    bwidth: int := int$parse(xdemo_default("circle", "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
    cirpix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("circle", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    pixs: pixellist
	    pixs, plane := x_display$alloc_cells(1, 1, false)
	    back := x_pixmap$tile(pixs[1])
	    r, g, b: int := x_parse_color(xdemo_default("circle", "Background"))
	       except when not_found:
			   r, g, b := x_display$query_color(WhitePixel)
		      end
	    x_display$store_color(pixs[1], r, g, b)
	    cirpix := pixs[1] + plane
	    random_color(cirpix)
       end
    w: x_window, wid0, hgt0: int := x_cons("circle", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "circle"
    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
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= 30  cor  height <= 30
	   then break end
	size: int := int$min(height, width) / 2 - 10
	size2: int := size * size
	sx := width / 2
	sy := height / 2
	while ~x_input$pending() do
	    x_window$clear(w)
	    if cirpix ~= BlackPixel
	       then random_color(cirpix) end
	    for i: int in int$from_to_by(20, 1, -1) do
		y: int := random$next(size) + 1
		x: int := int$max(1, isqrt(size2 - y * y))
		x_window$pix_fill(w, 0, nobit, sx - x, sy - y, 2 * x, 2 * y,
				  GXinvert, plane)
		x := random$next(size) + 1
		y := int$max(1, isqrt(size2 - x * x))
		x_window$pix_fill(w, 0, nobit, sx - x, sy - y, 2 * x, 2 * y,
				  GXinvert, plane)
		end
	    x_window$query_mouse(w)
	    sleep(1)
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    x_window$destroy(w)
    end circledemo