Galton box animation: Difference between revisions

Content added Content deleted

Inline

Revision as of 08:40, 26 June 2012

Generate an animated simulation of Sir Francis Galton's device. An example can be found to the right.

Example of a Galton Box at the end of animation.

In a Galton box, there are a set of pins arranged in a triangular pattern. A number of balls are dropped so that they fall in line with the top pin, deflecting to the left or the right of the pin. The ball continues to fall to the left or right of subsequent pins before arriving at one of the collection points between and to the sides of the bottom row of pins.

For the purpose of this task the box should have at least 5 pins on the bottom row. Your solution can use graphics or ASCII animation. Provide a sample of the output/display such as a screenshot.

Your solution can have either one or more balls in flight at the same time. If multiple balls are in flight, ensure they don't interfere with each other.

Your solution should allow users to specify the number of balls or it should run until full or a preset limit. Optionally, display the number of balls.

AutoHotkey

Uses an edit box for the (text based) animation <lang AutoHotkey>AutoTrim Off

User settings

bottompegs := 6 SleepTime := 200 fallspace := 30

create the board

out := (pad2 := Space(bottompegs*2+1)) "`n" Loop % bottompegs { out .= Space(bottompegs-A_Index+1) Loop % A_Index out .= "* " out .= Space(bottompegs-A_Index+1) . "`n" } StringTrimRight, strboard, out, 1 ; remove last newline Loop % fallspace-1 strboard .= "`n" . pad2 strboard .= "`n" Loop % bottompegs*2+1 strboard .= "="

Create Gui

Gui Font, , Consolas Gui -Caption Gui Margin, 0, 0 Gui, Add, edit, -VScroll vE, % strboard Gui Show Loop { ballX := bottompegs+1, BallY := 1 strboard := ChangeChar(strboard, BallX, ballY, "O") GuiControl,, E, % strboard sleep SleepTime ; Make ball fall and bounce Loop % bottompegs { strboard := ChangeChar(strboard, BallX, BallY, " ") ballY += 1 ballX += RandAdd() ; MsgBox % ballX ", " ballY GuiControl,, E, % strboard := ChangeChar(strboard, ballX, ballY, "O") sleep SleepTime } ; now fall to the bottom While GetChar(strboard, BallX, BallY+1) = A_Space { strboard := ChangeChar(strboard, BallX, BallY, " ") BallY += 1 strboard := ChangeChar(strboard, BallX, BallY, "O") GuiControl,, E, % strboard sleep SleepTime } } ~Esc:: GuiClose: ExitApp

Space(n){ If n return " " Space(n-1) return "" } RandAdd(){ Random, n, 3, 4 return (n=3 ? -1 : 1) }

GetChar(s, x, y){ Loop Parse, s, `n if (A_Index = y) return SubStr(A_LoopField, x, 1) } ChangeChar(s, x, y, c){ Loop Parse, s, `n { If (A_Index = y) { Loop Parse, A_LoopField If (A_Index = x) out .= c else out .= A_LoopField } else out .= A_LoopField out .= "`n" } StringTrimRight, out, out, 1 ; removes the last newline return out }</lang>While the number of pegs, and falling space are configurable, here's output shortly after starting one configuration:

            
      *       
     * *O     
    * * *     
   * * * *    
  * * * * *   
 * * * * * *  
             
             
    O        
  O O        
  O O O O    
O O O O O    
=============

C

<lang c>#include <stdio.h>

include <stdlib.h>
include <string.h>

define BALLS 1024

int n, w, h = 45, *x, *y, cnt = 0; char *b;

define B(y, x) b[(y)*w + x]
define C(y, x) ' ' == b[(y)*w + x]
define V(i) B(y[i], x[i])

inline int rnd(int a) { return (rand()/(RAND_MAX/a))%a; }

