Attribute VB_Name = "Shapes"

Option Explicit

Public Const ShapeType_Box As Long = 0
Public Const ShapeType_Sphere As Long = 1
Public Const ShapeType_StaticPlane As Long = 2
Public Const ShapeType_Cylinder As Long = 3
Public Const ShapeType_Capsule As Long = 4
Public Const ShapeType_Cone As Long = 5
Public Const ShapeType_HeightField As Long = 6
Public Const ShapeType_Compound As Long = 7
Public Const ShapeType_ConvexHull As Long = 8

Private Type ChildShape
    Shape As Long
    Pos As Vector3
    XAxis As Vector3
    YAxis As Vector3
End Type

Public Function GetNameOfShapeType(ShapeType As Long) As String
    Select Case ShapeType
    Case ShapeType_Box
        GetNameOfShapeType = "Box"
    Case ShapeType_Capsule
        GetNameOfShapeType = "Capsule"
    Case ShapeType_Compound
        GetNameOfShapeType = "Compound"
    Case ShapeType_Cone
        GetNameOfShapeType = "Cone"
    Case ShapeType_ConvexHull
        GetNameOfShapeType = "Convex hull"
    Case ShapeType_Cylinder
        GetNameOfShapeType = "Cylinder"
    Case ShapeType_HeightField
        GetNameOfShapeType = "Height field"
    Case ShapeType_Sphere
        GetNameOfShapeType = "Sphere"
    Case ShapeType_StaticPlane
        GetNameOfShapeType = "Static plane"
    Case Else
        GetNameOfShapeType = "Unknown shape (" & ShapeType & ")"
    End Select
End Function

