Return to bounce.clu CVS log

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

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

1.1       root        1: % from Lucasfilm Ltd.
                      2: 
                      3: bouncedemo = proc ()
                      4:     nbounce = 20
                      5:     bwidth: int := int$parse(xdemo_default("bounce", "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:     ballpix: int := BlackPixel
                     11:     if x_display$cells() > 2
                     12:        then begin
                     13:            r, g, b: int := x_parse_color(xdemo_default("bounce", "Border"))
                     14:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
                     15:            end except when not_found: end
                     16:            pixs: pixellist
                     17:            pixs, plane := x_display$alloc_cells(1, 1, false)
                     18:            back := x_pixmap$tile(pixs[1])
                     19:            r, g, b: int := x_parse_color(xdemo_default("bounce", "Background"))
                     20:               except when not_found:
                     21:                           r, g, b := x_display$query_color(WhitePixel)
                     22:                      end
                     23:            x_display$store_color(pixs[1], r, g, b)
                     24:            ballpix := pixs[1] + plane
                     25:            random_color(ballpix)
                     26:        end
                     27:     w: x_window, wid0, hgt0: int := x_cons("bounce", back, bdr,
                     28:                                           xdemo_geometry(), "=400x400+1+1",
                     29:                                           40, 40, bwidth)
                     30:     w.name := "bounce"
                     31:     w.input := UnmapWindow
                     32:     x_window$map(w)
                     33:     w.input := ExposeWindow + UnmapWindow
                     34:     ev: event := x_input$empty_event()
                     35:     nobit: x_bitmap := x_bitmap$none()
                     36:     while true do
                     37:        x_window$clear(w)
                     38:        sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
                     39:        if width <= 30  cor  height <= 30
                     40:           then x_window$destroy(w)
                     41:                return
                     42:           end
                     43:        width := width - nbounce
                     44:        height := height - nbounce - 1
                     45:        x: int := 0
                     46:        y: int := 0
                     47:        vx: int := 4
                     48:        vy: int := 0
                     49:        wait: bool := false
                     50:        while ~x_input$pending() do
                     51:            x_window$pix_fill(w, 0, nobit, x, y, nbounce, nbounce,
                     52:                              GXinvert, plane)
                     53:            wait := ~wait
                     54:            if wait
                     55:               then x_window$query_mouse(w) end
                     56:            x := x + vx
                     57:            if x >= width
                     58:               then x := 2 * width - x - 2
                     59:                    vx := -vx
                     60:             elseif x < 0
                     61:               then x := -x
                     62:                    vx := -vx
                     63:             end
                     64:            vy := vy + 1
                     65:            y := y + vy
                     66:            if y >= height
                     67:               then y := 2 * height - y
                     68:                    if vy < nbounce
                     69:                       then vy := 1 - vy
                     70:                       else vy := vy / nbounce - vy
                     71:                       end
                     72:                    if vy = 0
                     73:                       then x := 0
                     74:                            y := 0
                     75:                            vx := 4
                     76:                            vy := 0
                     77:                            if ballpix ~= BlackPixel
                     78:                               then random_color(ballpix) end
                     79:                       end
                     80:               end
                     81:            end
                     82:        x_input$deq(ev)
                     83:        if ev.kind = UnmapWindow
                     84:           then x_input$deq(ev) end
                     85:        end
                     86:     end bouncedemo

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