Const TIMESTEP
= 1 / 30 ' total engine updates per second - should match any _LIMIT FPS in program Const ROUND
= 0, SQUARE
= 1
Inuse
As Integer ' is object currently in use (TRUE / FALSE) Xvel
As Single ' horizontal velocity of object Yvel
As Single ' vertical velocity of object Gravity
As Single ' object is affected by gravity (0 = no gravity, >0 gravity present) Friction
As Single ' object has friction (0 = no friction, >0 friction present, use small increments of .1) Attract
As Single ' amount of attraction to another object (0 = no attraction, <0 = repulsion, >0 = attraction) AttractedTo
As Integer ' handle of object attracted to Elastic
As Single ' object has elastic collisions Fixed
As Integer ' object is in a fixed position (TRUE / FALSE) MaxSpeed
As Single ' object's maximum speed Shape
As Integer ' object's shape (0 for circle, 1 for square)
ReDim Object
(0) As OBJECT
' array to hold objects Dim rndRadius!
, rndXpos!
, rndYpos!
, rndXvel!
, rndYvel!
Dim OldMouseX%
, OldMouseY%
For Count%
= 1 To BALLS
' create random ball objects rndRadius!
= Int(Rnd(1) * 20) + 10 Ball%(Count%) = DEFINEOBJECT(ROUND, rndRadius!)
APPLYFRICTION Ball%(Count%), .01
APPLYMAXSPEED Ball%(Count%), 100
APPLYELASTIC Ball%(Count%), 1
rndXpos!
= Int(Rnd(1) * (SWIDTH
- 1 - OBJECTRADIUS
(Ball%
(Count%
)) * 2)) + OBJECTRADIUS
(Ball%
(Count%
)) rndYpos!
= Int(Rnd(1) * (SHEIGHT
- 1 - OBJECTRADIUS
(Ball%
(Count%
)) * 2)) + OBJECTRADIUS
(Ball%
(Count%
)) rndXvel!
= (Rnd(1) - Rnd(1)) '* 3 rndYvel!
= (Rnd(1) - Rnd(1)) '* 3 PUTOBJECT Ball%(Count%), rndXpos!, rndYpos!, rndXvel!, rndYvel!, NONFIXED ' define where ball resides
Paddle% = DEFINEOBJECT(ROUND, 40) ' create a fixed ball with radius of 40
APPLYELASTIC Paddle%, .1 ' give a slightly bouncy surface
PUTOBJECT Paddle%, SWIDTH / 2 - 1, SHEIGHT / 2 - 1, 0, 0, FIXED ' define where object resides
_Limit 30 ' we limit simulation to 30FPS - note that TIMESTEP constant should match this to avoid tunneling through objects SETOBJECTX Paddle%
, _MouseX ' set paddle object X location SETOBJECTY Paddle%
, _MouseY ' set paddle object Y location SETOBJECTXVEL Paddle%, OBJECTX(Paddle%) - OldMouseX% ' set paddle object X velocity
SETOBJECTYVEL Paddle%, OBJECTY(Paddle%) - OldMouseY% ' set paddle object Y velocity
OldMouseX% = OBJECTX(Paddle%) ' remember paddle X position
OldMouseY% = OBJECTY(Paddle%) ' remember paddle Y location
For Count%
= 1 To BALLS
' Dummy% = INTERACTION(Ball%(Count%)) ' check this ball's interaction with all other objects
If OBJECTX
(Ball%
(Count%
)) < OBJECTRADIUS
(Ball%
(Count%
)) Then ' keep balls constrained to screen SETOBJECTXVEL Ball%(Count%), -OBJECTXVEL(Ball%(Count%))
SETOBJECTX Ball%(Count%), OBJECTRADIUS(Ball%(Count%))
If OBJECTX
(Ball%
(Count%
)) > SWIDTH
- OBJECTRADIUS
(Ball%
(Count%
)) Then SETOBJECTXVEL Ball%(Count%), -OBJECTXVEL(Ball%(Count%))
SETOBJECTX Ball%(Count%), SWIDTH - OBJECTRADIUS(Ball%(Count%))
If OBJECTY
(Ball%
(Count%
)) < OBJECTRADIUS
(Ball%
(Count%
)) Then SETOBJECTYVEL Ball%(Count%), -OBJECTYVEL(Ball%(Count%))
SETOBJECTY Ball%(Count%), OBJECTRADIUS(Ball%(Count%))
If OBJECTY
(Ball%
(Count%
)) > SHEIGHT
- OBJECTRADIUS
(Ball%
(Count%
)) Then SETOBJECTYVEL Ball%(Count%), -OBJECTYVEL(Ball%(Count%))
SETOBJECTY Ball%(Count%), SHEIGHT - OBJECTRADIUS(Ball%(Count%))
Circle (OBJECTX
(Ball%
(Count%
)), OBJECTY
(Ball%
(Count%
))), OBJECTRADIUS
(Ball%
(Count%
)), Bcolor~&
(Count%
) Paint (OBJECTX
(Ball%
(Count%
)), OBJECTY
(Ball%
(Count%
))), Bcolor~&
(Count%
), Bcolor~&
(Count%
) Circle (OBJECTX
(Paddle%
), OBJECTY
(Paddle%
)), OBJECTRADIUS
(Paddle%
), _RGB32(255, 255, 255) Paint (OBJECTX
(Paddle%
), OBJECTY
(Paddle%
)), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
'------------------------------------------------------------------------------
'**
'** returns the Y velocity of an object
'**
OBJECTYVEL = Object(Handle%).Yvel
'------------------------------------------------------------------------------
Sub SETOBJECTY
(Handle%
, Ypos!
)
'**
'** returns the Y location of an object
'**
Object(Handle%).Ypos = Ypos!
'------------------------------------------------------------------------------
Sub SETOBJECTYVEL
(Handle%
, Yvel!
)
'**
'** sets the Y velocity of an object
'**
Object(Handle%).Yvel = Yvel!
'------------------------------------------------------------------------------
Sub SETOBJECTX
(Handle%
, Xpos!
)
'**
'** sets the X location of an object
'**
Object(Handle%).Xpos = Xpos!
'------------------------------------------------------------------------------
'**
'** returns the X velocity of an object
'**
OBJECTXVEL = Object(Handle%).Xvel
'------------------------------------------------------------------------------
Sub SETOBJECTXVEL
(Handle%
, Xvel!
)
'**
'** sets the X velocity of an object
'**
Object(Handle%).Xvel = Xvel!
'------------------------------------------------------------------------------
'**
'** defines an object (very basic, not finished yet)
'**
Object(ob%).Inuse = -1
Object(ob%).Xpos = 0
Object(ob%).Ypos = 0
Object(ob%).Xvel = 0
Object(ob%).Yvel = 0
Object(ob%).Radius = Radius!
Object(ob%).Gravity = 0
Object(ob%).Friction = 0
Object(ob%).Attract = 0
Object(ob%).AttractedTo = 0
Object(ob%).Elastic = 1
Object(ob%).Fixed = 0
Object(ob%).MaxSpeed = 100
Object(ob%).Shape = Shape%
DEFINEOBJECT = ob%
'------------------------------------------------------------------------------
'**
'** returns the radius of an object
'**
OBJECTRADIUS = Object(Handle%).Radius
'------------------------------------------------------------------------------
'**
'** returns the Y location of an object
'**
OBJECTY = Object(Handle%).Ypos
'------------------------------------------------------------------------------
'**
'** returns the X location of an object
'**
OBJECTX = Object(Handle%).Xpos
'------------------------------------------------------------------------------
Sub APPLYMAXSPEED
(Handle%
, Maxspeed!
)
'**
'** sets the maximum speed of an object (setting too low causes 45 degree movement, need to investigate)
'**
Object(Handle%).MaxSpeed = Maxspeed!
'------------------------------------------------------------------------------
Sub APPLYELASTIC
(Handle%
, Elastic!
)
'**
'** sets the elastic property of an object (setting too low allows tunneling, need to investigate)
'**
Object(Handle%).Elastic = Elastic!
'------------------------------------------------------------------------------
Sub APPLYATTRACTION
(Handle%
, HandleTo%
, Attract!
)
'**
'** sets the attration to another object
'**
Object(Handle%).Attract = Attract!
Object(Handle%).AttractedTo = HandleTo%
'------------------------------------------------------------------------------
Sub APPLYFRICTION
(Handle%
, Friction!
)
'**
'** sets the friction amount for an object
'**
Object(Handle%).Friction = Friction!
'------------------------------------------------------------------------------
Sub APPLYGRAVITY
(Handle%
, Gravity!
)
'**
'** sets the amount of gravity on an object
'**
Object(Handle%).Gravity = Gravity!
'------------------------------------------------------------------------------
Sub PUTOBJECT
(Handle%
, Xpos!
, Ypos!
, Xvel!
, Yvel!
, Fixed%
)
'**
'** defines where object resides
'**
Object(Handle%).Xpos = Xpos!
Object(Handle%).Ypos = Ypos!
Object(Handle%).Xvel = Xvel!
Object(Handle%).Yvel = Yvel!
Object(Handle%).Fixed = Fixed%
'------------------------------------------------------------------------------
'**
'** Checks the interaction between objects for a collision then calculates
'** the new object position based on those calculations.
'**
'** H1% - handle of object to test for collision
'**
'** Returns: 0 (FALSE) if no collision occured
'** >0 the object that was collided with
'**
'** Function also updates gravity, friction and repulsion/attraction between the two objects.
'**
'** Note: this function is far from complete. Variables need to be updated with variables names and
'** types identifiers that make sense.
'**
Dim Diameter!
' the radius of object 1 plus the radius of object 2 Dim Distance!
' the distance from the center point of object 1 to the center point of object 2 Dim FrictionScale!
' amount of frictional force to add to an object Dim Xdifference!
' the distance between object 1 X position and object 2 X position Dim Ydifference!
' the distance between object 1 Y position and onject 2 Y position Dim H1Xvel!
, H1Yvel!
, H1Xpos!
, H1Ypos!
' object 1's X and Y velocities and X and Y positions Dim H2Xvel!
, H2Yvel!
, H2Xpos!
, H2Ypos!
' object 2's X and Y velocities and X and Y positions Dim cH1Xvel!
, cH1Yvel!
, cH1Xpos!
, cH1Ypos!
' object 1's X and Y velocities and X and Y positions Dim cH2Xvel!
, cH2Yvel!
, cH2Xpos!
, cH2Ypos!
' object 2's X and Y velocities and X and Y positions Dim CoefA!
, CoefB!
, CoefC!
' object collision time coefficients Dim TouchTime!
' actual time when object's touched Dim MomentumX!
, MomentumY!
' momentum loss of objects when collision occurred Dim OB!
' center line velocity vector Dim Elastic!
' amount of elasticity applied to objects
If Object
(H1%
).Fixed
Then Exit Function ' if object is in a fixed position no need to continue
For H2%
= 1 To UBound(Object
) ' cycle through all defined objects If (H2%
<> H1%
) And Object
(H2%
).Inuse
Then ' object can't check itself or objects not in use
diam = Object(H1%).Radius + Object(H2%).Radius ' calculate the length of both object radii
'** update object position
u = MIN(Object(H1%).MaxSpeed, MAX(Object(H1%).Xvel, -Object(H1%).MaxSpeed)) ' set maximum X velocity of object if needed
v = MIN(Object(H1%).MaxSpeed, MAX(Object(H1%).Yvel, -Object(H1%).MaxSpeed)) ' set maximum Y velocity of object if needed
x = Object(H1%).Xpos + TIMESTEP * u ' update object's X position
y = Object(H1%).Ypos + TIMESTEP * v ' update object's Y position
' ** Gravity and Friction
u = Object(H1%).Xvel ' get object's X velocity
v = Object(H1%).Yvel ' get object's Y velocity
fricscale
= 1 - Object
(H1%
).Friction
/ Sqr(1 + u
^ 2 + v
^ 2) ' calculate the amount of friction needed (if any) Object(H1%).Xvel = fricscale * u ' apply friction amount to object's X velocity
Object(H1%).Yvel = fricscale * v + Object(H1%).Gravity ' apply friction and gravity amounts tp object's Y velocity
'** check for collision
xi = x ' copy object's updated X position
yi = y ' copy object's updated Y position
xj = Object(H2%).Xpos ' get 2nd object's X position
yj = Object(H2%).Ypos ' get 2nd object's Y position
dx = xi - xj ' calculate X distance between objects
dy = yi - yj ' calculate Y distance between objetcs
dist
= Sqr(dx
^ 2 + dy
^ 2) ' calculate center to center distance between objects If dist
< diam
Then ' is center to center distance less than diameter? INTERACTION = H2% ' yes, return object that was collided with
'** get object vectors
ui = Object(H1%).Xvel ' get object's X velocity
vi = Object(H1%).Yvel ' get object's Y velocity
uj = Object(H2%).Xvel ' get 2nd object's X velocity
vj = Object(H2%).Yvel ' get 2nd object's Y velocity
'** move backwards in time until the two objects are just touching
CoefA = (ui - uj) ^ 2 + (vi - vj) ^ 2 ' calculate time coefficiants of actual objects touching
CoefB = 2 * ((ui - uj) * (xi - xj) + (vi - vj) * (yi - yj))
CoefC = (xi - xj) ^ 2 + (yi - yj) ^ 2 - diam ^ 2
t = -CoefC / CoefB
t
= (-CoefB
- Sqr(CoefB
^ 2 - 4 * CoefA
* CoefC
)) / (2 * CoefA
) t
= (-CoefB
+ Sqr(CoefB
^ 2 - 4 * CoefA
* CoefC
)) / (2 * CoefA
) xi = xi + t * ui ' move object's X location to this point in time
yi = yi + t * vi ' move object's Y location to this point in time
xj = xj + t * uj ' move 2nd object's X location to this point in time
yj = yj + t * vj ' move 2nd object's Y location to this point in time
'** center of momentum coordinates
mx = (ui + uj) / 2 ' calculate horizontal loss of momentum between objects
my = (vi + vj) / 2 ' calculate vertical loss of momentum between objects
ui = ui - mx ' update object's X velocity based on momentum loss
vi = vi - my ' update object's Y velocity based on momentum loss
uj = uj - mx ' update 2nd object's X velocity based on momentum loss
vj = vj - my ' update 2nd object's Y velocity based on momentum loss
'** new center to center line
dx = xi - xj ' calculate X distance between objects
dy = yi - yj ' calculate Y distance between objects
dist
= Sqr(dx
^ 2 + dy
^ 2) ' calculate center to center distance between objects dx = dx / dist '
dy = dy / dist
'** reflect object veolcity vectors in center to center 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
= Sqr(Object
(H1%
).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 object velocities
Object(H1%).Xvel = ui
Object(H1%).Yvel = vi
'** set 2nd object velocities and position if allowed to respond to first object
Object(H2%).Xvel = uj
Object(H2%).Yvel = vj
Object(H2%).Xpos = xj
Object(H2%).Ypos = yj
'** set object position
x = xi
y = yi
'** attrack/repel the two objects to/against each other
If (Object
(H1%
).Attract
<> 0) And (Object
(H1%
).AttractedTo
= H2%
) Then xm = Object(H2%).Xpos - x
ym = Object(H2%).Ypos - y
dist = xm ^ 2 + ym ^ 2
dist = MAX(dist, Object(H1%).Radius ^ 2)
Object(H1%).Xvel = Object(H1%).Attract * xm / dist + Object(H1%).Xvel
Object(H1%).Yvel = Object(H1%).Attract * ym / dist + Object(H1%).Yvel
Object(H2%).Xvel = Object(H1%).Attract * xm / dist + Object(H2%).Xvel
Object(H2%).Yvel = -Object(H1%).Attract * ym / dist + Object(H2%).Yvel
'** save position of object
Object(H1%).Xpos = x
Object(H1%).Ypos = y
'------------------------------------------------------------------------------
'**
'** returns the smallest number passed in
'**
MIN = Num1!
MIN = Num2!
'------------------------------------------------------------------------------
'**
'** returns the largest number passed in
'**
MAX = Num1!
MAX = Num2!
