Galton box animation: Difference between revisions
(→Tcl: Pointed to solution) |
(→{{header|Tcl}}: Put in a full solution (converted from C version, with quite a bit of adaptation)) |
||
Line 598: | Line 598: | ||
=={{header|Tcl}}== |
=={{header|Tcl}}== |
||
{{trans|C}} |
|||
There is a comprehensive solution to this on the [http://wiki.tcl.tk/8825 Tcler's Wiki].<!-- Too long to reproduce here --> |
|||
<lang tcl>package require TclOO |
|||
{{libheader|Tk}}{{libheader|Snack}} |
|||
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 <tt>10 55</tt>: |
|||
<pre> |
|||
* |
|||
* * |
|||
* * * |
|||
* * * * |
|||
* * * * * |
|||
* * * * * * |
|||
* * * * * * * |
|||
* * * * * * * * |
|||
* * * * * * * * * |
|||
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 |
|||
</pre> |
|||
There is a much more comprehensive solution to this on the [http://wiki.tcl.tk/8825 Tcler's Wiki].<!-- Too long to reproduce here --> |
|||
{{omit from|GUISS}} |
{{omit from|GUISS}} |
Revision as of 21:52, 28 December 2011
You are encouraged to solve this task according to the task description, using any language you may know.
Generate an animated simulation of Sir Francis Galton's device. An example can be found to the right.
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:
<lang j>init=: ' ',. ' ',.~ ] ,~ ' ',~ ' o' {~ (# ' ' ~: 1&{.)</lang>
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:
<lang j> nxt&.>^:a: <7 (init ' ',.' ',.~ initpins) 5 ┌─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┬─────────────┐ │ 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 │ │ * * * │ * * * │ * * * * │ * * * * * │ │ │ │ │ │ │ │ │ │ │ │ * * * * │ * * * * │ * * * * * │ │ │ │ │ │ │ │ │ │ │ │ │ * * * * * │ * * * * * │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ └─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┴─────────────┘</lang>
PureBasic
<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
<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
<lang tcl>package require TclOO
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.