Return to circle.clu CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo

Annotation of 43BSD/contrib/X/xdemo/circle.clu, revision 1.1.1.1

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.