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

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.