Private Function GetShape(Model As Long, Shape As Long, UsedScale As Single) As Long
    Dim CollisionType As Long
    Dim ShapeType As Long
    Dim Point As Long
    Dim Radius As Single
    Dim HalfWidth As Single
    Dim HalfHeight As Single
    Dim HalfDepth As Single
    CollisionType = frmMain.DGE.Model_Shape_GetCollisionType(Model, Shape): RE
    ShapeType = frmMain.DGE.Model_Shape_GetShapeType(Model, Shape): RE
    Radius = frmMain.DGE.Model_Shape_GetRadius(Model, Shape): RE
    HalfWidth = frmMain.DGE.Model_Shape_GetHalfWidth(Model, Shape): RE
    HalfHeight = frmMain.DGE.Model_Shape_GetHalfHeight(Model, Shape): RE
    HalfDepth = frmMain.DGE.Model_Shape_GetHalfDepth(Model, Shape): RE
    GetShape = 0
    Select Case CollisionType
    Case 0
        'Give the shape to the physics engine
        Select Case ShapeType
        Case ShapeType_ConvexHull
            Dim NumberOfPoints As Long
            NumberOfPoints = frmMain.DGE.Model_Shape_GetNumberOfPoints(Model, Shape): RE
            GetShape = frmMain.DGE.CollisionShape_Create_ConvexHull: RE
            For Point = 0 To NumberOfPoints - 1
                'The compensated corner position is eroded by the edge radius from each neighboring plane
                'The direction must be set for this to have any effect
                'Sharp corners can use directions of lengths above 1.0 to erode more
                Dim PointPos As Vector3
                Dim PointDir As Vector3
                Dim Compensated As Vector3
                frmMain.DGE.Model_Shape_GetPoint_OutV3 Model, Shape, Point: PointPos = GetVector3FromMatrixBuffer: RE
                frmMain.DGE.Model_Shape_GetPointDir_OutV3 Model, Shape, Point: PointDir = GetVector3FromMatrixBuffer: RE
                Compensated = SubVector3(PointPos, MulVector3(PointDir, 0.04 / UsedScale))
                frmMain.DGE.CollisionShape_ConvexHull_AddPoint GetShape, Compensated.X, Compensated.Y, Compensated.Z
            Next Point
        Case ShapeType_Box
            GetShape = frmMain.DGE.CollisionShape_Create_Box(HalfWidth, HalfHeight, HalfDepth): RE
        Case ShapeType_Cylinder
            GetShape = frmMain.DGE.CollisionShape_Create_Cylinder(HalfWidth, HalfHeight, HalfDepth): RE
        Case ShapeType_Cone
            GetShape = frmMain.DGE.CollisionShape_Create_Cone(Radius, HalfHeight)
        Case ShapeType_Sphere
            GetShape = frmMain.DGE.CollisionShape_Create_Sphere(Radius)
        Case ShapeType_Capsule
            GetShape = frmMain.DGE.CollisionShape_Create_Capsule(Radius, HalfHeight)
        Case Else
            MsgBox "The shape type """ & GetNameOfShapeType(ShapeType) & """ is not used for compound shapes in this game."
        End Select
    Case Else
        'Do what you want with the shape
    End Select
End Function

Private Sub AddChild(Child As ChildShape, Compound As Long)
    frmMain.DGE.CollisionShape_Compound_AddChild Compound, Child.Shape, Child.Pos.X, Child.Pos.Y, Child.Pos.Z, Child.XAxis.X, Child.XAxis.Y, Child.XAxis.Z, Child.YAxis.X, Child.YAxis.Y, Child.YAxis.Z: RE
End Sub

Public Function GetCollisionShapeFromModel(Model As Long, UniformScale As Single) As Long
    Dim NumberOfShapes As Long
    Dim NumberOfUsableShapes As Long
    Dim Shape As Long
    Dim PreviousChildShape As ChildShape
    Dim NewChildShape As ChildShape
    Dim NewCompoundShape As Long
    If Model = 0 Then
        'There is no model
        GetCollisionShapeFromModel = 0
        
        Exit Function
    End If
    NumberOfShapes = frmMain.DGE.Model_GetNumberOfShapes(Model): RE
    NumberOfUsableShapes = 0
    For Shape = 0 To NumberOfShapes - 1
        NewChildShape.Shape = GetShape(Model, Shape, UniformScale)
        If NewChildShape.Shape > 0 Then
            frmMain.DGE.Model_Shape_GetPos_OutV3 Model, Shape: NewChildShape.Pos = GetVector3FromMatrixBuffer: RE
            frmMain.DGE.Model_Shape_GetXAxis_OutV3 Model, Shape: NewChildShape.XAxis = GetVector3FromMatrixBuffer: RE
            frmMain.DGE.Model_Shape_GetYAxis_OutV3 Model, Shape: NewChildShape.YAxis = GetVector3FromMatrixBuffer: RE
            NumberOfUsableShapes = NumberOfUsableShapes + 1
            If NumberOfUsableShapes = 1 Then
                'Wait for more shapes before making a compound shape
            ElseIf NumberOfUsableShapes = 2 Then
                'Create a compound shape because we have at least 2 shapes to store
                NewCompoundShape = frmMain.DGE.CollisionShape_Create_Compound: RE
                AddChild PreviousChildShape, NewCompoundShape
                AddChild NewChildShape, NewCompoundShape
            Else
                'Add another shape to the compound shape
                AddChild NewChildShape, NewCompoundShape
            End If
            PreviousChildShape = NewChildShape
        End If
    Next Shape
    If NumberOfUsableShapes = 0 Then
        'The model do not want a collision shape
        GetCollisionShapeFromModel = 0
        Exit Function
    ElseIf NumberOfUsableShapes = 1 Then
        If AbsVector3(NewChildShape.Pos) < 0.0001 And DistVector3(NewChildShape.XAxis, MakeVector3(1, 0, 0)) < 0.0001 And DistVector3(NewChildShape.YAxis, MakeVector3(0, 1, 0)) < 0.0001 Then
            'Just return the only shape to save performance
            GetCollisionShapeFromModel = NewChildShape.Shape
        Else
            'Create the compound shape anyway because the transformations is not a unit matrix
            NewCompoundShape = frmMain.DGE.CollisionShape_Create_Compound: RE
            
            'Add it's only child shape
            AddChild NewChildShape, NewCompoundShape
            
            'Return the compound shape
            GetCollisionShapeFromModel = NewCompoundShape
        End If
    Else
        GetCollisionShapeFromModel = NewCompoundShape
    End If
    
    'Set the shape's local scaling
    frmMain.DGE.CollisionShape_SetLocalScaling GetCollisionShapeFromModel, UniformScale, UniformScale, UniformScale: RE
End Function
