% 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