Galton box animation

Galton box animation is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Generate a graphical animated simulation of Sir Francis Galton's device.

Icon and Unicon

The code here is adapted from the Unicon Book.

<lang Icon>link graphics

global pegsize, pegsize2, height, width, delay

procedure main(args) # galton box simulation from Unicon book

  pegsize2 := (pegsize := 10) * 2    # pegs & steps
  delay := 2                         # ms delay
  setup_galtonwindow(pegsize)
  n := integer(args[1]) | 100        # balls to drop 
  every 1 to n do galton(pegsize)
  WDone()

end

procedure setup_galtonwindow(n) # Draw n levels of pegs, local xpos, ypos, i, j

  # Pegboard size is 2n-1 square
  # Expected max value of histogram is (n, n/2)/2^n 
  # ... approximate with something simpler?

  height := n*n/2*pegsize + (width := (2*n+1)*pegsize)
  Window("size=" || width || "," || height, "fg=grayish-white")
  WAttrib("fg=dark-grey")
  every ypos := (i := 1 to n) * pegsize2 do {
     xpos := width/2 - (i - 1) * pegsize - pegsize/2 - pegsize2
     every 1 to i do
        FillArc(xpos +:= pegsize2, ypos, pegsize, pegsize)
     }
  WAttrib("fg=black","drawop=reverse")      # set drawing mode for balls

end

procedure galton(n) # drop a ball into the galton box local xpos, ypos, oldx, oldy

  xpos := oldx := width/2 - pegsize/2
  ypos := oldy := pegsize
  every 1 to n do {                         # For every ball...
     xpos +:= ((?2 = 1) | -1) * pegsize     # +/- pegsize
     animate(.oldx, .oldy, oldx := xpos, oldy := ypos +:= pegsize2)
     }
  animate(xpos, ypos, xpos, ypos + 40)      # Now the ball falls ...
  animate(xpos, ypos+40, xpos, ypos + 200)  # ... to the floor
  draw_ball(xpos)                           # Record this ball

end

procedure animate(xfrom, yfrom, xto, yto)

  animate_actual(xfrom, yfrom, xto, yfrom, 4)
  animate_actual(xto, yfrom, xto, yto, 10)

end

procedure animate_actual(xfrom, yfrom, xto, yto, steps) # attribs already set local x, y, xstep, ystep, lastx, lasty

  x -:= xstep := (xto - (x := xfrom))/steps
  y -:= ystep := (yto - (y := yfrom))/steps
  every 1 to steps do {      
     FillArc(lastx := x +:= xstep, lasty := y +:= ystep, pegsize, pegsize)
     WDelay(delay)      # wait in ms
     FillArc(x, y, pegsize, pegsize)
     }

end

procedure draw_ball(x) static ballcounts initial ballcounts := table(0)

  FillArc(x, height-(ballcounts[x] +:= 1)*pegsize, pegsize, pegsize)

end</lang>