% from Lucasfilm Ltd.

rec = record[dx, dy, x, y: int]
ar = array[rec]

tetrademo = proc ()
    bwidth: int := int$parse(xdemo_default("tetra", "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
    linepix: int := BlackPixel
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("tetra", "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)
	    back := x_pixmap$tile(pixs[1])
	    linepix := pixs[1] + plane
	    r, g, b: int := x_parse_color(xdemo_default("tetra", "Background"))
	       except when not_found:
			   r, g, b := x_display$query_color(WhitePixel)
		      end
	    x_display$store_color(pixs[1], r, g, b)
	    random_color(linepix)
       end
    w: x_window, wid0, hgt0: int := x_cons("tetra", back, bdr,
					   xdemo_geometry(), "=800x800+1+1",
					   40, 40, bwidth)
    w.name := "tetra"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    vlist: x_vlist := x_vlist$create(6 * 2)
    ev: event := x_input$empty_event()
    while true do
	x_window$clear(w)
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= 30  cor  height <= 30
	   then x_window$destroy(w)
		return
	   end
	a0: ar := ar$create(0)
	for i: int in int$from_to(0, 3) do
	    ar$addh(a0, rec${dx: 3 + random$next(4),
			     dy: 3 + random$next(4),
			     x:  random$next(width),
			     y:  random$next(height)})
	    end
	a1: ar := ar$copy(a0)
	delay: int := 6
	count: int := 0
	while count ~= 0  cor  ~x_input$pending() do
	    if count = 10
	       then count := 0
	       else count := count + 1
	       end
	    iterate(w, a0, width, height, linepix, plane, vlist)
	    if delay = 0
	       then iterate(w, a1, width, height, linepix, plane, vlist)
	       else delay := delay - 1
	       end
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    end tetrademo

iterate = proc (w: x_window, a: ar, width, height, pix, plane: int, vlist: x_vlist)
    idx: int := 1
    for i: int in int$from_to(1, 3) do
	ri: rec := a[i]
	for j: int in int$from_to(0, i - 1) do
	    rj: rec := a[j]
	    x_vlist$store(vlist, idx, ri.x, ri.y, VertexDontDraw)
	    x_vlist$store(vlist, idx + 1, rj.x, rj.y, VertexDrawLastPoint)
	    idx := idx + 2
	    end
	end
    x_window$draw(w, vlist, 12, 0, 1, 1, GXinvert, plane)
    for r: rec in ar$elements(a) do
	r.x := r.x + r.dx
	if r.x < 0  cor  r.x >= width
	   then r.x := r.x - 2 * r.dx
		r.dx := -r.dx
		if pix ~= BlackPixel
		   then random_color(pix) end
	   end
	r.y := r.y + r.dy
	if r.y < 0  cor  r.y >= height
	   then r.y := r.y - 2 * r.dy
		r.dy := -r.dy
		if pix ~= BlackPixel
		   then random_color(pix) end
	   end
	end
    end iterate