Return to lines.clu CVS log

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

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

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

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