At 8:31 PM +1300 2/11/2000, Robert Purves wrote:
>Comments or further improvements are welcome.

I've completely rewritten the core of the program with a cleaner and
smaller algorithm.  Took me a while to get all the fine points right.
Comments welcome.  I think this new program should do everything
Robert's did but hopefully faster.  I tried to be careful about which
calculations are done.  I've turned off word wrapping so you should
get this program without that problem.

Michael

'---------A complete FB^3 or FBII program------------
' by Robert Purves 11 Feb 2000
' enhanced 18 Feb 2000 by Michael Kluskens)
COMPILE 1, _dimmedVarsOnly
DIM RECORD aballRec
 DIM xF!, yF!  ' position
 DIM xVF!, yVF!' velocity
 DIM oldRect.8, ballColor
DIM END RECORD.ballRec

DIM RECORD apreciseRect
 DIM yTopp!, xLeftp!, yBottomp!, xRightp!
DIM END RECORD.preciseRect

_hitVert = -1
_hitHoriz = -2

_bSize  = 20'20
_nBalls = 30 '90
_initSpeed = 6 '6
DIM gBall.ballRec(_nBalls), gRect.8, gBoundsRect.preciseRect
DIM gCollideDist!, gCollideDistSq!
DIM gOffPort&
END GLOBALS

'================challenge code===============
LOCAL FN Bounce(ball1&, ball2&)' pointers to 2 balls
' by Robert Purves 7 Feb 2000
' bounce conserves x- and y-momentum, and also
' the energy (sum of the squares of all velocity components)
DIM sineD!, cosineD!, dVD!, dVXF!, dVYF!
' calculate sin and cos of angle of line between centres
cosineD! = (ball1&.xF! - ball2&.xF!) / gCollideDist!
sineD!   = (ball1&.yF! - ball2&.yF!) / gCollideDist!
dVD! = (ball1&.xVF! - ball2&.xVF!)*cosineD!
dVD! = dVD! + (ball1&.yVF! - ball2&.yVF!)*sineD!
dVXF! = dVD!*cosineD!:  dVYF! = dVD!*sineD!
' give equal but opposite velocity changes to the 2 colliders
ball1&.xVF! = ball1&.xVF! - dVXF!
ball2&.xVF! = ball2&.xVF! + dVXF!
ball1&.yVF! = ball1&.yVF! - dVYF!
ball2&.yVF! = ball2&.yVF! + dVYF!
END FN

LOCAL FN TestCollides%(ballOne)
' by Michael Kluskens 18 Feb 2000
DIM ball1&, ball2&, k
DIM ballOneX!, ballOneY!
DIM ballOneVx!, ballOneVy!
DIM closest! ' original distance to closest appraoch
DIM closestCollision! ' closest distance to collision with any ball
DIM collision! ' original distance to collision
DIM delta2! ' square of distance between balls at closest approach
DIM dX!, dY! ' X,Y distances between balls
DIM fraction! ' collision's fractional distance from original position
DIM hitWhat ' what did we hit earliest along path, >0 a ball, <0 a wall
DIM toBall2! ' square of original distance between balls
DIM vBallOne! ' velocity of ball1
DIM vBallOne2! ' square of velocity of ball1
DIM xRange!, yRange! ' range of x,y that needs to be checked
DIM offset2! ' square of distance between collision & closest approach

hitWhat = 0 ' initialize
closestCollision! = 1e9
ball1& = @gBall(ballOne)
ballOneX! = ball1&.xF!' gain a little speed with...
ballOneY! = ball1&.yF!' ...these local variables
ballOneVx! = ball1&.xVF!
ballOneVy! = ball1&.yVF!
xRange! = ballOneVx! ' initially entire range of movement
yRange! = ballOneVy! '  needs to be checked for balls

