Microsoft Small Basic

Program Listing: PMT149

List Program

'Initialise graphics window
GraphicsWindow.Hide()
gw = 800
gh = 600
GraphicsWindow.CanResize = "False"
GraphicsWindow.Top = (Desktop.Height-gh)/2
GraphicsWindow.Left = (Desktop.Width-gw)/2
GraphicsWindow.Title = "Bouncing balls with realistic collision physics"
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.BackgroundColor = "LightBlue"

'Reduce gw for options
gw = gw-200
GraphicsWindow.MouseDown = OnMouseDown

Start:

' Gravity, friction and attraction to mouse
grav = 0.0 ' 0 for none
fric = 0 ' 0 for none
follow = 0 'attract to mouse
attract = 0 'attract balls to each other
dt = 1 'timestep (speed)
shape = 0 '0:ball,1 square
elastic = 1 '1 fully elastic collisions
Colour = "Yellow"

'Initialise some balls
radius = 20
diam = 2*radius
nball = Math.Floor(gw/diam)
istart = "True"
reset()
ireset = "False"
istart = "False"
iend = "False"
iselect = "False"
ioptions = "False"

'Show window - an MS comment
GraphicsWindow.Show()

'Main loop
While ("True")
If (ioptions) Then
options()
ioptions = "False"
EndIf
energy = 0.0
isCollision = "False"
If (iselect) Then
For i = 1 To nball
x = Xpos[i]
y = Ypos[i]
dist = (xm-x)*(xm-x)+(ym-y)*(ym-y)
If (dist < radius*radius) Then
u = 0
v = 0
Xvel[i] = u
Yvel[i] = v
EndIf
EndFor
iselect = "False"
EndIf
For i = 1 To nball
update()
move()
u = Xvel[i]
v = Yvel[i]
energy = energy+(u*u+v*v)
EndFor
energy = dt*dt*energy
energy = Math.Floor(energy)
GraphicsWindow.BrushColor = "LightBlue"
GraphicsWindow.FillRectangle(gw+15,560,190,20)
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(gw+65,560,"Energy "+energy)
If (ireset) Then
reset()
ireset = "False"
EndIf
If (istart) Then
Goto Start
EndIf
If (iend) Then
Program.End()
EndIf
' If (isCollision) Then
' Sound.PlayClick()
' EndIf
Program.Delay(10)
EndWhile

'Update ball positions
Sub update
u = Xvel[i]
v = Yvel[i]
u = Math.Min(100,Math.Max(u,-100))
v = Math.Min(100,Math.Max(v,-100))
x = Xpos[i]+dt*u
y = Ypos[i]+dt*v
bounce()
gravity()
collision()
attraction()
Xpos[i] = x
Ypos[i] = y
EndSub

'Check for edge bounces
Sub bounce
If (x < radius) Then
Xvel[i] = -Xvel[i]
x = radius
EndIf
If (x > gw-radius) Then
Xvel[i] = -Xvel[i]
x = gw-radius
EndIf
If (y < radius) Then
Yvel[i] = -Yvel[i]
y = radius
EndIf
If (y > gh-radius) Then
Yvel[i] = -Yvel[i]
y = gh-radius
EndIf
EndSub

'Check for collisions
Sub collision
'Only check each pair once
For j = i+1 To nball
xi = x
yi = y
xj = Xpos[j]
yj = Ypos[j]
dx = xi-xj
dy = yi-yj
dist = Math.SquareRoot(dx*dx+dy*dy)
If (dist < diam) Then
isCollision = "True"
'Get ball vectors
ui = Xvel[i]
vi = Yvel[i]
uj = Xvel[j]
vj = Yvel[j]
'Move backwards (forwards if dt < 0) in time until balls are just touching
CoefA = (ui-uj)*(ui-uj)+(vi-vj)*(vi-vj)
CoefB = 2*((ui-uj)*(xi-xj)+(vi-vj)*(yi-yj))
CoefC = (xi-xj)*(xi-xj)+(yi-yj)*(yi-yj)-diam*diam
If (CoefA = 0) Then
t = -CoefC/CoefB
Else
If (dt >= 0) Then
t = (-CoefB-Math.SquareRoot(CoefB*CoefB-4*CoefA*CoefC))/(2*CoefA)
Else
t = (-CoefB+Math.SquareRoot(CoefB*CoefB-4*CoefA*CoefC))/(2*CoefA)
EndIf
EndIF
xi = xi+t*ui
yi = yi+t*vi
xj = xj+t*uj
yj = yj+t*vj
'Centre of momentum coordinates
mx = (ui+uj)/2
my = (vi+vj)/2
ui = ui-mx
vi = vi-my
uj = uj-mx
vj = vj-my
'New centre to centre line
dx = xi-xj
dy = yi-yj
dist = Math.SquareRoot(dx*dx+dy*dy)
dx = dx/dist
dy = dy/dist
'Reflect balls velocity vectors in centre to centre line
OB = -(dx*ui+dy*vi)
ui = ui+2*OB*dx
vi = vi+2*OB*dy
OB = -(dx*uj+dy*vj)
uj = uj+2*OB*dx
vj = vj+2*OB*dy
'Back to moving coordinates with elastic velocity change
e = Math.SquareRoot(elastic)
ui = e*(ui+mx)
vi = e*(vi+my)
uj = e*(uj+mx)
vj = e*(vj+my)
'Move to new bounced position
xi = xi-t*ui
yi = yi-t*vi
xj = xj-t*uj
yj = yj-t*vj
'Set velocities
Xvel[i] = ui
Yvel[i] = vi
Xvel[j] = uj
Yvel[j] = vj
'Set position
Xpos[j] = xj
Ypos[j] = yj
x = xi
y = yi
EndIf
EndFor
EndSub

