% from Lucasfilm Ltd.

ballsdemo = proc ()
    ai = array[int]
    n = 20
    bsize = 21
    rad = bsize / 2
    nx = 48
    ny = -36
    nz = 80
    qi = sequence[int]
    dmat = sequence[qi]$[qi$[1, 13, 4, 16],
			 qi$[9, 5, 12, 8],
			 qi$[3, 15, 2, 14],
			 qi$[11, 7, 10, 6]]

    bwidth: int := int$parse(xdemo_default("balls", "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
    if x_display$cells() > 2
       then begin
	    r, g, b: int := x_parse_color(xdemo_default("balls", "Border"))
	    bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
	    end except when not_found: end
	    cback: string := xdemo_default("balls", "Background")
	       except when not_found: cback := "" end
	    cfore: string := xdemo_default("balls", "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
	    x_display$store_color(pixs[1] + plane, r, g, b)
       end except when done: end
    w: x_window, wid0, hgt0: int := x_cons("balls", back, bdr,
					   xdemo_geometry(), "=400x400+1+1",
					   40, 40, bwidth)
    w.name := "balls"
    w.input := UnmapWindow
    x_window$map(w)
    w.input := ExposeWindow + UnmapWindow
    x: ai := ai$fill(0, n, 0)
    y: ai := ai$fill(0, n, 0)
    vx: ai := ai$fill(0, n, 0)
    vy: ai := ai$fill(0, n, 0)
    r: _wordvec := _wordvec$create(bsize)
    r[1] := 1
    swap: bool := _wordvec$bfetch(r, 1) = 0
    r[1] := 0
    for xx: int in int$from_to(-rad, rad) do
	maxy: int := isqrt(rad * rad - xx * xx)
	for yy: int in int$from_to(-maxy, maxy) do
	    if (nx * xx + ny * yy +
		nz * isqrt(rad * rad - xx * xx - yy * yy)) *
	       17 / (100 * rad) < dmat[xx // 4 + 1][yy // 4 + 1]
	       then yy := yy + rad + 1
		    r[yy] := r[yy] + 2 ** (xx + rad)
	       end
	    end
	end
    if swap
       then for i: int in int$from_to_by(1, 4 * bsize, 4) do
		v: int := _wordvec$bfetch(r, i)
		_wordvec$bstore(r, i, _wordvec$bfetch(r, i + 2))
		_wordvec$bstore(r, i + 2, v)
		v := _wordvec$bfetch(r, i + 1)
		_wordvec$bstore(r, i + 1, _wordvec$bfetch(r, i + 3))
		_wordvec$bstore(r, i + 3, v)
		end
       end
    ball: x_pixmap := x_pixmap$create(x_bitmap$create(bsize, bsize, r),
				      plane, 0)
    ev: event := x_input$empty_event()
    while true do
	sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
	if width <= 5 * bsize  cor  height <= 5 * bsize
	   then x_window$destroy(w)
		return
	   end
	x_window$clear(w)
	width := width - bsize
	height := height - bsize
	for i: int in int$from_to(0, n - 1) do
	    x[i] := random$next(width)
	    y[i] := random$next(height)
	    vx[i] := random$next(13) - 6
	    vy[i] := random$next(13) - 6
	    x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x[i], y[i],
				GXxor, plane)
	    end
	count: int := 0
	while count ~= 0  cor  ~x_input$pending() do
	    if count = 4
	       then count := 0
	       else count := count + 1
	       end
	    for i: int in int$from_to(0, n - 1) do
		x0: int := x[i]
		y0: int := y[i]
		xx: int := x0 + vx[i]
		if xx < 0
		   then xx := -xx
			vx[i] := -vx[i]
		 elseif xx >= width
		   then xx := 2 * (width - 1) - xx
			vx[i] := -vx[i]
		 end
		x[i] := xx
		yy: int := y0 + vy[i]
		if yy < 0
		   then yy := -yy
			vy[i] := -vy[i]
		 elseif yy >= height
		   then yy := 2* (height - 1) - yy
			vy[i] := -vy[i]
		 end
		y[i] := yy
		x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x0, y0,
				    GXxor, plane)
		x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, xx, yy,
				    GXxor, plane)
		end
	    for i: int in int$from_to(1, n - 1) do
		for j: int in int$from_to(0, i - 1) do
		    x0: int := x[i] - x[j]
		    y0: int := y[i] - y[j]
		    if int$abs(x0) >= bsize  cor  int$abs(y0) >= bsize  cor
		       x0 * x0 + y0 * y0 >= bsize * bsize
		       then continue end
		    if y0 < 0
		       then y0 := -y0
			    x0 := -x0
		       end
		    if rad * int$abs(x0) > rad * int$abs(y0)
		       then vx[i] := -vx[i]
			    vx[j] := -vx[j]
		     elseif rad * int$abs(y0) > (rad + 2) * int$abs(x0)
		       then vy[i] := -vy[i]
			    vy[j] := -vy[j]
		     elseif y0 > 0
		       then t: int := vx[i]
			    vx[i] := -vy[i]
			    vy[i] := -t
			    t := vx[j]
			    vx[j] := -vy[j]
			    vy[j] := -t
		     else t: int := vx[i]
			  vx[i] := -vy[i]
			  vy[i] := t
			  t := vx[j]
			  vx[j] := -vy[j]
			  vy[j] := t
		     end
		    end
		end
	    end
	x_input$deq(ev)
	if ev.kind = UnmapWindow
	   then x_input$deq(ev) end
	end
    end ballsdemo