Deprecated: Function split() is deprecated in /home/wiki/public_html/inc/common.php on line 533

Warning: Cannot modify header information - headers already sent by (output started at /home/wiki/public_html/inc/common.php:533) in /home/wiki/public_html/inc/actions.php on line 71
wiki:ggolemgprj1source [TV3DWiki]
 
Option Explicit
 
Private TV3D As TVEngine
 
Private Land As TVLandscape
 
Private TVLightEngine As TVLightEngine
 
Private MatFactory As TVMaterialFactory
 
Private TextureFactory As TVTextureFactory
 
Private CarMesh As TVMesh
 
Private WayPointMesh As TVMesh
 
Private Scene As TVScene
 
Private InputEngine As TVInputEngine
 
Private Atmos As TVAtmosphere
 
Private Math As TVMathLibrary
 
Private DoLoop As Boolean
 
Private Type Circ
    Pos                           As D3DVECTOR
    Radius                        As Single
End Type
 
Private Type StageBounds
    Min                           As D3DVECTOR
    Max                           As D3DVECTOR
End Type
 
Private Type CarType
    Pos                           As D3DVECTOR
    Direction                     As Single
    Speed                         As Single
    MaxSpeed                      As Single
    MinSpeed                      As Single
    TurnRatio                     As Single       'We rotate this much every tick
    Accleration                   As Single
    BrakeSpeed                    As Single
    BackAngle                     As Single
    Radius                        As Long         'The size of the car      'The size of the car
    NextNode                      As Long
    Circle                        As Circ
End Type
 
Private CaR(0 To 7)           As CarType
 
Private Nodes()               As D3DVECTOR    'NodeType 'An array of nodes marking our route
 
Private InLoop                As Boolean      'Is our main loop running?
 
Private LastTick              As Long         'The last time we ran
 
Private Const TickInterval    As Long = 5     'How often to run
 
Private Level                 As StageBounds
 
Private sngPos                As D3DVECTOR
 
Private sngLookat             As D3DVECTOR
 
Private sngAngle              As D3DVECTOR
 
Private sngWalk               As Single
 
Private sngStrafe             As Single
 
Private light(8)              As D3DLIGHT8
 
Private MatIND(0 To 20)       As Long
 
Private Const NodeRadius      As Long = 10    'Size of the nodes
 
Private Const PI              As Double = 3.14159265358979
 
Private TE                    As Single
 
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Private Sub CheckAngle(ByRef sngDir As Single)
 
    Do While sngDir > PI Or sngDir < -PI
        If sngDir > PI Then
            sngDir = sngDir - 2 * PI
        End If
        If sngDir < -PI Then
            sngDir = sngDir + 2 * PI
        End If
        'DoEvents
    Loop
 
End Sub
 
Private Sub cmdQuit_Click()
 
    DoLoop = False
 
End Sub
 
Private Sub DoAI(CaR As CarType)
 
