Share My Creation LittleSquare Physics Demo

#Region  Project Attributes
    #MainFormWidth: 600
    #MainFormHeight: 400
#End Region

Sub Process_Globals
    'Custom Types
        Type PhysicalObject2D(posX As Double, posY As Double, sizeX As Double, sizeY As Double, Velocity As Vector, Gravity As Vector)
        Type Line2D(aX As Double, aY As Double, bX As Double, bY As Double, Active As Boolean)
        Type PerformanceMeasurement(Interval As Double, TimeStamp As Long)

    'MainForm
        Private fx                             As JFX
        Private MainForm                       As Form
        Dim cvs As Canvas

    'Main Cycle
        Dim DeltaTime                          As PerformanceMeasurement
        Dim MainCycle                          As Timer

    'Physical Elements
        Dim LittleSquare                       As PhysicalObject2D
        Dim Platform                           As PhysicalObject2D
        Dim World                              As PhysicalObject2D

    'Temporary Variables
        Dim tempVelocity                       As Vector
        Dim tempGravity                        As Vector

    'Constants
        Dim EarthMass = 5.972 * Power(10, 24)  As Double

    'User Input
        Dim LaunchVisual                       As Line2D
        Dim UserInput                          As Pane
End Sub

Sub AppStart (Form1 As Form, Args() As String)
    'MainForm Settings
        MainForm           =  Form1
        MainForm.Resizable =  False
        MainForm.Title     =  "LittleSquare Physics Demo - Bruno Silva 2015"
        MainForm.SetFormStyle("UNIFIED")
        MainForm.Show

    'Canvas
        cvs.Initialize("cvs")
        MainForm.RootPane.AddNode(cvs, 0, 0, MainForm.Width, MainForm.Height)

    'User Input
        UserInput.Initialize("UserInput")
        MainForm.RootPane.AddNode(UserInput, 0, 0, MainForm.Width, MainForm.Height)

    'World Gravity
        tempGravity.setAngleAndMagnitudeD(90, 1600)
        World.Gravity = tempGravity

    'Player
        LittleSquare.sizeX = 15
        LittleSquare.sizeY = 15
        LittleSquare.posX  = Rnd(0, cvs.Width - LittleSquare.sizeX)
        LittleSquare.posY  = 0

    'Player Velocity
        tempVelocity.setAngleAndMagnitudeD(Rnd(0,360), 300)
        LittleSquare.Velocity = tempVelocity

    'Stage
        Platform.sizeX = cvs.Width
        Platform.sizeY = 100
        Platform.posX  = 0
        Platform.posY  = cvs.Height - Platform.sizeY

    'Main Cycle
        DeltaTime.Interval = (1 / 60)
        MainCycle.Initialize("MainCycle", 16) 'DeltaTime.Interval * 1000)
        MainCycle.Enabled = True
End Sub

