|
|
1.1 ! root 1: % from Lucasfilm Ltd. ! 2: ! 3: circledemo = proc () ! 4: bwidth: int := int$parse(xdemo_default("circle", "BorderWidth")) ! 5: except when not_found, overflow, bad_format: bwidth := 2 end ! 6: back: x_pixmap := x_display$white() ! 7: bdr: x_pixmap := x_display$black() ! 8: plane: int := 1 ! 9: cirpix: int := BlackPixel ! 10: if x_display$cells() > 2 ! 11: then begin ! 12: r, g, b: int := x_parse_color(xdemo_default("circle", "Border")) ! 13: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b)) ! 14: end except when not_found: end ! 15: pixs: pixellist ! 16: pixs, plane := x_display$alloc_cells(1, 1, false) ! 17: back := x_pixmap$tile(pixs[1]) ! 18: r, g, b: int := x_parse_color(xdemo_default("circle", "Background")) ! 19: except when not_found: ! 20: r, g, b := x_display$query_color(WhitePixel) ! 21: end ! 22: x_display$store_color(pixs[1], r, g, b) ! 23: cirpix := pixs[1] + plane ! 24: random_color(cirpix) ! 25: end ! 26: w: x_window, wid0, hgt0: int := x_cons("circle", back, bdr, ! 27: xdemo_geometry(), "=400x400+1+1", ! 28: 40, 40, bwidth) ! 29: w.name := "circle" ! 30: w.input := UnmapWindow ! 31: x_window$map(w) ! 32: w.input := ExposeWindow + UnmapWindow ! 33: ev: event := x_input$empty_event() ! 34: nobit: x_bitmap := x_bitmap$none() ! 35: while true do ! 36: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w) ! 37: if width <= 30 cor height <= 30 ! 38: then break end ! 39: size: int := int$min(height, width) / 2 - 10 ! 40: size2: int := size * size ! 41: sx := width / 2 ! 42: sy := height / 2 ! 43: while ~x_input$pending() do ! 44: x_window$clear(w) ! 45: if cirpix ~= BlackPixel ! 46: then random_color(cirpix) end ! 47: for i: int in int$from_to_by(20, 1, -1) do ! 48: y: int := random$next(size) + 1 ! 49: x: int := int$max(1, isqrt(size2 - y * y)) ! 50: x_window$pix_fill(w, 0, nobit, sx - x, sy - y, 2 * x, 2 * y, ! 51: GXinvert, plane) ! 52: x := random$next(size) + 1 ! 53: y := int$max(1, isqrt(size2 - x * x)) ! 54: x_window$pix_fill(w, 0, nobit, sx - x, sy - y, 2 * x, 2 * y, ! 55: GXinvert, plane) ! 56: end ! 57: x_window$query_mouse(w) ! 58: sleep(1) ! 59: end ! 60: x_input$deq(ev) ! 61: if ev.kind = UnmapWindow ! 62: then x_input$deq(ev) end ! 63: end ! 64: x_window$destroy(w) ! 65: end circledemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.