Return to circles.clu CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / new / X / xdemo

Annotation of 43BSDTahoe/new/X/xdemo/circles.clu, revision 1.1.1.1

1.1       root        1: % from Lucasfilm Ltd.
                      2: 
                      3: circlesdemo = proc ()
                      4:     size = 64
                      5:     bwidth: int := int$parse(xdemo_default("circles", "BorderWidth"))
                      6:        except when not_found, overflow, bad_format: bwidth := 2 end
                      7:     back: x_pixmap := x_display$white()
                      8:     bdr: x_pixmap := x_display$black()
                      9:     plane: int := 1
                     10:     if x_display$cells() > 2
                     11:        then begin
                     12:            r, g, b: int := x_parse_color(xdemo_default("circles", "Border"))
                     13:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
                     14:            end except when not_found: end
                     15:            cback: string := xdemo_default("circles", "Background")
                     16:               except when not_found: cback := "" end
                     17:            cfore: string := xdemo_default("circles", "Foreground")
                     18:               except when not_found: cfore := "" end
                     19:            if string$empty(cback)  cand  string$empty(cfore)
                     20:               then exit done end
                     21:            pixs: pixellist
                     22:            pixs, plane := x_display$alloc_cells(1, 1, false)
                     23:            back := x_pixmap$tile(pixs[1])
                     24:            r, g, b: int
                     25:            if string$empty(cback)
                     26:               then r, g, b := x_display$query_color(WhitePixel)
                     27:               else r, g, b := x_parse_color(cback)
                     28:               end
                     29:            x_display$store_color(pixs[1], r, g, b)
                     30:            if string$empty(cfore)
                     31:               then r, g, b := x_display$query_color(BlackPixel)
                     32:               else r, g, b := x_parse_color(cfore)
                     33:               end
                     34:            x_display$store_color(pixs[1] + plane, r, g, b)
                     35:        end except when done: end
                     36:     w: x_window, wid0, hgt0: int := x_cons("circles", back, bdr,
                     37:                                           xdemo_geometry(), "=400x400+1+1",
                     38:                                           40, 40, bwidth)
                     39:     w.name := "circles"
                     40:     w.input := UnmapWindow
                     41:     x_window$map(w)
                     42:     w.input := ExposeWindow + UnmapWindow
                     43:     ev: event := x_input$empty_event()
                     44:     nobit: x_bitmap := x_bitmap$none()
                     45:     while true do
                     46:        x_window$clear(w)
                     47:        sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
                     48:        width := width / size
                     49:        height := height / size
                     50:        if width <= 0  cor  height <= 0
                     51:           then break end
                     52:        x: int := random$next(width - 1) + 1
                     53:        y: int := random$next(height - 1) + 1
                     54:        vx: int := random$next(3) - 1
                     55:        vy: int := random$next(3) - 1
                     56:        while ~x_input$pending() do
                     57:            x0: int := x * size
                     58:            y0: int := y * size
                     59:            xx: int := 1
                     60:            while true do
                     61:                yy: int := isqrt(size * size - xx * xx)
                     62:                if yy < xx
                     63:                   then break end
                     64:                x_window$pix_fill(w, 0, nobit, x0 - xx, y0 - yy,
                     65:                                  2 * xx, 2 * yy, GXinvert, plane)
                     66:                if yy = xx
                     67:                   then break end
                     68:                x_window$pix_fill(w, 0, nobit, x0 - yy, y0 - xx,
                     69:                                  2 * yy, 2 * xx, GXinvert, plane)
                     70:                xx := xx + 1
                     71:                end
                     72:            while true do
                     73:                vx := int$max(-1, int$min(vx + random$next(3) - 1, 1))
                     74:                vy := int$max(-1, int$min(vy + random$next(3) - 1, 1))
                     75:                if vx = 0  cand  vy = 0
                     76:                   then continue end
                     77:                break
                     78:                end
                     79:            x := x + vx
                     80:            if x <= 0  cor  x >= width
                     81:               then x := x - 2 * vx
                     82:                    vx := -vx
                     83:               end
                     84:            y := y + vy
                     85:            if y <= 0  cor  y >= height
                     86:               then y := y - 2 * vy
                     87:                    vy := -vy
                     88:               end
                     89:            end
                     90:        x_input$deq(ev)
                     91:        if ev.kind = UnmapWindow
                     92:           then x_input$deq(ev) end
                     93:        end
                     94:     x_window$destroy(w)
                     95:     end circlesdemo

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.