Return to wallpaper.clu CVS log

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

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

1.1     ! root        1: % from Lucasfilm Ltd.
        !             2: 
        !             3: wallpaperdemo = proc ()
        !             4:     size = 128
        !             5:     bwidth: int := int$parse(xdemo_default("wallpaper", "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:     wallpix: int := BlackPixel
        !            11:     if x_display$cells() > 2
        !            12:        then begin
        !            13:            r, g, b: int := x_parse_color(xdemo_default("wallpaper", "Border"))
        !            14:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
        !            15:            end except when not_found: end
        !            16:            cback: string := xdemo_default("wallpaper", "Background")
        !            17:               except when not_found: cback := "" end
        !            18:            cfore: string := xdemo_default("wallpaper", "Foreground")
        !            19:               except when not_found: cfore := "" end
        !            20:            if string$empty(cback)  cand  string$empty(cfore)
        !            21:               then exit done end
        !            22:            pixs: pixellist
        !            23:            pixs, plane := x_display$alloc_cells(1, 1, false)
        !            24:            back := x_pixmap$tile(pixs[1])
        !            25:            r, g, b: int
        !            26:            if string$empty(cback)
        !            27:               then r, g, b := x_display$query_color(WhitePixel)
        !            28:               else r, g, b := x_parse_color(cback)
        !            29:               end
        !            30:            x_display$store_color(pixs[1], r, g, b)
        !            31:            if string$empty(cfore)
        !            32:               then r, g, b := x_display$query_color(BlackPixel)
        !            33:               else r, g, b := x_parse_color(cfore)
        !            34:               end
        !            35:            wallpix := pixs[1] + plane
        !            36:            x_display$store_color(wallpix, r, g, b)
        !            37:        end except when done: end
        !            38:     w: x_window, wid0, hgt0: int := x_cons("wallpaper", back, bdr,
        !            39:                                           xdemo_geometry(), "=400x400+1+1",
        !            40:                                           40, 40, bwidth)
        !            41:     w.name := "wallpaper"
        !            42:     w.input := UnmapWindow
        !            43:     x_window$map(w)
        !            44:     w.input := ExposeWindow + UnmapWindow
        !            45:     ev: event := x_input$empty_event()
        !            46:     nobit: x_bitmap := x_bitmap$none()
        !            47:     while true do
        !            48:        x_window$clear(w)
        !            49:        sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
        !            50:        if width <= size  cor  height <= size
        !            51:           then x_window$destroy(w)
        !            52:                return
        !            53:           end
        !            54:        idx: int := 0
        !            55:        x0: int := 0
        !            56:        y0: int := 0
        !            57:        x1: int := 0
        !            58:        y1: int := 0
        !            59:        vx0: int := 0
        !            60:        vy0: int := 0
        !            61:        vx1: int := 0
        !            62:        vy1: int := 0
        !            63:        while ~x_input$pending() do
        !            64:            func: int := GXinvert
        !            65:            if random$next(10) = 0
        !            66:               then func := GXset end
        !            67:            for x: int in int$from_to_by(x0 - size, x0 + 8 * size, size) do
        !            68:                for y: int in int$from_to_by(y0 - size, y0 + 8 * size, size) do
        !            69:                    xs: int := x1 - x0
        !            70:                    ys: int := y1 - y0
        !            71:                    if x < 0
        !            72:                       then xs := xs + x
        !            73:                            x := 0
        !            74:                       end
        !            75:                    if y < 0
        !            76:                       then ys := ys + y
        !            77:                            y := 0
        !            78:                       end
        !            79:                    if x >= width  cor  y >= height
        !            80:                       then continue end
        !            81:                    if x + xs >= width
        !            82:                       then xs := width - 1 - x end
        !            83:                    if y + ys >= height
        !            84:                       then ys := height - y end
        !            85:                    if xs <= 0  cor  ys <= 0
        !            86:                       then continue end
        !            87:                    x_window$pix_fill(w, 0, nobit, x, y, xs, ys, func, plane)
        !            88:                    end
        !            89:                end
        !            90:            vx0 := int$max(-5, int$min(vx0 + random$next(3) - 1, 5))
        !            91:            x0 := x0 + vx0
        !            92:            if x0 < 0
        !            93:               then x0 := -x0
        !            94:                    vx0 := -vx0
        !            95:             elseif x0 > size
        !            96:               then x0 := 2 * size - x0
        !            97:                    vx0 := -vx0
        !            98:             end
        !            99:            vx1 := int$max(-5, int$min(vx1 + random$next(3) - 1, 5))
        !           100:            x1 := x1 + vx1
        !           101:            if x1 < 0
        !           102:               then x1 := -x1
        !           103:                    vx1 := -vx1
        !           104:             elseif x1 > size
        !           105:               then x1 := 2 * size - x1
        !           106:                    vx1 := -vx1
        !           107:             end
        !           108:            if x0 > x1
        !           109:               then x0, x1 := x1, x0
        !           110:                    vx0, vx1 := vx1, vx0
        !           111:               end
        !           112:            vy0 := int$max(-5, int$min(vy0 + random$next(3) - 1, 5))
        !           113:            y0 := y0 + vy0
        !           114:            if y0 < 0
        !           115:               then y0 := -y0
        !           116:                    vy0 := -vy0
        !           117:             elseif y0 > size
        !           118:               then y0 := 2 * size - y0
        !           119:                    vy0 := -vy0
        !           120:             end
        !           121:            vy1 := int$max(-5, int$min(vy1 + random$next(3) - 1, 5))
        !           122:            y1 := y1 + vy1
        !           123:            if y1 < 0
        !           124:               then y1 := -y1
        !           125:                    vy1 := -vy1
        !           126:             elseif y1 > size
        !           127:               then y1 := 2 * size - y1
        !           128:                    vy1 := -vy1
        !           129:             end
        !           130:            if y0 > y1
        !           131:               then y0, y1 := y1, y0
        !           132:                    vy0, vy1 := vy1, vy0
        !           133:               end
        !           134:            end
        !           135:        x_input$deq(ev)
        !           136:        if ev.kind = UnmapWindow
        !           137:           then x_input$deq(ev) end
        !           138:        end
        !           139:     end wallpaperdemo

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