' check if any balls could have been hit, keep info only on the ball hit earliest
FOR k = 1 TO _nBalls
LONG IF (ballOne <> k) ' don't compare with self
ball2& = @gBall(k) ' pointer to ball 2
' check box defined by ball 1's possible movement
dX! = ball2&.xF! - ballOneX!
LONG IF ( abs(-dX!+.5*xRange!) < abs(.5*xRange!) + gCollideDist! )
dY! = ball2&.yF! - ballOneY!
LONG IF ( ABS(-dY!+.5*yRange!) < abs(.5*yRange!) + gCollideDist!)
' velocity of ball 1 (only calculate once and only if needed)
if hitWhat = 0 Then vBallOne2! = ballOneVx! * ballOneVx! + ballOneVy! * ballOneVy!
' square of distance between ball 1 path and center of ball 2 (cross product of two vectors)
delta2! = (ballOneVx! * dY! - ballOneVy! * dX!)
delta2! = delta2! * delta2! / vBallOne2!
long if ( delta2! < gCollideDistSq! ) ' collision is possible
vBallOne! = sqr(vBallOne2!) ' do not do square root unless really needed
' point of closest approach: projection of ball 2 onto ball 1 path (dot product of two vectors)
closest! = (ballOneVx! * dX! + ballOneVy! * dY!) / vBallOne!
long if closest! > 0 ' look forward only (got to get the vectors right)
' square of distance between point of closest approach and collision point
offset2! = gCollideDistSq! - delta2!
if offset2! < 0.0 then offset2! = 0.0 ' possible with rounding errors and grazing incidence
' distance from original position to collision
collision! = closest! - SQR(offset2!)
' collision's fractional distance from original position
fraction! = collision! / vBallOne!
long if fraction! < 1.0 ' keep within present movement
long if fraction! < closestCollision!
xRange! = ballOneVx! * fraction!
yRange! = ballOneVy! * fraction!
closestCollision! = fraction!
hitWhat = k
end if
END IF
end if
end if
end if
END IF
END IF
NEXT

long if hitWhat = 0 ' ball can only hit a wall if no balls are in the way
' top or bottom wall bounces
select case
case ( ballOneY!+ballOneVy! < 0.0 ) ' bounce from top wall
long if ( ballOneVy! <> 0.0 ) ' protect against division by zero
closestCollision! = -ballOneY! / ballOneVy! ' intersection point
hitWhat = _hitVert ' value is zero so no comparison needed
end if
case (ballOneY!+ballOneVy! >= gBoundsRect.yBottomp!) ' bounce from bottom  wall
long if ( ballOneVy! <> 0.0 ) ' protect against division by zero
closestCollision! = ( gBoundsRect.yBottomp! - ballOneY! ) / ballOneVy! ' intersection point
hitWhat = _hitVert' value is zero so no comparison needed
end if
end select
' right or left wall bounce
select case
case ( ballOneX!+ballOneVx! < 0.0 )'left bounce
long if ( ballOneVx! <> 0.0 )' protect against division by zero
fraction! = -ballOneX! / ballOneVx! ' intersection point
long if fraction! < closestCollision! ' check if this is the closest wall
closestCollision! = fraction!
hitWhat = _hitHoriz
end if
end if
case ( ballOneX!+ballOneVx! >= gBoundsRect.xRightp! ) 'right bounce
long if ( ballOneVx! <> 0.0 )' protect against division by zero
fraction! = ( gBoundsRect.xRightp! - ballOneX! ) / ballOneVx! ' intersection point
long if fraction! < closestCollision!  ' check if this is the closest wall
closestCollision! = fraction!
hitWhat = _hitHoriz
end if
end if
END select
end if

' if something was hit now handle the collision
LONG if hitWhat <> 0
long IF (closestCollision! < 0.0)
closestCollision! = 0.0
xelse
' move forward fractional distance to collision point
ball1&.xF! = ballOneX! + closestCollision! * ballOneVx!
ball1&.yF! = ballOneY! + closestCollision! * ballOneVy!
end if
select case
case hitWhat > 0 ' collision with a ball
ball2& = @gBall(hitWhat)
FN Bounce (ball1&, ball2&)' handle the collision with closest ball
case hitWhat = _hitVert' handle top or bottom wall bounce
ball1&.yVF! = -ballOneVy!
case hitWhat = _hitHoriz' handle right or left wall bounce
ball1&.xVF! = -ballOneVx!
end SELECT
END IF
END FN = hitWhat