Dim AbsoluteAngle As Single
Dim RelativeAngle As Single
Dim NextNode      As Long
Dim Distance      As Single
 
    NextNode = CaR.NextNode
    Distance = Math.GetDistance3D(CaR.Pos.x, CaR.Pos.y, CaR.Pos.z, Nodes(CaR.NextNode).x, Nodes(CaR.NextNode).y, Nodes(CaR.NextNode).z)
    If Distance < CaR.Radius + NodeRadius Then
        NextNode = NextNode + 1
        If NextNode > UBound(Nodes) Then
            NextNode = 0
        End If
        CaR.NextNode = NextNode
    End If
    '## Calculate Direction
    AbsoluteAngle = FindAngle(CaR.Pos.x, CaR.Pos.z, Nodes(NextNode).x, Nodes(NextNode).z)
    'We now have the angle from us to our next node
    'we're going to re-orient it so its a relative angle
    CheckAngle CaR.Direction
    CheckAngle AbsoluteAngle
    RelativeAngle = AbsoluteAngle - CaR.Direction
    CheckAngle RelativeAngle
    If RelativeAngle > 0 Then
        CaR.Direction = CaR.Direction + CaR.TurnRatio
    Else 'NOT RELATIVEANGLE...
        CaR.Direction = CaR.Direction - CaR.TurnRatio
    End If
    '## Calculate Speed
    'work out our turning circle
    If RelativeAngle > 0 Then
        ProjectCircle CaR, CaR.Circle.Pos.x, CaR.Circle.Pos.z, CaR.Circle.Radius, True
    Else 'NOT RELATIVEANGLE...
        ProjectCircle CaR, CaR.Circle.Pos.x, CaR.Circle.Pos.z, CaR.Circle.Radius, False
        'the sub executes.
    End If
    'check if the node is within our turning circle
    'ie if we dont slow down we'll miss it cause we cant turn enough
    Distance = Math.GetDistance2D(CaR.Circle.Pos.x, CaR.Circle.Pos.z, Nodes(NextNode).x, Nodes(NextNode).z)
    If Distance < CaR.Circle.Radius Then
        CaR.Speed = CaR.Speed - CaR.BrakeSpeed
        If CaR.Speed < CaR.MinSpeed Then
            CaR.Speed = CaR.MinSpeed
        End If
    ElseIf Abs(RelativeAngle) > CaR.BackAngle Then 'NOT DISTANCE...
        'Check if node is behind us and slow down if it is
        CaR.Speed = CaR.Speed - CaR.BrakeSpeed
        If CaR.Speed < CaR.MinSpeed Then
            CaR.Speed = CaR.MinSpeed
        End If
    Else 'we are a race car, we should speed up if we can 'NOT ABS(RELATIVEANGLE)...
        CaR.Speed = CaR.Speed + CaR.Accleration
        If CaR.Speed > CaR.MaxSpeed Then
            CaR.Speed = CaR.MaxSpeed
        End If
    End If
    CaR.Pos.x = CaR.Pos.x + CaR.Speed * Sin(CaR.Direction)
    CaR.Pos.z = CaR.Pos.z - CaR.Speed * Cos(CaR.Direction)
    If CaR.Pos.x > Level.Max.x Then
        CaR.Pos.x = Level.Max.x
    End If
    If CaR.Pos.z > Level.Max.z Then
        CaR.Pos.z = Level.Max.z
    End If
    If CaR.Pos.x < Level.Min.x Then
        CaR.Pos.x = Level.Min.x
    End If
    If CaR.Pos.z < Level.Min.z Then
        CaR.Pos.z = Level.Min.z
    End If
 
End Sub
 
Private Function FindAngle(ByVal X1 As Single, _
                           ByVal Y1 As Single, _
                           ByVal X2 As Single, _
                           ByVal Y2 As Single) As Single
 
Dim sngXComp As Single
Dim sngYComp As Single
 
    'Find the angle between the 2 coords
    sngXComp = X2 - X1
    sngYComp = Y1 - Y2
    If Sgn(sngYComp) > 0 Then
        FindAngle = Atn(sngXComp / sngYComp)
    End If
    If Sgn(sngYComp) < 0 Then
        FindAngle = Atn(sngXComp / sngYComp) + PI
    End If
 
End Function
 
Private Sub Form_Load()
 
    Main_Loop
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
 
    DoLoop = False
 
End Sub
 
Private Sub Main_Loop()
 
'<:-) :WARNING: Large Control procedure (197 lines of code)
 
