125 lines
2.8 KiB
Text
125 lines
2.8 KiB
Text
Const boxW As Integer = 41 ' Galton box width
|
|
Const boxH As Integer = 37 ' Galton box height
|
|
Const pinsBaseW As Integer = 19 ' Pins triangle base
|
|
Const nMaxBalls As Integer = 55 ' Number of balls
|
|
|
|
Const centerH As Integer = pinsBaseW + (boxW - pinsBaseW * 2 + 1) / 2 - 1
|
|
|
|
Const empty As String = " "
|
|
Const ball As String = "o"
|
|
Const wall As String = "|"
|
|
Const corner As String = "+"
|
|
Const floor As String = "-"
|
|
Const pin As String = "."
|
|
|
|
Type Ball
|
|
x As Integer
|
|
y As Integer
|
|
End Type
|
|
|
|
Dim Shared box(boxH - 1, boxW - 1) As String
|
|
|
|
Sub initializeBox()
|
|
Dim As Integer r, c, nPins
|
|
' Set ceiling and floor
|
|
box(0, 0) = corner
|
|
box(0, boxW - 1) = corner
|
|
For c = 1 To boxW - 2
|
|
box(0, c) = floor
|
|
Next
|
|
For c = 0 To boxW - 1
|
|
box(boxH - 1, c) = box(0, c)
|
|
Next
|
|
|
|
' Set walls
|
|
For r = 1 To boxH - 2
|
|
box(r, 0) = wall
|
|
box(r, boxW - 1) = wall
|
|
Next
|
|
|
|
' Set rest to empty initially
|
|
For r = 1 To boxH - 2
|
|
For c = 1 To boxW - 2
|
|
box(r, c) = empty
|
|
Next
|
|
Next
|
|
|
|
' Set pins
|
|
For nPins = 1 To pinsBaseW
|
|
For c = 0 To nPins - 1
|
|
box(boxH - 2 - nPins, centerH + 1 - nPins + c * 2) = pin
|
|
Next
|
|
Next
|
|
End Sub
|
|
|
|
Sub drawBox()
|
|
Dim As Integer r, c
|
|
For r = boxH - 1 To 0 Step -1
|
|
For c = 0 To boxW - 1
|
|
Print box(r, c);
|
|
Next
|
|
Print
|
|
Next
|
|
End Sub
|
|
|
|
Function newBall(x As Integer, y As Integer) As Ball
|
|
If box(y, x) <> empty Then
|
|
Print "Tried to create a new ball in a non-empty cell. Program terminated."
|
|
End
|
|
End If
|
|
Dim b As Ball
|
|
b.x = x
|
|
b.y = y
|
|
box(y, x) = ball
|
|
Return b
|
|
End Function
|
|
|
|
Sub doStep(b As Ball)
|
|
If b.y <= 0 Then
|
|
Exit Sub ' Reached the bottom of the box
|
|
End If
|
|
Dim As String cell = box(b.y - 1, b.x)
|
|
Select Case cell
|
|
Case empty
|
|
box(b.y, b.x) = empty
|
|
b.y -= 1
|
|
box(b.y, b.x) = ball
|
|
Case pin
|
|
box(b.y, b.x) = empty
|
|
b.y -= 1
|
|
If box(b.y, b.x - 1) = empty And box(b.y, b.x + 1) = empty Then
|
|
b.x += Int(Rnd * 2) * 2 - 1
|
|
box(b.y, b.x) = ball
|
|
Exit Sub
|
|
Elseif box(b.y, b.x - 1) = empty Then
|
|
b.x += 1
|
|
Else
|
|
b.x -= 1
|
|
End If
|
|
box(b.y, b.x) = ball
|
|
Case Else
|
|
' It's frozen - it always piles on other balls
|
|
End Select
|
|
End Sub
|
|
|
|
Dim As Ball balls()
|
|
Dim As Integer i, j, ballCount
|
|
|
|
initializeBox()
|
|
For i = 0 To nMaxBalls + boxH - 1
|
|
Print !"\nStep"; i; ":"
|
|
If i < nMaxBalls Then
|
|
ballCount += 1
|
|
Redim Preserve balls(ballCount - 1)
|
|
balls(ballCount - 1) = newBall(centerH, boxH - 2) ' add ball
|
|
End If
|
|
drawBox()
|
|
|
|
' Next step for the simulation
|
|
' Frozen balls are kept in balls array for simplicity
|
|
For j = 0 To ballCount - 1
|
|
doStep(balls(j))
|
|
Next
|
|
Next
|
|
|
|
Sleep
|