Gravity


Option Explicit

‘The gettickcount API delcaration
Private Declare Function GetTickCount Lib “kernel32” () As Long

Const PI = 3.14159          ‘Mmmm.. Pi
Const ORBIT_GRAVITY = 1000  ‘Acceleration due to gravity (during the “orbit” sequence)
Const FALL_GRAVITY = 0.1    ‘Acceleration due to gravity (during the “fall” sequence)
Const OBJECT_RADIUS = 10    ‘How FALL is our “ball”?

Const ORBIT_PLN_RADIUS = 15 ‘How big is our planet during an “orbit” sequence?
Const ORBIT_PLN_X = 200     ‘X-Coordinate of the planet during an “orbit”
Const ORBIT_PLN_Y = 200     ‘Y-Coordinate of the planet during an “orbit”
Const ORBIT_OBJ_X = 280     ‘Starting X-Coord of our object during an “orbit”
Const ORBIT_OBJ_Y = 220     ‘Starting Y-Coord of our object during an “orbit”
Const ORBIT_OBJ_SPEED = 4   ‘Starting speed during an “orbit”
Const ORBIT_OBJ_HEADING = 0 ‘Starting heading during an “orbit”

Const FALL_PLN_RADIUS = 500 ‘How big is our planet during a “fall” sequence?
Const FALL_PLN_X = 200      ‘X-Coordinate of the planet during a “fall”
Const FALL_PLN_Y = 600      ‘Y-Coordinate of the planet during a “fall”
Const FALL_OBJ_X = 375      ‘Starting X-Coord of our object during a “fall”
Const FALL_OBJ_Y = 345      ‘Starting Y-Coord of our object during a “fall”
Const FALL_OBJ_SPEED = 7    ‘Starting speed during a “fall”
Const FALL_OBJ_HEADING = 15 * PI / 8 ‘Starting heading during a “fall”

Const MS_DELAY = 25         ‘Milliseconds per frame (25 = 40 frames per second)

Dim mlngTimer As Long       ‘Holds system time since last frame was displayed
Dim msngHeading As Single   ‘Current direction in which object is moving
Dim msngSpeed As Single     ‘Current speed with which object is moving
Dim msngObjX As Single      ‘Current X coordinate of object within form
Dim msngObjY As Single      ‘Current Y coordinate of object within form
Dim mblnRunning As Boolean  ‘Is the render loop running?
Dim mblnOrbit As Boolean    ‘Are we orbiting?
Dim mblnFall As Boolean     ‘..or are we falling?

Private Sub Form_Load()

‘Initialize the variables
mlngTimer = GetTickCount()
mblnRunning = True
mblnOrbit = False
mblnFall = False
shpObject.Width = OBJECT_RADIUS
shpObject.Height = OBJECT_RADIUS

‘Display the form
frmGravity.Show

‘Start the render loop
Do While mblnRunning
‘Check if we’ve waited for the appropriate number of milliseconds
If mlngTimer + MS_DELAY <= GetTickCount() Then
mlngTimer = GetTickCount()      ‘Reset the timer variable
If mblnOrbit Then Physics_Orbit ‘Make the object orbit
If mblnFall Then Physics_Fall   ‘Make the object fall
If mblnOrbit Or mblnFall Then DrawObject   ‘Draw the object
End If
‘Allow other events to occur
DoEvents
Loop

End Sub

Private Sub cmdOrbit_Click()

‘Set up our booleans
mblnOrbit = True
mblnFall = False

‘Place the planet
shpPlanet.Width = ORBIT_PLN_RADIUS
shpPlanet.Height = ORBIT_PLN_RADIUS
shpPlanet.Left = ORBIT_PLN_X – shpPlanet.Width / 2
shpPlanet.Top = ORBIT_PLN_Y – shpPlanet.Height / 2

‘Place the object
msngSpeed = ORBIT_OBJ_SPEED
msngHeading = ORBIT_OBJ_HEADING
msngObjX = ORBIT_OBJ_X
msngObjY = ORBIT_OBJ_Y

End Sub

Private Sub cmdFall_Click()

‘Set up our booleans
mblnOrbit = False
mblnFall = True

‘Place the planet
shpPlanet.Width = FALL_PLN_RADIUS
shpPlanet.Height = FALL_PLN_RADIUS
shpPlanet.Left = FALL_PLN_X – shpPlanet.Width / 2
shpPlanet.Top = FALL_PLN_Y – shpPlanet.Height / 2

‘Place the object
msngSpeed = FALL_OBJ_SPEED
msngHeading = FALL_OBJ_HEADING
msngObjX = FALL_OBJ_X
msngObjY = FALL_OBJ_Y

End Sub

Private Sub DrawObject()

‘Move the object (according to its speed and heading)
msngObjX = msngObjX + msngSpeed * Sin(msngHeading)
msngObjY = msngObjY – msngSpeed * Cos(msngHeading)

‘Display the object
shpObject.Left = msngObjX – OBJECT_RADIUS / 2
shpObject.Top = msngObjY – OBJECT_RADIUS / 2

End Sub

Private Sub Physics_Orbit()

Dim sngXComp As Single      ‘Resultant X and Y components
Dim sngYComp As Single
Dim sngPlnX As Single       ‘X Distance to planet
Dim sngPlnY As Single       ‘Y Distance to planet
Dim sngDist As Single       ‘The linear distance to planet
Dim sngGravDir As Single    ‘In which direction is gravity acting (towards the planet!)

‘Find the distance to planet
sngPlnX = ORBIT_PLN_X – msngObjX
sngPlnY = msngObjY – ORBIT_PLN_Y
sngDist = Sqr(sngPlnX ^ 2 + sngPlnY ^ 2)

‘Calculate the gravity direction, and adjust for arctangent by adding Pi if necessary
If sngPlnY > 0 Then sngGravDir = Atn(sngPlnX / sngPlnY)
If sngPlnY < 0 Then sngGravDir = Atn(sngPlnX / sngPlnY) + PI

‘Find the components
sngXComp = msngSpeed * Sin(msngHeading) + (ORBIT_GRAVITY / (sngDist ^ 2)) * Sin(sngGravDir)
sngYComp = msngSpeed * Cos(msngHeading) + (ORBIT_GRAVITY / (sngDist ^ 2)) * Cos(sngGravDir)

‘Determine the resultant speed
msngSpeed = Sqr(sngXComp ^ 2 + sngYComp ^ 2)

‘Calculate the resultant heading, and adjust for arctangent by adding Pi if necessary
If sngYComp > 0 Then msngHeading = Atn(sngXComp / sngYComp)
If sngYComp < 0 Then msngHeading = Atn(sngXComp / sngYComp) + PI

End Sub

Private Sub Physics_Fall()

Dim sngXComp As Single  ‘Resultant X and Y components
Dim sngYComp As Single

‘Find the components
sngXComp = Sin(msngHeading) * msngSpeed
sngYComp = Cos(msngHeading) * msngSpeed – FALL_GRAVITY   ‘Don’t forget to apply gravity straight down!

‘Determine the resultant speed
msngSpeed = Sqr(sngXComp ^ 2 + sngYComp ^ 2)

‘Calculate the resultant heading, and adjust for arctangent by adding Pi if necessary
If sngYComp > 0 Then msngHeading = Atn(sngXComp / sngYComp)
If sngYComp < 0 Then msngHeading = Atn(sngXComp / sngYComp) + PI

‘Stop the ball when it hits the “ground”
If msngObjY > FALL_OBJ_Y Then msngSpeed = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)

‘Terminate the render loop
mblnRunning = False

End Sub

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s