DataMuseum.dk

top - download

    Length: 5222 (0x1466)
    Types: TextFile
    Names: »motion.clu«

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

TextFile

motiondemo = proc ()
    vcount = 500
    bwidth: int := int$parse(xdemo_default("motion", "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
    backpix: int := WhitePixel
    linepix: int := BlackPixel
    mousepix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("motion", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    pixs: pixellist
	    pixs, plane := x_display$alloc_cells(1, 1, false)
	    backpix := pixs[1]
	    back := x_pixmap$tile(backpix)
	    linepix := backpix + plane
	    r, g, b: int := x_parse_color(xdemo_default("motion", "Background"))
	       except when not_found:
			   r, g, b := x_display$query_color(WhitePixel)
		      end
	    x_display$store_color(backpix, r, g, b)
	    random_color(linepix)
	    begin
	    r, g, b := x_parse_color(xdemo_default("motion", "Mouse"))
	    mousepix := x_display$alloc_color(r, g, b)
	    end except when not_found: end
       end
    w: x_window, wid0, hgt0: int := x_cons("motion", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "motion"
    w.input := ButtonPressed + UnmapWindow
    x_window$map(w)
    cr: x_cursor := x_cursor$scons(cross_width, cross_height,
				   cross, cross_mask,
				   backpix, mousepix, cross_x, cross_y,
				   GXcopy)
    w.cursor := cr
    w.input := ButtonPressed + ExposeWindow + UnmapWindow
    vlist: x_vlist := x_vlist$create(vcount + 1)
    ovlist: x_vlist := x_vlist$create(vcount + 1)
    sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
    height := height - 1
    width := width - 1
    ev: event := x_input$empty_event()
    nobit: x_bitmap := x_bitmap$none()
    while true do
	n: int := 0
	while n < vcount do
	    x_input$deq(ev)
	    if ev.kind = ExposeWindow
	       then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w)
		    if width <= 30  cor  height <= 30
		       then x_window$destroy(w)
			    return
		       end
		    height := height - 1
		    width := width - 1
		    x_window$clear(w)
		    for i: int in int$from_to(1, n) do
			x, y, flags: int := x_vlist$fetch(vlist, i)
			x_window$pix_fill(w, 0, nobit, x, y, 2, 2, GXinvert, 1)
			end
		    continue
	     elseif ev.kind = UnmapWindow
	       then continue end
	    if ev.value = MiddleButton
	       then break end
	    x_window$pix_fill(w, 0, nobit, ev.x, ev.y, 2, 2, GXinvert, 1)
	    n := n + 1
	    flags: int := 0
	    if ev.value = LeftButton
	       then flags := VertexCurved end
	    x_vlist$store(vlist, n, ev.x, ev.y, flags)
	    end
	x_window$clear(w)
	if n > 2
	   then x, y, flags: int := x_vlist$fetch(vlist, 1)
		x_vlist$store(vlist, 1, x, y, flags + VertexStartClosed)
		n := n + 1
		x_vlist$store(vlist, n, x, y, flags + VertexEndClosed)
	 elseif n < 2
	   then continue end
	x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
	xd: int := -1
	dx: int := 1
	yd: int := -1
	dy: int := 1
	count: int := 0
	while true do
	    if xd < 0
	       then xd := random$next(width)
		    dx := random$next(2)
	       else xd := xd - 1
	       end
	    if yd < 0
	       then yd := random$next(height)
		    dy := random$next(2)
	       else yd := yd - 1
	       end
	    for i: int in int$from_to(1, n - 1) do
		xx, yy, flags: int := x_vlist$fetch(vlist, i)
		x_vlist$store(ovlist, i, xx, yy, flags)
		x: int := random$next(5)
		if dx = 0
		   then x := -x end
		x := x + xx
		if x < 0
		   then x := 0
			xd := -1
			if linepix ~= BlackPixel
			   then random_color(linepix) end
		 elseif x > width
		   then x := width
			xd := -1
			if linepix ~= BlackPixel
			   then random_color(linepix) end
		 end
		y: int := random$next(5)
		if dy = 0
		   then y := -y end
		y := y + yy
		if y < 0
		   then y := 0
			yd := -1
			if linepix ~= BlackPixel
			   then random_color(linepix) end
		 elseif y > height
		   then y := height
			yd := -1
			if linepix ~= BlackPixel
			   then random_color(linepix) end
		 end
		x_vlist$store(vlist, i, x, y, flags)
		end
	    if n > 2
	       then x, y, flags: int := x_vlist$fetch(vlist, n)
		    x_vlist$store(ovlist, n, x, y, flags)
		    x, y, flags := x_vlist$fetch(vlist, 1)
		    x_vlist$store(vlist, n, x, y,
				  flags + (VertexEndClosed - VertexStartClosed))
	       end
	    x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
	    x_window$draw(w, ovlist, n, 0, 1, 1, GXinvert, 1)
	    if count = 4
	       then count := 0
	       else count := count + 1
	       end
	    if count ~= 0  cor  ~x_input$pending()
	       then continue end
	    x_input$deq(ev)
	    if ev.kind = UnmapWindow
	       then x_input$deq(ev) end
	    if ev.kind = ExposeWindow
	       then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w)
		    if width <= 30  cor  height <= 30
		       then x_window$destroy(w)
			    return
		       end
		    height := height - 1
		    width := width - 1
		    x_window$clear(w)
		    x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
	     elseif ev.value = MiddleButton
	       then break end
	    end
	end
    end motiondemo