Sub MainCycle_Tick
    'Calculate DeltaTime Interval
        If Not(DeltaTime.TimeStamp = 0) Then DeltaTime.Interval = (Max(1, DateTime.Now - DeltaTime.TimeStamp) / 1000)
        DeltaTime.TimeStamp = DateTime.Now

    'Clear Screen
        cvs.ClearRect(0, 0, cvs.Width, cvs.Height)

    'Apply Gravity Physics
        tempVelocity.dirY  = LittleSquare.Velocity.dirY + (World.Gravity.dirY * DeltaTime.Interval)
        LittleSquare.Velocity = tempVelocity

    'Collision Detection: Platform
        If LittleSquare.posY + LittleSquare.sizeY >= Platform.posY Then  
            If LittleSquare.posY + LittleSquare.sizeY > Platform.posY And LittleSquare.Velocity.AngleD <= 180 Then
                tempVelocity.dirY  = PostCollisionVelocity(LittleSquare.Velocity.dirY, 0, 10, EarthMass, 0.6)
                LittleSquare.Velocity = tempVelocity
            End If
            If Abs(LittleSquare.Velocity.dirY) < Abs(0.05 * World.Gravity.dirY) Then
                tempVelocity.dirY = 0
                LittleSquare.Velocity = tempVelocity
            End If
            LittleSquare.posY = Platform.posY - LittleSquare.sizeY
        End If

    'Collision Detection: Top
        If LittleSquare.posY < 0 Then
            LittleSquare.posY = 0
            tempVelocity.dirY  = PostCollisionVelocity(LittleSquare.Velocity.dirY, 0, 10, EarthMass, 0.6)
            LittleSquare.Velocity = tempVelocity
        End If

    'Collision Detection: Walls
        If LittleSquare.posX + LittleSquare.sizeX > cvs.Width Then
            LittleSquare.posX = cvs.Width - LittleSquare.sizeX
            tempVelocity.dirX  = PostCollisionVelocity(LittleSquare.Velocity.dirX, 0, 10, EarthMass, 0.6)
            LittleSquare.Velocity = tempVelocity
        Else If LittleSquare.posX < 0 Then
            LittleSquare.posX = 0
            tempVelocity.dirX  = PostCollisionVelocity(LittleSquare.Velocity.dirX, 0, 10, EarthMass, 0.6)
            LittleSquare.Velocity = tempVelocity
        End If

    'Friction
        If LittleSquare.posY + LittleSquare.sizeY >= Platform.posY Then
            tempVelocity.dirX  = LittleSquare.Velocity.dirX * 0.8
            LittleSquare.Velocity = tempVelocity
        End If

    'Backup Coords
        Dim oX = LittleSquare.posX As Double
        Dim oY = LittleSquare.posY As Double

    'Update Position
        LittleSquare.posX = LittleSquare.posX + (LittleSquare.Velocity.dirX * DeltaTime.Interval)
        LittleSquare.posY = LittleSquare.posY + (LittleSquare.Velocity.dirY * DeltaTime.Interval)

    'Calculate the Velocity Angle
        tempVelocity.AngleD = CalcAngleD(oX, oY, LittleSquare.posX, LittleSquare.posY)
        LittleSquare.Velocity  = tempVelocity

    'Render on Screen
        DrawShape(LittleSquare, fx.Colors.Blue)
        DrawShape(Platform, fx.Colors.Green)
        If LaunchVisual.Active Then
            LaunchVisual.aX = LittleSquare.posX + (LittleSquare.sizeX / 2)
            LaunchVisual.aY = LittleSquare.posY + (LittleSquare.sizeY / 2)
            DrawLine(LaunchVisual, fx.Colors.Red, 2)
        End If

    'Debug
        'Log(DeltaTime.Interval)
End Sub

'Given the Conservation of Momentum formula (m1*u1)+(m2*u2) = (m1*v1)+(m2*v2),
'we're able to calculate an object's post collision velocity.
'
'u1: ObjectA pre-collision velocity, u2: ObjectB pre-collision velocity, m1: ObjectA mass in kg, m2: ObjectB mass in kg.
'CoR: Coefficient of Restitution, a value between 0.00(0) and 1.00(0) where 1 represents a perfectly elastic collision.
Sub PostCollisionVelocity(u1 As Double, u2 As Double, m1 As Double, m2 As Double, CoR As Double) As Double
    Dim v1 = ((u1 * (m1 - m2)) + (2 * m2 * u2)) / (m1 + m2) As Double
    Return v1 * CoR
End Sub

Sub Userinput_MousePressed (EventData As MouseEvent)
    Dim dist, aX, aY, bX, bY As Double
    aX    = (LittleSquare.posX + LittleSquare.sizeX / 2)
    aY    = (LittleSquare.posY + LittleSquare.sizeY / 2)
    bX    = (EventData.X)
    bY    = (EventData.Y)
    dist  = Sqrt(Power((bX-aX),2) + Power((bY-aY),2))
    If dist <= LittleSquare.sizeX Then
        LaunchVisual.aX     = aX
        LaunchVisual.aY     = aY
        LaunchVisual.bX     = aX
        LaunchVisual.bY     = aY
        LaunchVisual.Active = True
    End If
End Sub

Sub Userinput_MouseDragged (EventData As MouseEvent)
    Dim aX, aY, bX, bY As Double
    aX    = (LittleSquare.posX + LittleSquare.sizeX / 2)
    aY    = (LittleSquare.posY + LittleSquare.sizeY / 2)
    bX    = (EventData.X)
    bY    = (EventData.Y)
    If LaunchVisual.Active Then
        LaunchVisual.aX = aX
        LaunchVisual.aY = aY
        LaunchVisual.bX = bX
        LaunchVisual.bY = bY
    End If
