This is the B15 tutorial code
It shouldn't be too hard to convert it to Delphi.
' ------------------------------------------------------------
' TrueVision3D Tutorials : . Advanced collision with meshs .
' ------------------------------------------------------------
' Goal :
' This tutorial shows how to do accurate collision on the scene
' for a character. This is the base of every game, and quite simple
' to understand and do. Note that you can replace the meshs by
' any other mesh, and it will work the same.
' Thanks to Yegveni team for the 3d character.
' Declare the engine objects.
Dim TV As New TVEngine
Dim Scene As New TVScene
Dim FloorMesh As TVMesh
Dim Actor As New TVActor2
Dim Land As New TVLandscape
Dim Tex As New TVTextureFactory
Dim Inp As New TVInputEngine
Dim Finished As Boolean
' Information about the movement of the actor.
Dim ActorPosition As D3DVECTOR
Dim ActorDestination As D3DVECTOR
Dim ActorDir As D3DVECTOR
Dim Moving As Boolean
Public Sub Initialize()
' Initialization and loading of everything.
'Engine initialization.
Me.Show
DoEvents
TV.Init3DWindowedMode Me.Picture1.hWnd
TV.SetSearchDirectory App.Path + "\..\..\..\Media"
TV.SetAngleSystem TV_ANGLE_DEGREE
'Objects loading.
Actor.Load "character.x", "actor", False, True
Actor.SetMaterial 0
Actor.PlayAnimation 20
Actor.SetScale 0.2, 0.2, 0.2
' ActorPosition.x = 150
'ActorPosition.z = 150
Scene.SetSceneBackGround 0.7, 0.8, 1
'Load the bridge mesh, that the character can go upon.
Set FloorMesh = Scene.CreateMeshBuilder
FloorMesh.LoadXFile "brige.x"
FloorMesh.SetMaterial 0
FloorMesh.SetCullMode TV_FRONT_CULL
'Landscape creation.
Land.SetFactorY 0.3
Land.GenerateHugeTerrain "track.jpg", TV_PRECISION_AVERAGE, 2, 2, 0, 0, True
Tex.LoadTexture "sand.jpg", "sand"
Land.SetTexture GetTex("sand")
ActorPosition.x = 150
ActorPosition.z = 150
ActorPosition.y = Land.GetHeight(150, 150)
FloorMesh.SetPosition 100, Land.GetHeight(100, 100), 100
'Camera settings
Scene.SetCamera 400, 150, 350, 0, 150, 0
End Sub
Public Sub CheckAll()
' do input mousepicking on the scene.
Dim mousex As Long, mousey As Long, button As Integer
Inp.GetAbsMouseState mousex, mousey, button
Dim Pick As TVCollisionResult
If button Then
Set Pick = Scene.MousePicking(mousex, mousey, TV_COLLIDE_LANDSCAPE Or TV_COLLIDE_MESH, TV_TESTTYPE_ACCURATETESTING)
If Pick.IsCollision Then
'the impact point is the new destination for the actor
ActorDestination = Pick.GetImpactPoint
'compute his new direction (in 2d so remove the y argument)
ActorDestination.y = ActorPosition.y
ActorDir = VNormalize(VSubtract(ActorDestination, ActorPosition))
Actor.Lookat ActorDestination.x, ActorDestination.y, ActorDestination.z
Actor.RotateY 180
Actor.SetAnimationID 1
Actor.PlayAnimation 50
Moving = True
End If
End If
' now do the actor moving.
If Moving = True Then
ActorPosition = VAdd(ActorPosition, VScale(ActorDir, TV.AccurateTimeElapsed * 0.08))
' The Important Part : Accurate Advanced Collision detection.
' Get the landscape point below the actor
Dim LandHeight As Single
LandHeight = Land.GetHeight(ActorPosition.x, ActorPosition.z)
' GRAVITY TEST
' Do a vertical check from the player position + 10 to the landscape.
Dim Coll As TV_COLLISIONRESULT
Dim test As Boolean
test = Scene.AdvancedCollision(Vector3(ActorPosition.x, ActorPosition.y + 10, ActorPosition.z), Vector3(ActorPosition.x, LandHeight, ActorPosition.z), Coll, TV_COLLIDE_MESH, TV_TESTTYPE_ACCURATETESTING, True)
If test = False Then
' there is nothing else than landscape below the actor, so the actor must fall
ActorPosition.y = ActorPosition.y - TV.AccurateTimeElapsed * 0.1
If ActorPosition.y < LandHeight Then ActorPosition.y = LandHeight
Else
' check the impact point of collision
If Coll.collisionimpact.y < ActorPosition.y Then
' if impact is below actor, it must fall,
ActorPosition.y = ActorPosition.y - TV.AccurateTimeElapsed * 0.1
If ActorPosition.y < Coll.collisionimpact.y Then ActorPosition.y = Coll.collisionimpact.y
Else
'else it must go up
ActorPosition.y = Coll.collisionimpact.y
End If
End If
End If
' if we are near the dest point, just stop it
If GetDistance2D(ActorPosition.x, ActorPosition.z, ActorDestination.x, ActorDestination.z) < 0.5 Then
Actor.SetAnimationID 0
Actor.PlayAnimation 20
Moving = False
End If
If Inp.IsKeyPressed(TV_KEY_1) = True Then
Scene.GetCamera.RotateY -TV.AccurateTimeElapsed * 0.02
End If
If Inp.IsKeyPressed(TV_KEY_2) = True Then
Scene.GetCamera.RotateY TV.AccurateTimeElapsed * 0.02
End If
' manage the camera
If mode = 0 Then
If Inp.IsKeyPressed(TV_KEY_LEFT) = True Then
Scene.GetCamera.RotateY -TV.AccurateTimeElapsed * 0.02
End If
If Inp.IsKeyPressed(TV_KEY_RIGHT) = True Then
Scene.GetCamera.RotateY TV.AccurateTimeElapsed * 0.02
End If
If Inp.IsKeyPressed(TV_KEY_UP) = True Then
Scene.GetCamera.MoveRelative TV.AccurateTimeElapsed * 0.2, 0, 0
End If
If Inp.IsKeyPressed(TV_KEY_DOWN) = True Then
Scene.GetCamera.MoveRelative -TV.AccurateTimeElapsed * 0.2, 0, 0
End If
If Inp.IsKeyPressed(TV_KEY_PAGEUP) = True Then
Scene.GetCamera.MoveRelative 0, TV.AccurateTimeElapsed * 0.2, 0
End If
If Inp.IsKeyPressed(TV_KEY_PAGEDOWN) = True Then
Scene.GetCamera.MoveRelative 0, -TV.AccurateTimeElapsed * 0.2, 0
End If
End If
End Sub
Public Sub RenderAll()
If mode = 1 Then
'put the camera above player
Scene.SetCamera ActorPosition.x, ActorPosition.y + 200, ActorPosition.z + 200, ActorPosition.x, ActorPosition.y, ActorPosition.z
End If
'render
TV.Clear
Land.Render
FloorMesh.Render
Actor.SetPosition ActorPosition.x, ActorPosition.y, ActorPosition.z
Actor.Render
TV.RenderToScreen
End Sub
Public Sub MainLoop()
Do
' Render everything to the screen.
DoEvents
RenderAll
' Do Input and physics check
CheckAll
Loop Until Finished = True Or Inp.IsKeyPressed(TV_KEY_ESCAPE) = True
Set TV = Nothing
End
End Sub
Private Sub cmdQuit_Click()
Finished = True
End Sub
Private Sub Form_Load()
Initialize
MainLoop
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Finished = True
End Sub
