DataMuseum.dk

top - metrics - download

    Length: 4004 (0xfa4)
    Types: TextFile
    Names: »wallpaper.clu«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z« 
        └─⟦2109abc41⟧ 
            └─⟦this⟧ »./X.V10R4/xdemo/wallpaper.clu« 

TextFile

% from Lucasfilm Ltd.

wallpaperdemo = proc ()
    size = 128
    bwidth: int := int$parse(xdemo_default("wallpaper", "BorderWidth"))
       except when not_found, overflow, bad_format: bwidth := 2 end
    back: x_pixmap := x_display$white()
    bdr: x_pixmap := x_display$black()
    plane: int := 1
    wallpix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("wallpaper", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    cback: string := xdemo_default("wallpaper", "Background")
	       except when not_found: cback := "" end
	    cfore: string := xdemo_default("wallpaper", "Foreground")
	       except when not_found: cfore := "" end
	    if string$empty(cback)  cand  string$empty(cfore)
	       then exit done end
	    pixs: pixellist
	    pixs, plane := x_display$alloc_cells(1, 1, false)
	    back := x_pixmap$tile(pixs[1])
	    r, g, b: int
	    if string$empty(cback)
	       then r, g, b := x_display$query_color(WhitePixel)
	       else r, g, b := x_parse_color(cback)
	       end
	    x_display$store_color(pixs[1], r, g, b)
	    if string$empty(cfore)
	       then r, g, b := x_display$query_color(BlackPixel)
	       else r, g, b := x_parse_color(cfore)
	       end
	    wallpix := pixs[1] + plane
	    x_display$store_color(wallpix, r, g, b)
       end except when done: end
    w: x_window, wid0, hgt0: int := x_cons("wallpaper", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "wallpaper"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    ev: event := x_input$empty_event()
    nobit: x_bitmap := x_bitmap$none()
    while true do
	x_window$clear(w)
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= size  cor  height <= size
	   then x_window$destroy(w)
		return
	   end
	idx: int := 0
	x0: int := 0
	y0: int := 0
	x1: int := 0
	y1: int := 0
	vx0: int := 0
	vy0: int := 0
	vx1: int := 0
	vy1: int := 0
	while ~x_input$pending() do
	    func: int := GXinvert
	    if random$next(10) = 0
	       then func := GXset end
	    for x: int in int$from_to_by(x0 - size, x0 + 8 * size, size) do
		for y: int in int$from_to_by(y0 - size, y0 + 8 * size, size) do
		    xs: int := x1 - x0
		    ys: int := y1 - y0
		    if x < 0
		       then xs := xs + x
			    x := 0
		       end
		    if y < 0
		       then ys := ys + y
			    y := 0
		       end
		    if x >= width  cor  y >= height
		       then continue end
		    if x + xs >= width
		       then xs := width - 1 - x end
		    if y + ys >= height
		       then ys := height - y end
		    if xs <= 0  cor  ys <= 0
		       then continue end
		    x_window$pix_fill(w, 0, nobit, x, y, xs, ys, func, plane)
		    end
		end
	    vx0 := int$max(-5, int$min(vx0 + random$next(3) - 1, 5))
	    x0 := x0 + vx0
	    if x0 < 0
	       then x0 := -x0
		    vx0 := -vx0
	     elseif x0 > size
	       then x0 := 2 * size - x0
		    vx0 := -vx0
	     end
	    vx1 := int$max(-5, int$min(vx1 + random$next(3) - 1, 5))
	    x1 := x1 + vx1
	    if x1 < 0
	       then x1 := -x1
		    vx1 := -vx1
	     elseif x1 > size
	       then x1 := 2 * size - x1
		    vx1 := -vx1
	     end
	    if x0 > x1
	       then x0, x1 := x1, x0
		    vx0, vx1 := vx1, vx0
	       end
	    vy0 := int$max(-5, int$min(vy0 + random$next(3) - 1, 5))
	    y0 := y0 + vy0
	    if y0 < 0
	       then y0 := -y0
		    vy0 := -vy0
	     elseif y0 > size
	       then y0 := 2 * size - y0
		    vy0 := -vy0
	     end
	    vy1 := int$max(-5, int$min(vy1 + random$next(3) - 1, 5))
	    y1 := y1 + vy1
	    if y1 < 0
	       then y1 := -y1
		    vy1 := -vy1
	     elseif y1 > size
	       then y1 := 2 * size - y1
		    vy1 := -vy1
	     end
	    if y0 > y1
	       then y0, y1 := y1, y0
		    vy0, vy1 := vy1, vy0
	       end
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    end wallpaperdemo