Return to tetra.clu CVS log

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

Annotation of 43BSD/contrib/X/xdemo/tetra.clu, revision 1.1

1.1     ! root        1: % from Lucasfilm Ltd.
        !             2: 
        !             3: rec = record[dx, dy, x, y: int]
        !             4: ar = array[rec]
        !             5: 
        !             6: tetrademo = proc ()
        !             7:     bwidth: int := int$parse(xdemo_default("tetra", "BorderWidth"))
        !             8:        except when not_found, overflow, bad_format: bwidth := 2 end
        !             9:     back: x_pixmap := x_display$white()
        !            10:     bdr: x_pixmap := x_display$black()
        !            11:     plane: int := 1
        !            12:     linepix: int := BlackPixel
        !            13:     if x_display$cells() > 2
        !            14:        then begin
        !            15:            r, g, b: int := x_parse_color(xdemo_default("tetra", "Border"))
        !            16:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
        !            17:            end except when not_found: end
        !            18:            pixs: pixellist
        !            19:            pixs, plane := x_display$alloc_cells(1, 1, false)
        !            20:            back := x_pixmap$tile(pixs[1])
        !            21:            linepix := pixs[1] + plane
        !            22:            r, g, b: int := x_parse_color(xdemo_default("tetra", "Background"))
        !            23:               except when not_found:
        !            24:                           r, g, b := x_display$query_color(WhitePixel)
        !            25:                      end
        !            26:            x_display$store_color(pixs[1], r, g, b)
        !            27:            random_color(linepix)
        !            28:        end
        !            29:     w: x_window, wid0, hgt0: int := x_cons("tetra", back, bdr,
        !            30:                                           xdemo_geometry(), "=800x800+1+1",
        !            31:                                           40, 40, bwidth)
        !            32:     w.name := "tetra"
        !            33:     w.input := UnmapWindow
        !            34:     x_window$map(w)
        !            35:     w.input := ExposeWindow + UnmapWindow
        !            36:     vlist: x_vlist := x_vlist$create(6 * 2)
        !            37:     ev: event := x_input$empty_event()
        !            38:     while true do
        !            39:        x_window$clear(w)
        !            40:        sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
        !            41:        if width <= 30  cor  height <= 30
        !            42:           then x_window$destroy(w)
        !            43:                return
        !            44:           end
        !            45:        a0: ar := ar$create(0)
        !            46:        for i: int in int$from_to(0, 3) do
        !            47:            ar$addh(a0, rec${dx: 3 + random$next(4),
        !            48:                             dy: 3 + random$next(4),
        !            49:                             x:  random$next(width),
        !            50:                             y:  random$next(height)})
        !            51:            end
        !            52:        a1: ar := ar$copy(a0)
        !            53:        delay: int := 6
        !            54:        count: int := 0
        !            55:        while count ~= 0  cor  ~x_input$pending() do
        !            56:            if count = 10
        !            57:               then count := 0
        !            58:               else count := count + 1
        !            59:               end
        !            60:            iterate(w, a0, width, height, linepix, plane, vlist)
        !            61:            if delay = 0
        !            62:               then iterate(w, a1, width, height, linepix, plane, vlist)
        !            63:               else delay := delay - 1
        !            64:               end
        !            65:            end
        !            66:        x_input$deq(ev)
        !            67:        if ev.kind = UnmapWindow
        !            68:           then x_input$deq(ev) end
        !            69:        end
        !            70:     end tetrademo
        !            71: 
        !            72: iterate = proc (w: x_window, a: ar, width, height, pix, plane: int, vlist: x_vlist)
        !            73:     idx: int := 1
        !            74:     for i: int in int$from_to(1, 3) do
        !            75:        ri: rec := a[i]
        !            76:        for j: int in int$from_to(0, i - 1) do
        !            77:            rj: rec := a[j]
        !            78:            x_vlist$store(vlist, idx, ri.x, ri.y, VertexDontDraw)
        !            79:            x_vlist$store(vlist, idx + 1, rj.x, rj.y, VertexDrawLastPoint)
        !            80:            idx := idx + 2
        !            81:            end
        !            82:        end
        !            83:     x_window$draw(w, vlist, 12, 0, 1, 1, GXinvert, plane)
        !            84:     for r: rec in ar$elements(a) do
        !            85:        r.x := r.x + r.dx
        !            86:        if r.x < 0  cor  r.x >= width
        !            87:           then r.x := r.x - 2 * r.dx
        !            88:                r.dx := -r.dx
        !            89:                if pix ~= BlackPixel
        !            90:                   then random_color(pix) end
        !            91:           end
        !            92:        r.y := r.y + r.dy
        !            93:        if r.y < 0  cor  r.y >= height
        !            94:           then r.y := r.y - 2 * r.dy
        !            95:                r.dy := -r.dy
        !            96:                if pix ~= BlackPixel
        !            97:                   then random_color(pix) end
        !            98:           end
        !            99:        end
        !           100:     end iterate

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