% 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