void show_board() { int i, j; for (puts("\033[H"), i = 0; i < h; i++, putchar('\n')) for (j = 0; j < w; j++, putchar(' ')) printf(B(i, j) == '*' ? C(i - 1, j) ? "\033[32m%c\033[m" : "\033[31m%c\033[m" : "%c", B(i, j)); }

void init() { int i, j; puts("\033[H\033[J"); b = malloc(w * h); memset(b, ' ', w * h);

x = malloc(sizeof(int) * BALLS * 2); y = x + BALLS;

for (i = 0; i < n; i++) for (j = -i; j <= i; j += 2) B(2 * i+2, j + w/2) = '*'; srand(time(0)); }

void move(int idx) { int xx = x[idx], yy = y[idx], c, kill = 0, sl = 3, o = 0;

if (yy < 0) return; if (yy == h - 1) { y[idx] = -1; return; }

switch(c = B(yy + 1, xx)) { case ' ': yy++; break; case '*': sl = 1; default: if (xx < w - 1 && C(yy, xx + 1) && C(yy + 1, xx + 1)) if (!rnd(sl++)) o = 1; if (xx && C(yy, xx - 1) && C(yy + 1, xx - 1)) if (!rnd(sl++)) o = -1; if (!o) kill = 1; xx += o; }

c = V(idx); V(idx) = ' '; idx[y] = yy, idx[x] = xx; B(yy, xx) = c; if (kill) idx[y] = -1; }

int run(void) { static int step = 0; int i; for (i = 0; i < cnt; i++) move(i); if (2 == ++step && cnt < BALLS) { step = 0; x[cnt] = w/2; y[cnt] = 0; if (V(cnt) != ' ') return 0; V(cnt) = rnd(80) + 43; cnt++; } return 1; }

int main(int c, char **v) { if (c < 2 || (n = atoi(v[1])) <= 3) n = 5; if (n >= 20) n = 20; w = n * 2 + 1; init();

do { show_board(), usleep(60000); } while (run());

return 0; }</lang>

Sample out put at begining of a run:

          *

        *   *

      *   *   *

    *   *   *   *

  *   *   *   *   *

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>

J

First, we need to a representation for our pins:

<lang j>initpins=: '* ' {~ '1'&i.@(-@|. |."_1 [: ":@-.&0"1 <:~/~)@i.</lang>

For example:

<lang j> initpins 4

  *   
 * *  
* * *

* * *</lang>

Note that we could introduce other pin arrangements, for example a Sierpinski triangle:

<lang j>initSpins=: [: }.@|. (1- 2&^@>:) ]\ [: ,] (,~ ,.~)@]^:[ ,: bind '* '</lang>

... but this will not be too interesting to use, because of the lack of interior pins for the balls to bounce off of.

Anyways, once we have that, we can add balls to our picture:

For example:

<lang j> 3 (init initpins) 4

   o    
   o    
   o    
        
   *    
  * *   
 * * *  
* * * * </lang>

Now we just need some way of updating our datastructure.

We will need a mechanism to shift a ball left or right if it's above a pin:

<lang>bounce=: (C.~ ] <"1@:+ 0 1 -~/~ ? @: (2"0))"1 [: I. 'o*'&E."1&.|:</lang>

And, a mechanism to make the balls fall:

<lang>shift=: 4 :0

 fill=. {.0#,y
 x |.!.fill y

)</lang>

And then we need to separate out the balls from the pins, so the balls fall and the pins do not. Note also that in this representation, balls will have to fall when they bounce because they cannot occupy the same space that a pin occupies.

We will also want some way of preventing the balls from falling forever. For this task it's probably sufficient to introduce a baseline sufficiently deep to hold the stacks and have balls instantly fall as close as they can to the baseline once they are past the pins.

<lang j>pins=: '*'&= balls=: 'o'&=