'Gravity and friction and follow mouse
Sub gravity
xm = GraphicsWindow.MouseX-x
ym = GraphicsWindow.MouseY-y
dist = xm*xm+ym*ym
dist = Math.Max(dist,radius*radius)
'dist = dist*Math.SquareRoot(dist)
u = Xvel[i]
v = Yvel[i]
fricscale = (1-fric/Math.SquareRoot(1+u*u+v*v))
Xvel[i] = follow*xm/dist+fricscale*u
Yvel[i] = follow*ym/dist+fricscale*v+grav
EndSub

'Attract-repell balls to each other
Sub attraction
If (attract <> 0) Then
For j = i+1 To nball
xm = Xpos[j]-x
ym = Ypos[j]-y
dist = xm*xm+ym*ym
dist = Math.Max(dist,radius*radius)
'dist = dist*Math.SquareRoot(dist)
Xvel[i] = attract*xm/dist+Xvel[i]
Yvel[i] = attract*ym/dist+Yvel[i]
Xvel[j] = attract*xm/dist+Xvel[j]
Yvel[j] = -attract*ym/dist+Yvel[j]
EndFor
EndIf
EndSub

'Move ball
Sub move
ball = balls[i]
Shapes.Move(ball,x-radius,y-radius)
EndSub

'Update options display
Sub options
GraphicsWindow.PenColor = "Black"
GraphicsWindow.DrawLine(gw,0,gw,gh)
GraphicsWindow.BrushColor = "LightBlue"
GraphicsWindow.FillRectangle(gw+10,10,190,gh-20)
For i = 0 To 5
GraphicsWindow.DrawLine(gw+10,100*i+10,gw+190,100*i+10)
EndFor
GraphicsWindow.DrawLine(gw+100,10,gw+100,510)

GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawBoundText(gw+15,20,70,"Gravity")
GraphicsWindow.DrawBoundText(gw+15,40,70,grav)
GraphicsWindow.DrawBoundText(gw+15,120,70,"Friction")
GraphicsWindow.DrawBoundText(gw+15,140,70,fric)
GraphicsWindow.DrawBoundText(gw+15,220,70,"Follow")
GraphicsWindow.DrawBoundText(gw+15,240,70,follow)
GraphicsWindow.DrawBoundText(gw+15,320,70,"Size")
GraphicsWindow.DrawBoundText(gw+15,340,70,radius)
GraphicsWindow.DrawBoundText(gw+15,420,70,"Count")
GraphicsWindow.DrawBoundText(gw+15,440,70,nball)
GraphicsWindow.DrawBoundText(gw+15,520,170,"Click coloured options or a ball to stop it")
GraphicsWindow.BrushColor = "Red"
GraphicsWindow.DrawBoundText(gw+15,580,50,"RESET")
GraphicsWindow.DrawBoundText(gw+115,580,50,"QUIT")
GraphicsWindow.DrawBoundText(gw+15,60,70,"More")
GraphicsWindow.DrawBoundText(gw+15,160,70,"More")
GraphicsWindow.DrawBoundText(gw+15,260,70,"More")
GraphicsWindow.DrawBoundText(gw+15,360,70,"More")
GraphicsWindow.DrawBoundText(gw+15,460,70,"More")
GraphicsWindow.BrushColor = "Blue"
GraphicsWindow.DrawBoundText(gw+15,80,70,"Less")
GraphicsWindow.DrawBoundText(gw+15,180,70,"Less")
GraphicsWindow.DrawBoundText(gw+15,280,70,"Less")
GraphicsWindow.DrawBoundText(gw+15,380,70,"Less")
GraphicsWindow.DrawBoundText(gw+15,480,70,"Less")

GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawBoundText(gw+115,20,70,"Speed")
GraphicsWindow.DrawBoundText(gw+115,40,70,dt)
GraphicsWindow.DrawBoundText(gw+115,120,70,"Attraction")
GraphicsWindow.DrawBoundText(gw+115,140,70,attract)
GraphicsWindow.DrawBoundText(gw+115,220,70,"Elastic")
GraphicsWindow.DrawBoundText(gw+115,240,70,elastic)
GraphicsWindow.DrawBoundText(gw+115,320,70,"Colour")
GraphicsWindow.BrushColor = "Red"
GraphicsWindow.DrawBoundText(gw+115,60,70,"More")
GraphicsWindow.DrawBoundText(gw+115,160,70,"More")
GraphicsWindow.DrawBoundText(gw+115,260,70,"More")
GraphicsWindow.BrushColor = "Blue"
GraphicsWindow.DrawBoundText(gw+115,80,70,"Less")
GraphicsWindow.DrawBoundText(gw+115,180,70,"Less")
GraphicsWindow.DrawBoundText(gw+115,280,70,"Less")
GraphicsWindow.BrushColor = "Red"
GraphicsWindow.DrawBoundText(gw+115,340,70,"Red")
GraphicsWindow.BrushColor = "Blue"
GraphicsWindow.DrawBoundText(gw+115,360,70,"Blue")
GraphicsWindow.BrushColor = "Yellow"
GraphicsWindow.DrawBoundText(gw+115,380,70,"Yellow")
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawBoundText(gw+115,420,70,"Shape")
GraphicsWindow.BrushColor = "Red"
GraphicsWindow.DrawBoundText(gw+115,440,70,"Circle")
GraphicsWindow.DrawBoundText(gw+115,460,70,"Square")
EndSub

'Change settings
Sub OnMouseDown
xm = GraphicsWindow.MouseX
ym = GraphicsWindow.MouseY
'Left column settings
If (xm > gw+15 And xm < gw+85) Then
If (ym > 60 And ym < 75) Then
grav = grav+0.01
EndIf
If (ym > 80 And ym < 95) Then
grav = grav-0.01
EndIf
If (ym > 160 And ym < 175) Then
fric = fric+0.001
EndIf
If (ym > 180 And ym < 195) Then
fric = fric-0.001
EndIf
If (ym > 260 And ym < 275) Then
follow = follow+1
EndIf
If (ym > 280 And ym < 295) Then
follow = follow-1
EndIf
If (ym > 360 And ym < 375) Then
radius = radius+1
diam = 2*radius
ireset = "True"
EndIf
If (ym > 380 And ym < 395) Then
radius = radius-1
radius = Math.Max(1,radius)
diam = 2*radius
ireset = "True"
EndIf
If (ym > 460 And ym < 475) Then
nball = nball+1
ireset = "True"
EndIf
If (ym > 480 And ym < 495) Then
nball = nball-1
nball = Math.Max(1,nball)
ireset = "True"
EndIf
If (ym > 580 And ym < 595) Then
istart = "True"
EndIf
EndIf
'Right column settings
If (xm > gw+115 And xm < gw+185) Then
If (ym > 60 And ym < 75) Then
dt = dt+0.1
EndIf
If (ym > 80 And ym < 95) Then
dt = dt-0.1
EndIf
If (ym > 160 And ym < 175) Then
attract = attract+1
EndIf
If (ym > 180 And ym < 195) Then
attract = attract-1
EndIf
If (ym > 260 And ym < 275) Then
elastic = elastic+0.01
EndIf
If (ym > 280 And ym < 295) Then
elastic = elastic-0.01
EndIf
If (ym > 340 And ym < 355) Then
Colour = "Red"
ireset = "True"
EndIf
If (ym > 360 And ym < 375) Then
Colour = "Blue"
ireset = "True"
EndIf
If (ym > 380 And ym < 395) Then
Colour = "Yellow"
ireset = "True"
EndIf
If (ym > 440 And ym < 455) Then
Shape = 0
ireset = "True"
EndIf
If (ym > 460 And ym < 475) Then
Shape = 1
ireset = "True"
EndIf
If (ym > 580 And ym < 595) Then
iend = "True"
EndIf
EndIf
'Select a ball
If (xm < gw) Then
iselect = "True"
EndIf
ioptions = "True"
EndSub

'Reset new balls
Sub reset
mball = Array.GetItemCount(balls)
For i = 1 To mball
balls[i] = ""
If (istart Or i > nball) Then
Xpos[i] = ""
Ypos[i] = ""
Xvel[i] = ""
Yvel[i] = ""
EndIf
EndFor
GraphicsWindow.Clear()
options()
GraphicsWindow.BrushColor = Colour
For i = 1 To nball
If (shape = 0) Then
ball = Shapes.AddEllipse(diam,diam)
EndIf
If (shape = 1) Then
ball = Shapes.AddRectangle(diam,diam)
EndIf
balls[i] = ball
If (istart Or i > mball) Then
x = Math.GetRandomNumber(gw)
y = Math.GetRandomNumber(gh)
u = Math.GetRandomNumber(500)/100-3
v = Math.GetRandomNumber(500)/100-3
Xpos[i] = x
Ypos[i] = y
Xvel[i] = u
Yvel[i] = v
EndIf
EndFor
EndSub