Dim i                 As Long
Dim tmpMouseScrollNew As Long
Dim tmpMouseX         As Long
Dim tmpMouseY         As Long
Dim tmpMouseB1        As Long
Dim tmpMouseB2        As Long
Dim tmpMouseB3        As Long
Dim MA(10)            As Single
 
    Set TV3D = New TVEngine
    Set InputEngine = New TVInputEngine
    Set Scene = New TVScene
    Set Atmos = New TVAtmosphere
    Set TextureFactory = New TVTextureFactory
    Set CarMesh = Scene.CreateMeshBuilder
    Set WayPointMesh = Scene.CreateMeshBuilder
    Set MatFactory = New TVMaterialFactory
    Set TVLightEngine = New TVLightEngine
    Set Land = New TVLandscape
    Set Math = New TVMathLibrary
    With TV3D
        .SetSearchDirectory App.Path
        .Init3DWindowedMode Picture1.hWnd
        .DisplayFPS = True
        .SetVSync True
        .EnableHardwareTL True
        .SetShadowMandatory True
    End With 'TV3D
    MatIND(0) = MatFactory.CreateLightMaterial(0.5, 0.5, 0.5, 1, , "carmat")
    MatIND(1) = MatFactory.CreateLightMaterial(0.5, 0.5, 0.5, 1, , "landmat")
    For i = LBound(light) To UBound(light)
        With light(i)
            .Type = D3DLIGHT_POINT
            .Ambient.a = 0.1
            .Ambient.r = 0.1
            .Ambient.g = 0.1
            .Ambient.b = 0.1
            .diffuse.a = 1
            .diffuse.r = 1
            .diffuse.g = 0.5
            .diffuse.b = 0.5
            .specular.a = 1
            .specular.r = 0.2
            .specular.g = 0.2
            .specular.b = 0.2
            '.Direction = Vector3(0, 1, 0)
            '.Position = Vector3(0, 10, 0)
            .Range = 300
            .Attenuation0 = 0.5
            .Falloff = 1#
            .Phi = PI / 4
            .Theta = .Phi / 2#
        End With 'LIGHT(I)
        TVLightEngine.CreateLight light(i), "light" & i, False
    Next i
    Scene.SetSpecularLightning True
    Level.Min = Vector(0, 0, 0)
    Level.Max = Vector(1024, 1000, 1024)
    With TextureFactory
        .LoadTexture "..\..\..\Media\sky\sunset\up.jpg", "SkyTop"
        .LoadTexture "..\..\..\Media\sky\sunset\down.jpg", "SkyBottom"
        .LoadTexture "..\..\..\Media\sky\sunset\left.jpg", "SkyLeft"
        .LoadTexture "..\..\..\Media\sky\sunset\right.jpg", "SkyRight"
        .LoadTexture "..\..\..\Media\sky\sunset\front.jpg", "SkyFront"
        .LoadTexture "..\..\..\Media\sky\sunset\back.jpg", "SkyBack"
        .LoadTexture "..\..\..\Media\grass9.jpg", "LandTexture", 1024, 1024
    End With 'TextureFactory
    Atmos.SkyBox_SetTexture GetTex("SkyFront"), GetTex("SkyBack"), GetTex("SkyLeft"), GetTex("SkyRight"), GetTex("SkyTop"), GetTex("SkyBottom")
    Atmos.SkyBox_Enable True
    With Land
        'Land.SetAffineDetail TV_AFFINE_NO
        .SetFactorY 0
        .GenerateHugeTerrain "Track.jpg", TV_PRECISION_LOW, 8, 8, 0, 0, True
        '.SetMaterial GetMat("landmat")
        .SetMaterial MatIND(1)
        .SetTexture GetTex("LandTexture")
        .SetTextureScale 2, 2
    End With 'Land
    'Init_Race
    '/////////////////////////////////////////////
    ReDim Nodes(3)
    Randomize
    Nodes(0) = Vector(Int((Level.Max.x + 1) * Rnd), Land.GetHeight(Nodes(0).x, Nodes(0).z), Int((Level.Max.z + 1) * Rnd))
    Nodes(1) = Vector(Int((Level.Max.x + 1) * Rnd), Land.GetHeight(Nodes(1).x, Nodes(1).z), Int((Level.Max.z + 1) * Rnd))
    Nodes(2) = Vector(Int((Level.Max.x + 1) * Rnd), Land.GetHeight(Nodes(2).x, Nodes(2).z), Int((Level.Max.z + 1) * Rnd))
    Nodes(3) = Vector(Int((Level.Max.x + 1) * Rnd), Land.GetHeight(Nodes(3).x, Nodes(3).z), Int((Level.Max.z + 1) * Rnd))
    For i = 0 To UBound(CaR)
        CaR(i).Pos = Vector3(Level.Max.x / 2, 0, Level.Max.z / 2)
        Set_Car CaR(i), , (9 - i) / 50, , , 1 + ((i + 1) / 5), (i + 1) * 1.1, -(CaR(i).MaxSpeed / 2), (i + 1) / 80
    Next i
    InLoop = True
    '////////////////////////////////////////////
    With CarMesh
        .LoadXFile "\M2.x"
        .ComputeBoundingVolumes
        .ComputeNormals
        .ScaleMesh 2, 2, 2
        .SetAlphaTest False, 0
        .EnableFrustumCulling True
        .SetCullMode TV_FRONT_CULL
        .SetColor RGBA(1, 0.5, 0.5, 1)
        .SetMaterial GetMat("carmat")
    End With 'CarMesh
    WayPointMesh.CreateSphere GetTex("SkyBottom"), 10, 6, 6, RGBA(1, 0.5, 0.5, 1)
    Scene.SetViewFrustum 60, 1000
    sngPos = Vector(512, 20, 512)
    sngLookat = Vector(512, 20, 550)
    sngAngle = Vector(0, 0, 0)
    sngWalk = 0
    sngStrafe = 0
    Form1.Show
    DoLoop = True
    Do
        DoEvents
        TE = TV3D.AccurateTimeElapsed
        If LastTick + TickInterval <= GetTickCount() Then
            LastTick = GetTickCount()
            '///////////////////////////////////////
            If InputEngine.IsKeyPressed(TV_KEY_UP) Then
                sngWalk = 1
            ElseIf InputEngine.IsKeyPressed(TV_KEY_DOWN) Then 'INPUTENGINE.ISKEYPRESSED(TV_KEY_UP) = FALSE/0
                sngWalk = -1
            End If
            If InputEngine.IsKeyPressed(TV_KEY_PAGEUP) Then
            sngPos.y = sngPos.y + 5
            ElseIf InputEngine.IsKeyPressed(TV_KEY_PAGEDOWN) Then
            sngPos.y = sngPos.y - 5
            End If
            If InputEngine.IsKeyPressed(TV_KEY_LEFT) Then
                sngStrafe = 1
            ElseIf InputEngine.IsKeyPressed(TV_KEY_RIGHT) Then 'INPUTENGINE.ISKEYPRESSED(TV_KEY_LEFT) = FALSE/0
                sngStrafe = -1
            End If
            'tmpMouseScrollOld = tmpMouseScrollNew
            InputEngine.GetMouseState tmpMouseX, tmpMouseY, CInt(tmpMouseB1), CInt(tmpMouseB2), CInt(tmpMouseB3), tmpMouseScrollNew
            sngAngle.x = sngAngle.x - (tmpMouseY / 100)
            sngAngle.y = sngAngle.y - (tmpMouseX / 100)
            MA(4) = 0.005 * TE
            If sngAngle.x > 1.3 Then
                sngAngle.x = 1.3
            End If
            If sngAngle.x < -1.3 Then
                sngAngle.x = -1.3
            End If
            Select Case sngWalk
            Case Is > 0
                sngWalk = sngWalk - MA(4)
                If sngWalk < 0 Then
                    sngWalk = 0
                End If
            Case Is < 0
                sngWalk = sngWalk + MA(4) '0.005 * TE 'TV3D.TimeElapsed
                If sngWalk > 0 Then
                    sngWalk = 0
                End If
            End Select
            Select Case sngStrafe
            Case Is > 0
                sngStrafe = sngStrafe - MA(4) '0.005 * TE 'TV3D.TimeElapsed
                If sngStrafe < 0 Then
                    sngStrafe = 0
                End If
            Case Is < 0
                sngStrafe = sngStrafe + MA(4) '0.005 * TE 'TV3D.TimeElapsed
                If sngStrafe > 0 Then
                    sngStrafe = 0
                End If
            End Select
            MA(0) = Cos(sngAngle.y)
            MA(1) = PI / 2
            MA(2) = sngWalk / 5 * TE
            MA(3) = sngStrafe / 5 * TE
            sngPos = Vector((sngPos.x + (MA(0) * MA(2)) + (Cos(sngAngle.y + MA(1)) * MA(3))), sngPos.y, (sngPos.z + (Sin(sngAngle.y) * MA(2)) + (Sin(sngAngle.y + MA(1)) * MA(3))))
                        'sngPos = Vector((sngPos.x + (MA(0) * MA(2)) + (Cos(sngAngle.y + MA(1)) * MA(3))), (Land.GetHeight(sngPos.x, sngPos.z) + 10), (sngPos.z + (Sin(sngAngle.y) * MA(2)) + (Sin(sngAngle.y + MA(1)) * MA(3))))
 
            sngLookat = Vector(sngPos.x + MA(0), sngPos.y + Tan(sngAngle.x), sngPos.z + Sin(sngAngle.y))
            Scene.SetCamera sngPos.x, sngPos.y, sngPos.z, sngLookat.x, sngLookat.y, sngLookat.z
            '//////////////////////////////////////
            TV3D.Clear
            For i = 0 To UBound(Nodes)
                Nodes(i).y = Land.GetHeight(Nodes(i).x, Nodes(i).z) + 5
                WayPointMesh.SetPosition Nodes(i).x, Nodes(i).y, Nodes(i).z
                WayPointMesh.Render
            Next i
            For i = 0 To UBound(CaR)
                DoAI CaR(i)
                If CaR(i).Pos.y < Land.GetHeight(CaR(i).Pos.x, CaR(i).Pos.z) Then
                    CaR(i).Pos.y = Land.GetHeight(CaR(i).Pos.x, CaR(i).Pos.z) + 1
                End If
                CarMesh.SetPosition CaR(i).Pos.x, Land.GetHeight(CaR(i).Pos.x, CaR(i).Pos.z) + 5, CaR(i).Pos.z
                CarMesh.SetRotation CarMesh.GetRotation.x, CaR(i).Direction + 45, CarMesh.GetRotation.z
                
                TVLightEngine.SetLightPosition i, Vector(CaR(i).Pos.x, CaR(i).Pos.y + 5, CaR(i).Pos.z)
                CarMesh.Render
                CarMesh.RenderShadow
            Next i
            Atmos.Atmosphere_Render
            Land.Render True
            'TVLightEngine.UpdateLight i, TVLightEngine.GetLightByName("light" & i)
            TV3D.RenderToScreen
        End If
    Loop Until DoLoop = False
    Scene.DestroyAllMeshes
    Set InputEngine = Nothing
    Set Scene = Nothing
    Set Atmos = Nothing
    Set TextureFactory = Nothing
    Set CarMesh = Nothing
    Set WayPointMesh = Nothing
    Set MatFactory = Nothing
    Set TVLightEngine = Nothing
    Set Land = Nothing
    Set Math = Nothing
    Set TV3D = Nothing
    End
 