bounce=: (C.~ 0 1 <@(-/~) [: (+ ?@2:"0) I.)"1

nxt=: ' ',~ [: clean ' *o' {~ pins + 2 * _1 shift balls bounce balls *. 1 shift pins

clean2=: ({. , -.&' '"1&.|:&.|.@}.)~ 1 + >./@(# | '*' i:~"1 |:) clean1=: #~ 1 1 -.@E. *./"1@:=&' ' clean=: clean1@clean2</lang>

For example:

<lang j> nxt nxt 3 (init initpins) 4

   o    
   o    
  o*    
  * *   
 * * *  
* * * * 
        </lang>

Or, showing an entire animation sequence:

Prolog

Works with SWI-Prolog and XPCE. <lang Prolog>:- dynamic tubes/1.

- dynamic balls/2.

- dynamic stop/1.

% number of rows of pins (0 -> 9) row(9).

galton_box :- retractall(tubes(_)), retractall(balls(_,_)), retractall(stop(_)), assert(stop(@off)), new(D, window('Galton Box')), send(D, size, size(520,700)), display_pins(D), new(ChTubes, chain), assert(tubes(ChTubes)), display_tubes(D, ChTubes), new(Balls, chain), new(B, ball(D)), send(Balls, append, B), assert(balls(Balls, D)), send(D, done_message, and(message(ChTubes, clear), message(ChTubes, free), message(Balls, for_all, message(@arg1, free)), message(Balls, clear), message(Balls, free), message(@receiver, destroy))), send(D, open).

% class pin, balls travel between pins

- pce_begin_class(pin, circle, "pin").

initialise(P, Pos) :-> send(P, send_super, initialise, 18), send(P, fill_pattern, new(_, colour(@default, 0, 0, 0))), get(Pos, x, X), get(Pos, y, Y), send(P, geometry, x := X, y := Y).

- pce_end_class.

% class tube, balls fall in them

- pce_begin_class(tube, path, "tube where balls fall").

variable(indice, any, both, "index of the tube in the list"). variable(balls, any, both, "number of balls inside").

initialise(P, Ind, D) :-> row(Row), send(P, send_super, initialise, kind := poly), send(P, slot, balls, 0), send(P, slot, indice, Ind), X0 is 228 - Row * 20 + Ind * 40, X1 is X0 + 20, Y1 is 600, Y0 is 350, send_list(P, append, [point(X0, Y0), point(X0, Y1), point(X1,Y1), point(X1,Y0)]), send(D, display, P).

% animation stop when a tube is full add_ball(P) :-> get(P, slot, balls, B), B1 is B+1, send(P, slot, balls, B1), ( B1 = 12 -> retract(stop(_)), assert(stop(@on)) ; true).

- pce_end_class.

% class ball

- pce_begin_class(ball, circle, "ball").

variable(angle, any, both, "angle of the ball with the pin"). variable(dir, any, both, "left / right"). variable(pin, point, both, "pin under the ball when it falls"). variable(position, point, both, "position of the ball"). variable(max_descent, any, both, "max descent"). variable(state, any, both, "in_pins / in_tube"). variable(window, any, both, "window to display"). variable(mytimer, timer, both, "timer of the animation").

initialise(P, W) :-> send(P, send_super, initialise, 18), send(P, pen, 0), send(P, state, in_pins), send(P, fill_pattern, new(_, colour(@default, 65535, 0, 0))), Ang is 3 * pi / 2, send(P, slot, angle, Ang), send(P, slot, window, W), send(P, geometry, x := 250, y := 30), send(P, pin, point(250, 50)), send(P, choose_dir), send(P, mytimer, new(_, timer(0.005, message(P, move_ball)))), send(W, display, P), send(P?mytimer, start).

% method called when the object is destroyed % first the timer is stopped % then all the resources are freed unlink(P) :-> send(P?mytimer, stop), send(P, send_super, unlink).

choose_dir(P) :-> I is random(2), ( I = 1 -> Dir = left; Dir = right), send(P, dir, Dir).

move_ball(P) :-> get(P, state, State), ( State = in_pins -> send(P, move_ball_in_pins) ; send(P, move_ball_in_tube)).

move_ball_in_pins(P) :-> get(P, slot, angle, Ang), get(P, slot, pin, Pin), get(P, slot, dir, Dir), ( Dir = left -> Ang1 is Ang-0.15 ; Ang1 is Ang + 0.15), get(Pin, x, PX), get(Pin, y, PY), X is 21 * cos(Ang1) + PX, Y is 21 * sin(Ang1) + PY, send(P, geometry, x := X, y := Y), send(P?window, display, P), ( abs(Ang1 - pi) < 0.1 -> PX1 is PX - 20, send(P, next_move, PX1, PY) ; abs(Ang1 - 2 * pi) < 0.1 -> PX1 is PX + 20, send(P, next_move, PX1, PY) ; send(P, slot, angle, Ang1)).

next_move(P, PX, PY) :-> row(Row),

Ang2 is 3 * pi / 2, PY1 is PY + 30, ( PY1 =:= (Row + 1) * 30 + 50 -> send(P, slot, state, in_tube), NumTube is round((PX - 228 + Row * 20) / 40), tubes(ChTubes), get(ChTubes, find, message(@prolog, same_value,@arg1?indice, NumTube), Tube), send(Tube, add_ball), get(Tube, slot, balls, Balls), Max_descent is 600 - Balls * 20, send(P, slot, max_descent, Max_descent), send(P, slot, position, point(PX, PY)) ; send(P, choose_dir), send(P, slot, angle, Ang2), send(P, slot, pin, point(PX, PY1))).

move_ball_in_tube(P) :-> get(P, slot, position, Descente), get(Descente, x, PX1), get(Descente, y, PY), PY1 is PY+4, send(P, geometry, x := PX1, y := PY1), get(P, slot, max_descent, Max_descent), ( Max_descent =< PY1 -> send(P?mytimer, stop), ( stop(@off) -> send(@prolog, next_ball); true) ; send(P, slot, position, point(PX1, PY1))), send(P?window, display, P).

- pce_end_class.

next_ball :- retract(balls(Balls, D)), new(B, ball(D)), send(Balls, append, B), assert(balls(Balls, D)).

% test to find the appropriate tube same_value(V, V).

display_pins(D) :- row(Row), forall(between(0, Row, I), ( Start is 250 - I * 20, Y is I * 30 + 50, forall(between(0, I, J), ( X is Start + J * 40, new(P, pin(point(X,Y))), send(D, display, P))))).

display_tubes(D, Ch) :- row(Row), Row1 is Row+1, forall(between(0, Row1, I), ( new(T, tube(I, D)), send(Ch, append, T), send(D, display, T))). </lang>

PureBasic

Translation of: Unicon

<lang purebasic>Global pegRadius, pegSize, pegSize2, height, width, delay, histogramSize, ball

Procedure eventLoop()

 Protected event
 Repeat
   event = WindowEvent()
   If event = #PB_Event_CloseWindow
     End
   EndIf
 Until event = 0

EndProcedure

Procedure animate_actual(x1, y1, x2, y2, steps)

 Protected x.f, y.f, xstep.f, ystep.f, i, lastX.f, lastY.f
 x = x1
 y = y1
 xstep = (x2 - x1)/steps
 ystep = (y2 - y1)/steps
 For i = 1 To steps
   lastX = x
   lastY = y
   StartDrawing(CanvasOutput(0))
     DrawingMode(#PB_2DDrawing_XOr)
     Circle(x, y, pegRadius, RGB(0, 255, 255))
   StopDrawing()
   eventLoop()
   Delay(delay)      ; wait in ms
   StartDrawing(CanvasOutput(0))
     DrawingMode(#PB_2DDrawing_XOr)
     Circle(x, y, pegRadius, RGB(0, 255, 255))
   StopDrawing()
   eventLoop()
   x + xstep
   y + ystep
 Next

EndProcedure

Procedure draw_ball(xpos, ypos)

 Static Dim ballcounts(0) ;tally drop positions
 If xpos > ArraySize(ballcounts())
   Redim ballcounts(xpos)
 EndIf 
 ballcounts(xpos) + 1
 animate_actual(xpos, ypos, xpos, height - ballcounts(xpos) * pegSize, 20)
 StartDrawing(CanvasOutput(0))
   Circle(xpos, height - ballcounts(xpos) * pegSize, pegRadius, RGB(255, 0, 0))
 StopDrawing()
 eventLoop()
 If ballcounts(xpos) <= histogramSize
   ProcedureReturn 1 
 EndIf
 SetWindowTitle(0, "Ended after " + Str(ball) + " balls") ;histogramSize exceeded

EndProcedure

Procedure animate(x1, y1, x2, y2)

 animate_actual(x1, y1, x2, y1, 4)
 animate_actual(x2, y1, x2, y2, 10)

EndProcedure

Procedure galton(pegRows)

 ;drop a ball into the galton box
 Protected xpos, ypos, i, oldX, oldY

 oldX = width / 2 - pegSize / 2
 xpos = oldX
 oldY = pegSize
 ypos = oldY
 animate_actual(oldX, 0, xpos, ypos, 10)
 For i = 1 To pegRows 
   If Random(1)
     xpos + pegSize 
   Else
     xpos - pegSize
   EndIf 
   ypos + pegSize2
   animate(oldX, oldY, xpos, ypos)
   oldX = xpos
   oldY = ypos
 Next
 
 ProcedureReturn draw_ball(xpos, ypos)

EndProcedure

Procedure setup_window(numRows, ballCount)

 ;Draw numRows levels of pegs
 Protected xpos, ypos, i, j
 
 width = (2 * numRows + 2) * pegSize
 histogramSize = (ballCount + 2) / 3
 If histogramSize > 500 / pegSize: histogramSize = 500 / pegSize: EndIf
 height = width + histogramSize * pegSize
 OpenWindow(0, 0, 0, width, height, "Galton box animation", #PB_Window_SystemMenu)
 CanvasGadget(0, 0, 0, width, height) 
 
 StartDrawing(CanvasOutput(0))
   Box(0, 0, width, height, RGB($EB, $EB, $EB))
   For i = 1 To numRows
     ypos = i * pegSize2
     xpos = width / 2 - (i - 1) * pegSize - pegSize / 2
     For j = 1 To i
       Circle(xpos, ypos, pegRadius, RGB(0, 0, 255))
       xpos + pegSize2
     Next
   Next
   For i = 1 To numRows
     Line((numRows - i + 1) * pegSize2 - pegSize / 2, width - pegSize, 1, histogramSize * pegSize, 0)
   Next 
 StopDrawing()

EndProcedure

based on the galton box simulation from Unicon book

Define pegRows = 10, ballCount pegRadius = 4 pegSize = pegRadius * 2 + 1 pegSize2 = pegSize * 2 delay = 2 ; ms delay

Repeat

 ballCount = Val(InputRequester("Galton box simulator","How many balls to drop?", "100"))

Until ballCount > 0

setup_window(pegRows, ballCount) eventLoop() For ball = 1 To ballCount

 If Not galton(pegRows): Break: EndIf

Next Repeat: eventLoop(): ForEver</lang>

Ruby

Library: Shoes

<lang ruby>$rows_of_pins = 12 $width = $rows_of_pins * 10 + ($rows_of_pins+1)*14

Shoes.app(

   :width => $width + 14,
   :title => "Galton Box"

) do

 @bins = Array.new($rows_of_pins+1, 0)

 @x_coords = Array.new($rows_of_pins) {Array.new}
 @y_coords = Array.new($rows_of_pins)
 stack(:width => $width) do
   stroke gray
   fill gray
   1.upto($rows_of_pins) do |row|
     y = 14 + 24*row
     @y_coords[row-1] = y
     row.times do |i|
       x = $width / 2 + (i - 0.5*row)*24 + 14
       @x_coords[row-1] << x
       oval x+2, y, 6
     end
   end
 end
 @y_coords << @y_coords[-1] + 24
 @x_coords << @x_coords[-1].map {|x| x-12} + [@x_coords[-1][-1]+12]

 @balls = stack(:width => $width) do
   stroke red
   fill red
 end.move(0,0)

 @histogram = stack(:width => $width) do
   nostroke
   fill black
 end.move(0, @y_coords[-1] + 10)

 @paused = false
 keypress do |key|
   case key
   when "\x11", :control_q
     exit
   when "\x10", :control_p
     @paused = !@paused
   end
 end

 @ball_row = 0
 @ball_col = 0
 animate(2*$rows_of_pins) do
   if not @paused
     y = @y_coords[@ball_row] - 12
     x = @x_coords[@ball_row][@ball_col]
     @balls.clear {oval x, y, 10}
     @ball_row += 1
     if @ball_row <= $rows_of_pins
       @ball_col += 1 if rand >= 0.5
     else
       @bins[@ball_col] += 1
       @ball_row = @ball_col = 0
       update_histogram
     end
   end
 end

 def update_histogram
   y = @y_coords[-1] + 10
   @histogram.clear do
     @bins.each_with_index do |num, i|
       if num > 0
         x = @x_coords[-1][i]
         rect x-6, 0, 24, num
       end
     end
   end
 end

end</lang>

Tcl

Translation of: C

<lang tcl>package require Tcl 8.6

oo::class create GaltonBox {

   variable b w h n x y cnt step dropping

   constructor {BALLS {NUMPEGS 5} {HEIGHT 24}} {

set n $NUMPEGS set w [expr {$n*2 + 1}] set h $HEIGHT puts -nonewline "\033\[H\033\[J" set x [set y [lrepeat $BALLS 0]] set cnt 0 set step 0 set dropping 1

set b [lrepeat $h [lrepeat $w " "]] for {set i 0} {$i < $n} {incr i} { for {set j [expr {-$i}]} {$j <= $i} {incr j 2} { lset b [expr {2*$i+2}] [expr {$j+$w/2}] "*" } }

   method show {} {

puts -nonewline "\033\[H" set oldrow {} foreach row $b { foreach char $row oldchar $oldrow { if {$char ne "*"} { puts -nonewline "$char " } elseif {$oldchar eq " "} { puts -nonewline "\033\[32m*\033\[m " } else { puts -nonewline "\033\[31m*\033\[m " } } set oldrow $row puts "" }

   method Move idx {

set xx [lindex $x $idx] set yy [lindex $y $idx] set kill 0

if {$yy < 0} {return 0} if {$yy == $h-1} { lset y $idx -1 return 0 }

switch [lindex $b [incr yy] $xx] { "*" { incr xx [expr {2*int(2 * rand()) - 1}] if {[lindex $b [incr yy -1] $xx] ne " "} { set dropping 0 } } "o" { incr yy -1 set kill 1 } }

set c [lindex $b [lindex $y $idx] [lindex $x $idx]] lset b [lindex $y $idx] [lindex $x $idx] " " lset b $yy $xx $c if {$kill} { lset y $idx -1 } else { lset y $idx $yy } lset x $idx $xx return [expr {!$kill}]

   method step {} {

set moving 0 for {set i 0} {$i < $cnt} {incr i} { set moving [expr {[my Move $i] || $moving}] } if {2 == [incr step] && $cnt < [llength $x] && $dropping} { set step 0 lset x $cnt [expr {$w / 2}] lset y $cnt 0 if {[lindex $b [lindex $y $cnt] [lindex $x $cnt]] ne " "} { return 0 } lset b [lindex $y $cnt] [lindex $x $cnt] "o" incr cnt } return [expr {($moving || $dropping)}]

}

GaltonBox create board 1024 {*}$argv while true {

   board show
   if {[board step]} {after 60} break

}</lang> After a sample run with input parameters 10 55:

                                          
                                          
                    *                     
                                          
                  *   *                   
                                          
                *   *   *                 
                                          
              *   *   *   *               
                                          
            *   *   *   *   *             
                                          
          *   *   *   *   *   *           
                                          
        *   *   *   *   *   *   *         
                                          
      *   *   *   *   *   *   *   *       
                                          
    *   *   *   *   *   *   *   *   *     
                    o   o                 
  *   *   *   *   * o * o *   *   *   *   
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
                    o   o                 
            o       o   o                 
            o       o   o                 
            o       o   o                 
            o       o   o                 
            o       o   o                 
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
            o   o   o   o   o             
        o   o   o   o   o   o             
        o   o   o   o   o   o   o         
    o   o   o   o   o   o   o   o         
    o   o   o   o   o   o   o   o         
    o   o   o   o   o   o   o   o         
    o   o   o   o   o   o   o   o         
    o   o   o   o   o   o   o   o

There is a much more comprehensive solution to this on the Tcler's Wiki.

XPL0

This Peeks into some IBM-PC specific locations and hence is not entirely portable.

<lang XPL0>include c:\cxpl\codes; \intrinsic code declarations define Balls = 80; \maximum number of balls int Bx(Balls), By(Balls), \character cell coordinates of each ball

       W, I, J, Peg, Dir;

[W:= Peek($40, $4A); \get screen width in characters Clear; CrLf(6); CrLf(6); for Peg:= 1 to 10 do \draw pegs

       [for I:= 1 to 12-Peg do ChOut(6,^ );    \space over to first peg
        for I:= 1 to Peg do [ChOut(6,^.);  ChOut(6,^ )];
       CrLf(6);
       ];

for J:= 0 to 12-1 do \draw slots

       [for I:= 0 to 12-1 do [ChOut(6,^:);  ChOut(6,^ )];
       CrLf(6);
       ];

for I:= 0 to 23-1 do ChOut(6,^.); \draw bottom for I:= 0 to Balls-1 do \make source of balls at top

       [Bx(I):= 11;  By(I):= 1];

Attrib($C); \make balls bright red repeat \balls away! ...

   for I:= 0 to Balls-1 do                     \for all the balls ...
       [Cursor(Bx(I), By(I));  ChOut(6, ^ );   \erase ball's initial position
       if Peek($B800, (Bx(I)+(By(I)+1)*W)*2) = ^ \is ball above empty location?
       then    By(I):= By(I)+1                 \yes: fall straight down
       else    [Dir:= Ran(3)-1;                \no: randomly fall right or left
               if Peek($B800, (Bx(I)+Dir+(By(I)+1)*W)*2) = ^  then
                       [Bx(I):= Bx(I)+Dir;  By(I):= By(I)+1];
               ];
       Cursor(Bx(I), By(I));  ChOut(6, ^o);    \draw ball at its new position
       ];
   Sound(0, 3, 1);                             \delay about 1/6 second

until KeyHit; \continue until a key is struck ]</lang>

Example output:

           o
          o.
          .o.
         . .o.
        .o. . .
       . .o. . .
      . .o. . . .
     . .o. . .o. .
    . . .o. . . . .
   . . . . . .o. . .
  . . . . .o. .o. . .
: : : : : : : : : : : :
: : : : :o: : : : : : :
: : : :o: : : : : : : :
: : : : : : : : : : : :
: : : : :o: : : : : : :
: : : : : : : :o: : : :
: : : : : :o: : : : : :
: : :o: : :o: : : :o: :
: : : : : :o:o: : : : :
: : : : :o:o:o: : : : :
: : : : :o:o:o: : : : :
: : :o:o:o:o:o:o: : : :
.......................