End Sub

Sub Userinput_MouseReleased (EventData As MouseEvent)
    Dim angle, dist, aX, aY, bX, bY As Double
    aX    = (LittleSquare.posX + LittleSquare.sizeX / 2)
    aY    = (LittleSquare.posY + LittleSquare.sizeY / 2)
    bX    = (EventData.X)
    bY    = (EventData.Y)
    angle = CalcAngleD(aX, aY, bX, bY)
    dist  = Sqrt(Power((bX-aX),2) + Power((bY-aY),2))
    If LaunchVisual.active Then
        LaunchVisual.bX = bX
        LaunchVisual.bY = bY
        Dim tempVelocity As Vector
        tempVelocity.setAngleAndMagnitudeD(angle, dist * 5)
        LittleSquare.Velocity = tempVelocity
    End If
    LaunchVisual.Active = False
    LaunchVisual.aX     = 0
    LaunchVisual.aY     = 0
    LaunchVisual.bX     = 0
    LaunchVisual.bY     = 0
End Sub

Public Sub CalcAngleD(aX As Double, aY As Double, bX As Double, bY As Double) As Double
    Dim dirX = bX - aX As Double
    Dim dirY = bY - aY As Double
    Return ATan2D(dirY, dirX)
End Sub

Sub DrawShape(input As PhysicalObject2D, color As Paint)
    cvs.DrawRect(input.posX, input.posY, input.sizeX, input.sizeY, color, True, 0)
End Sub

Sub DrawLine(line As Line2D, color As Paint, thickness As Int)
    cvs.DrawLine(line.aX, line.aY, line.bX, line.bY, color, thickness)
End Sub

'Class module
Private Sub Class_Globals
    Private fx As JFX
    Dim Description As String
    Dim Units       As String
    Dim Size        As Double
    Dim AngleD      As Double
    Dim AngleR      As Double
    Dim dirX        As Double
    Dim dirY        As Double
End Sub

'Sets this vector's description and units
Public Sub setDescription(Vector_Description As String, Vector_Units As String)
    Description = Vector_Description
    Units       = Vector_Units
End Sub

'Sets this vector's directional components, magnitude and angle from an imaginary line between two points in space, given their X, Y coordinates.
Public Sub setVectorFromLine(aX As Double, aY As Double, bX As Double, bY As Double)
    dirX      = bX - aX
    dirY      = bY - aY
    AngleD    = ATan2D(dirY, dirX)
    AngleR    = ATan2 (dirY, dirX)
    Size      = Sqrt(Power(dirX, 2) + Power(dirY, 2))
End Sub

'Sets this vector's directional components based on the given size and angle in degrees.
Public Sub setAngleAndMagnitudeD(Degrees As Double, Magnitude As Double)
    AngleD    = Degrees
    AngleR    = Degrees * cPI / 180
    Size      = Magnitude
    dirX      = CosD(Degrees) * Magnitude
    dirY      = SinD(Degrees) * Magnitude
End Sub

'Sets this vector's directional components based on the given size and angle in radians.
Public Sub setAngleAndMagnitudeR(Magnitude As Double, Radians As Double)
    AngleD    = Radians * 180 / cPI
    AngleR    = Radians
    Size      = Magnitude
    dirX      = Cos(Radians) * Magnitude
    dirY      = Sin(Radians) * Magnitude
End Sub

'Updates the vector's directional components, magnitude and angle in radians based on the given angle in degrees.
Public Sub setAngleD(Degrees As Double)
    AngleD    = Degrees
    AngleR    = Degrees * cPI / 180
    dirX      = CosD(Degrees) * Size
    dirY      = SinD(Degrees) * Size
End Sub

'Updates the vector's directional components, magnitude and angle in degrees based on the given angle in radians.
Public Sub setAngleR(Radians As Double)
    AngleD    = Radians * 180 / cPI
    AngleR    = Radians
    dirX      = Cos(Radians) * Size
    dirY      = Sin(Radians) * Size
End Sub