End Sub
 
Private Sub ProjectCircle(CaR As CarType, _
                          rtnOriginX As Single, _
                          rtnOriginY As Single, _
                          rtnRadius As Single, _
                          ByVal TurnLeft As Boolean)
 
 
Dim V1         As D3DVECTOR
 
Dim V2         As D3DVECTOR
 
Dim Acc        As D3DVECTOR
 
Dim Org        As D3DVECTOR
 
Dim AccelTot   As Single
 
Dim Radius     As Single
 
Dim T          As Long
 
Dim DummyCar   As CarType
 
Const NumTicks As Long = 10
 
    DummyCar = CaR
    'First we must calculate the seperate X & Y velocities
    'We project the motion of the car for a few ticks to get
    For T = 1 To NumTicks                       'more accuracy
        If TurnLeft Then
            DummyCar.Direction = DummyCar.Direction + DummyCar.TurnRatio
        Else 'Turn Right 'TURNLEFT = FALSE/0
            DummyCar.Direction = DummyCar.Direction - DummyCar.TurnRatio
        End If
        DummyCar.Pos.x = DummyCar.Pos.x + DummyCar.Speed * Sin(DummyCar.Direction)
        DummyCar.Pos.z = DummyCar.Pos.z - DummyCar.Speed * Cos(DummyCar.Direction)
    Next T
    V1.x = Sin(CaR.Direction) * CaR.Speed
    V1.z = Cos(CaR.Direction) * CaR.Speed
    With V2
        .x = Sin(DummyCar.Direction) * DummyCar.Speed
        .z = Cos(DummyCar.Direction) * DummyCar.Speed
        Acc.x = (.x - V1.x) / NumTicks
        Acc.z = (.z - V1.z) / NumTicks
    End With 'V2
    AccelTot = Sqr(Acc.x * Acc.x + Acc.z * Acc.z)
    On Error GoTo OverFlowHandler ':( Avoid "GoTo"
    Radius = (CaR.Speed * CaR.Speed) / AccelTot
    On Error GoTo 0 ':( Possible Structure Violation
    If TurnLeft Then
        Org.x = CaR.Pos.x + Radius * Sin(CaR.Direction + PI / 2)
        Org.z = CaR.Pos.z - Radius * Cos(CaR.Direction + PI / 2)
    Else ''TURNLEFT = FALSE/0 'TURNLEFT = FALSE/0
        Org.x = CaR.Pos.x + Radius * Sin(CaR.Direction - PI / 2)
        Org.z = CaR.Pos.z - Radius * Cos(CaR.Direction - PI / 2)
    End If
    rtnOriginX = Org.x
    rtnOriginY = Org.z
    rtnRadius = Radius
 
Exit Sub
 
OverFlowHandler:
    Radius = 0
    Resume Next
 
End Sub
 
Private Sub Set_Car(aCar As CarType, _
                    Optional ByVal Radius As Single = 10, _
                    Optional ByVal Accleration As Single = 0.2, _
                    Optional ByVal BrakeSpeed As Single = 0.3, _
                    Optional ByVal Direction As Single = 0, _
                    Optional ByVal Speed As Single = 3, _
                    Optional ByVal MaxSpeed As Single = 8, _
                    Optional ByVal MinSpeed As Single = -4, _
                    Optional ByVal TurnRatio As Single = 0.05, _
                    Optional ByVal BackAngle As Single = PI / 3 * 2, _
                    Optional ByVal NextNode As Long = 0)
 
    With aCar
        .Radius = Radius
        .Accleration = Accleration
        .BrakeSpeed = BrakeSpeed
        .Direction = Direction
        .Speed = Speed
        .MaxSpeed = MaxSpeed
        .MinSpeed = MinSpeed
        .TurnRatio = TurnRatio
        .BackAngle = BackAngle
        .NextNode = NextNode
    End With 'aCar
 
End Sub
 
wiki/ggolemgprj1source.txt · Last modified: 2009/02/18 21:11