LOCAL FN MoveBalls
DIM k, hit%
FOR k = 1 TO _nBalls
hit% = FN TestCollides%(k) ' see if ball hit anything
long if hit% = 0 ' if nothing was hit then handle movement here
gBall.xF!(k) = gBall.xF!(k) + gBall.xVF!(k) ' new position
gBall.yF!(k) = gBall.yF!(k) + gBall.yVF!(k)
end if
NEXT
END FN
'=========end of challenge code===============

LOCAL FN InitBalls
DIM k, x, y
_extra = _bSize
_bSizePlus = _bSize_extra
x = _bSize_extra:  y = _bSize_extra
FOR k = 1 TO _nBalls
gBall.ballColor%(k) = RND(7)
gBall.xF!(k) =  x
gBall.yF!(k) =  y
gBall.xVF!(k) = RND(_initSpeed)
gBall.yVF!(k) = RND(_initSpeed)
x = x + _bSize_extra
LONG IF x > gRect.right% - _bSize_extra
x = _bSize_extra
y = y + _bSize_extra
END IF
NEXT
END FN

LOCAL FN ShowEnergy
' debugging aid - check that energy is conserved during collisions
DIM j, energy!, s$
energy! = 0.0
FOR j = 1 TO _nBalls
energy! = energy!+gBall.xVF!(j)*gBall.xVF!(j)+gBall.yVF!(j)*gBall.yVF!(j)
NEXT
energy! = energy!/_nBalls
COLOR = _zBlack: PRINT @(0,0) "Energy = " ; STR$(INT(100*energy!))
END FN

LOCAL FN DrawBalls
DIM j, myRect.8
COMPILE LONG IF _appleMenu = 255
DIM  wndPort&,GDevice&' FBII
COMPILE XELSE
DIM  @ wndPort&,GDevice&' don't use FB^3 register variables for these
COMPILE END IF

call getgworld(wndPort&,Gdevice&)
CALL SETGWORLD(gOffPort&,0)
CALL ERASERECT(gRect)
FN ShowEnergy
FOR j = 1 TO _nBalls
myRect.left% = gBall.xF!(j)
myRect.top% = gBall.yF!(j)
myRect.bottom% = myRect.top% + _bSize
myRect.right% = myRect.left% + _bSize
COLOR = gBall.ballColor%(j)
CALL PAINTOVAL(myRect)
NEXT
CALL SETGWORLD(wndPort&,GDevice&)
CALL COPYBITS(#gOffPort&+2,#wndPort&+2,gRect,gRect,_srcCopy,0)
END FN

WINDOW 1,"Balls",(0,0)-(620,420),_docNoGrow
MENU 1,0,1,"File"
MENU 1,1,1,"Quit/Q"
CALL TEXTMODE(_srcCopy)
gCollideDist!   = _bSize
gCollideDistSq! = gCollideDist!*gCollideDist!
gRect;8 = WINDOW(_wndPointer)+_portRect
gBoundsRect.yTopp!    = gRect.top%
gBoundsRect.xLeftp!   = gRect.left%
gBoundsRect.yBottomp! = gRect.bottom% - _bSize - 1
gBoundsRect.xRightp!  = gRect.right% - _bSize - 1

LONG IF (FN NEWGWORLD(gOffPort&,0,#@gRect,0,0,0) <> _noErr)
STOP
END IF
LONG IF (FN LOCKPIXELS(FN GETGWORLDPIXMAP(gOffPort&)) = 0)
STOP
END IF

RANDOMIZE 123
FN InitBalls
POKE LONG EVENT-8,0' fast HANDLEEVENTS
DO
FN DrawBalls
FN MoveBalls
HANDLEEVENTS
UNTIL 0