Return to bounce.clu CVS log

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

Annotation of 43BSD/contrib/X/xdemo/bounce.clu, revision 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.