Return to star.clu CVS log

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

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

1.1     ! root        1: stardemo = proc ()
        !             2:     agon = 36
        !             3:     ai = array[int]
        !             4: 
        !             5:     bwidth: int := int$parse(xdemo_default("star", "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:     backpix: int := WhitePixel
        !            10:     linepix: int := BlackPixel
        !            11:     if x_display$cells() > 2
        !            12:        then begin
        !            13:            r, g, b: int := x_parse_color(xdemo_default("star", "Background"))
        !            14:            backpix := x_display$alloc_color(r, g, b)
        !            15:            back := x_pixmap$tile(backpix)
        !            16:            end except when not_found: end
        !            17:            begin
        !            18:            r, g, b: int := x_parse_color(xdemo_default("star", "Border"))
        !            19:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
        !            20:            end except when not_found: end
        !            21:            linepix := x_display$alloc_cell()
        !            22:        end
        !            23:     w: x_window, wid0, hgt0: int := x_cons("star", back, bdr,
        !            24:                                           xdemo_geometry(), "=400x400+1+1",
        !            25:                                           40, 40, bwidth)
        !            26:     w.name := "star"
        !            27:     w.input := UnmapWindow
        !            28:     x_window$map(w)
        !            29:     w.input := ExposeWindow + UnmapWindow
        !            30:     vlist: x_vlist := x_vlist$create(agon * 2)
        !            31:     cx: ai := ai$fill(0, agon, 0)
        !            32:     cy: ai := ai$fill(0, agon, 0)
        !            33:     ev: event := x_input$empty_event()
        !            34:     while true do
        !            35:        sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
        !            36:        if width <= 30  cor  height <= 30
        !            37:           then break end
        !            38:        xcent: int := width / 2
        !            39:        ycent: int := height / 2
        !            40:        cx[0] := int$min(height, width) / 2 - 10
        !            41:        cy[0] := 0
        !            42:        cos: int := 32270
        !            43:        sin: int := 5690
        !            44:        for i: int in int$from_to(1, agon - 1) do
        !            45:            cx[i] := (cx[i - 1] * cos - cy[i - 1] * sin + 16384) / 32768
        !            46:            cy[i] := (cx[i - 1] * sin + cy[i - 1] * cos + 16384) / 32768
        !            47:            end
        !            48:        for i: int in int$from_to(0, agon - 1) do
        !            49:            cx[i] := cx[i] + xcent
        !            50:            cy[i] := cy[i] + ycent
        !            51:            end
        !            52:        x_window$clear(w)
        !            53:        while ~x_input$pending() do
        !            54:            if linepix ~= BlackPixel
        !            55:               then random_color(linepix) end
        !            56:            for i: int in int$from_to(0, agon - 2) do
        !            57:                for j: int in int$from_to(i + 1, agon - 1) do
        !            58:                    k: int := 2 * (j - i)
        !            59:                    x_vlist$store(vlist, k - 1, cx[i], cy[i], VertexDontDraw)
        !            60:                    x_vlist$store(vlist, k, cx[j], cy[j], 0)
        !            61:                    end
        !            62:                x_window$draw(w, vlist, 2 * (agon - 1 - i), linepix, 1, 1,
        !            63:                              GXcopy, -1)
        !            64:                end
        !            65:            for i: int in int$from_to_by(agon - 2, 0, -1) do
        !            66:                for j: int in int$from_to_by(agon - 1, i + 1, -1) do
        !            67:                    k: int := 2 * (j - i)
        !            68:                    x_vlist$store(vlist, k - 1, cx[i], cy[i], VertexDontDraw)
        !            69:                    x_vlist$store(vlist, k, cx[j], cy[j], 0)
        !            70:                    end
        !            71:                x_window$draw(w, vlist, 2 * (agon - 1 - i), backpix, 1, 1,
        !            72:                              GXcopy, -1)
        !            73:                end
        !            74:            x_window$query_mouse(w)
        !            75:            end
        !            76:        x_input$deq(ev)
        !            77:        if ev.kind = UnmapWindow
        !            78:           then x_input$deq(ev) end
        !            79:        end
        !            80:     x_window$destroy(w)
        !            81:     end stardemo

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