Attribute VB_Name = "Shapes"

Option Explicit

'Shape type enumeration
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

'Models for basic shapes
Const MinShapeDetailLevel As Long = 1 'scDetailLevel.min
Const MaxShapeDetailLevel As Long = 16 'scDetailLevel.max
Private Type ShapeModel
    Generated As Boolean
    Model As Long
End Type
Dim Shape_Cube As ShapeModel
Dim Shape_Sphere(MinShapeDetailLevel To MaxShapeDetailLevel) As ShapeModel
Dim Shape_Cone(MinShapeDetailLevel To MaxShapeDetailLevel) As ShapeModel
Dim Shape_Cylinder(MinShapeDetailLevel To MaxShapeDetailLevel) As ShapeModel

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

'Positions are in object and also world space
Public Sub MakeNewQuad(Model As Long, Part As Long, Pos_A As Vector3, Pos_B As Vector3, Pos_C As Vector3, Pos_D As Vector3)
    MakeNewTriangle Model, Part, Pos_A, Pos_B, Pos_C
    MakeNewTriangle Model, Part, Pos_C, Pos_D, Pos_A
End Sub

'Positions are in object and also world space
Public Sub MakeNewTriangle(Model As Long, Part As Long, Pos_A As Vector3, Pos_B As Vector3, Pos_C As Vector3)
    Static Tri As Long
    Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 0, Pos_A.X, Pos_A.Y, Pos_A.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 1, Pos_B.X, Pos_B.Y, Pos_B.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 2, Pos_C.X, Pos_C.Y, Pos_C.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 0, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 1, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 2, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 0, 1: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 1, 1: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 2, 1: RE
    MakeTriangleFaceted Model, Part, Tri
End Sub

Private Function ScTan(ByVal X As Double) As Double
    ScTan = (Tan(((X * 2) - 1) * (PI / 4)) + 1) / 2
End Function

'Positions are in brush space from -1 to +1
Public Sub MakeNewNormalizedPlane_Transformed(Model As Long, Part As Long, Pos_A As Vector3, Pos_B As Vector3, Pos_C As Vector3, Pos_D As Vector3, Sections As Long, Origin As Vector3, AxisSystem As Matrix3)
    Static U As Long
    Static StartU As Double
    Static EndU As Double
    Static V As Long
    Static StartV As Double
    Static EndV As Double
    Static SubPos_A As Vector3
    Static SubPos_B As Vector3
    Static SubPos_C As Vector3
    Static SubPos_D As Vector3
    For U = 1 To Sections
        For V = 1 To Sections
            StartU = ScTan((U - 1) / Sections)
            EndU = ScTan(U / Sections)
            StartV = ScTan((V - 1) / Sections)
            EndV = ScTan(V / Sections)
            SubPos_A = LerpVector3(LerpVector3(Pos_A, Pos_B, StartU), LerpVector3(Pos_D, Pos_C, StartU), StartV)
            SubPos_B = LerpVector3(LerpVector3(Pos_A, Pos_B, EndU), LerpVector3(Pos_D, Pos_C, EndU), StartV)
            SubPos_C = LerpVector3(LerpVector3(Pos_A, Pos_B, EndU), LerpVector3(Pos_D, Pos_C, EndU), EndV)
            SubPos_D = LerpVector3(LerpVector3(Pos_A, Pos_B, StartU), LerpVector3(Pos_D, Pos_C, StartU), EndV)
            
            'Choose triangulation to make the surface convex
            If Lerp(StartU, EndU, 0.9) > 0.5 Xor Lerp(StartV, EndV, 0.9) > 0.5 Then
                MakeNewTriangle_Transformed Model, Part, NormalVector3(SubPos_B), NormalVector3(SubPos_C), NormalVector3(SubPos_D), Origin, AxisSystem
                MakeNewTriangle_Transformed Model, Part, NormalVector3(SubPos_D), NormalVector3(SubPos_A), NormalVector3(SubPos_B), Origin, AxisSystem
            Else
                MakeNewTriangle_Transformed Model, Part, NormalVector3(SubPos_A), NormalVector3(SubPos_B), NormalVector3(SubPos_C), Origin, AxisSystem
                MakeNewTriangle_Transformed Model, Part, NormalVector3(SubPos_C), NormalVector3(SubPos_D), NormalVector3(SubPos_A), Origin, AxisSystem
            End If
        Next V
    Next U
End Sub

'Positions are in brush space from -1 to +1
Public Sub MakeNewQuad_Transformed(Model As Long, Part As Long, Pos_A As Vector3, Pos_B As Vector3, Pos_C As Vector3, Pos_D As Vector3, Origin As Vector3, AxisSystem As Matrix3)
    MakeNewTriangle_Transformed Model, Part, Pos_A, Pos_B, Pos_C, Origin, AxisSystem
    MakeNewTriangle_Transformed Model, Part, Pos_C, Pos_D, Pos_A, Origin, AxisSystem
End Sub

'Positions are in brush space from -1 to +1
Public Sub MakeNewTriangle_Transformed(Model As Long, Part As Long, Pos_A As Vector3, Pos_B As Vector3, Pos_C As Vector3, Origin As Vector3, AxisSystem As Matrix3)
    Static Tri As Long
    Static FinalPos_A As Vector3
    Static FinalPos_B As Vector3
    Static FinalPos_C As Vector3
    FinalPos_A = AddVector3(MulVecMat3(Pos_A, AxisSystem), Origin)
    FinalPos_B = AddVector3(MulVecMat3(Pos_B, AxisSystem), Origin)
    FinalPos_C = AddVector3(MulVecMat3(Pos_C, AxisSystem), Origin)
    Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 0, FinalPos_A.X, FinalPos_A.Y, FinalPos_A.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 1, FinalPos_B.X, FinalPos_B.Y, FinalPos_B.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 2, FinalPos_C.X, FinalPos_C.Y, FinalPos_C.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 0, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 1, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, 2, Rnd, Rnd, Rnd, Rnd: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 0, 1: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 1, 1: RE
    frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, 2, 1: RE
    MakeTriangleFaceted Model, Part, Tri
End Sub

Private Sub MakeTriangleFaceted(Model As Long, Part As Long, Tri As Long)
    Static Vert As Long
    Static Pos(0 To 2) As Vector3
    Static Normal As Vector3
    For Vert = 0 To 2
        Pos(Vert) = Model_Part_Vertice_GetPos(Model, Part, Tri, Vert)
    Next Vert
    Normal = GenerateNormalFromPoints(Pos(2), Pos(1), Pos(0))
    For Vert = 0 To 2
        frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, Normal.X, Normal.Y, Normal.Z: RE
    Next Vert
End Sub

Public Sub CreateShape_Physical(Model As Long, Origin As Vector3, NormalizedAxisSystem As Matrix3, HalfDimensions As Vector3, Radius As Single, ShapeType As Long)
    Dim Shape As Long
    InsertStringToEngine "No name"
    Shape = frmMain.DGE.Model_Shape_Create_InSB(Model, ShapeType): RE
    frmMain.DGE.Model_Shape_SetPos Model, Shape, Origin.X, Origin.Y, Origin.Z: RE
    frmMain.DGE.Model_Shape_SetXAxis Model, Shape, NormalizedAxisSystem.XAxis.X, NormalizedAxisSystem.XAxis.Y, NormalizedAxisSystem.XAxis.Z: RE
    frmMain.DGE.Model_Shape_SetYAxis Model, Shape, NormalizedAxisSystem.YAxis.X, NormalizedAxisSystem.YAxis.Y, NormalizedAxisSystem.YAxis.Z: RE
    frmMain.DGE.Model_Shape_SetZAxis Model, Shape, NormalizedAxisSystem.ZAxis.X, NormalizedAxisSystem.ZAxis.Y, NormalizedAxisSystem.ZAxis.Z: RE
    frmMain.DGE.Model_Shape_SetHalfWidth Model, Shape, HalfDimensions.X: RE
    frmMain.DGE.Model_Shape_SetHalfHeight Model, Shape, HalfDimensions.Y: RE
    frmMain.DGE.Model_Shape_SetHalfDepth Model, Shape, HalfDimensions.Z: RE
    frmMain.DGE.Model_Shape_SetRadius Model, Shape, Radius: RE
End Sub

Public Sub CreateShape_Physical_WithoutRadius(Model As Long, Origin As Vector3, AxisSystem As Matrix3, ShapeType As Long)
    Dim HalfDimensions As Vector3
    Dim NormalizedAxisSystem As Matrix3
    HalfDimensions = MakeVector3(AbsVector3(AxisSystem.XAxis), AbsVector3(AxisSystem.YAxis), AbsVector3(AxisSystem.ZAxis))
    NormalizedAxisSystem = MakeMatrix3(NormalVector3(AxisSystem.XAxis), NormalVector3(AxisSystem.YAxis), NormalVector3(AxisSystem.ZAxis))
    CreateShape_Physical Model, Origin, NormalizedAxisSystem, HalfDimensions, 0, ShapeType
End Sub

Public Sub CreateShape_Physical_Box(Model As Long, Origin As Vector3, AxisSystem As Matrix3)
    CreateShape_Physical_WithoutRadius Model, Origin, AxisSystem, ShapeType_Box
End Sub

Public Sub CreateShape_Physical_Cylinder(Model As Long, Origin As Vector3, AxisSystem As Matrix3)
    CreateShape_Physical_WithoutRadius Model, Origin, AxisSystem, ShapeType_Cylinder
End Sub

Public Sub CreateShape_Physical_Cone(Model As Long, Origin As Vector3, AxisSystem As Matrix3)
    Dim Radius As Single
    Dim HalfHeight As Single
    Dim NormalizedAxisSystem As Matrix3
    Radius = AbsVector3(AxisSystem.XAxis)
    HalfHeight = AbsVector3(AxisSystem.YAxis)
    NormalizedAxisSystem = MakeMatrix3(NormalVector3(AxisSystem.XAxis), NormalVector3(AxisSystem.YAxis), NormalVector3(AxisSystem.ZAxis))
    CreateShape_Physical Model, Origin, NormalizedAxisSystem, MakeVector3(0, HalfHeight, 0), Radius, ShapeType_Cone
End Sub

Public Sub CreateShape_Physical_Sphere(Model As Long, Origin As Vector3, AxisSystem As Matrix3)
    Dim Radius As Single
    Dim NormalizedAxisSystem As Matrix3
    Radius = AbsVector3(AxisSystem.XAxis)
    NormalizedAxisSystem = MakeMatrix3(NormalVector3(AxisSystem.XAxis), NormalVector3(AxisSystem.YAxis), NormalVector3(AxisSystem.ZAxis))
    CreateShape_Physical Model, Origin, NormalizedAxisSystem, MakeVector3(0, 0, 0), Radius, ShapeType_Sphere
End Sub

Public Sub CreateShape_Graphical_Box(Model As Long, PartIndex As Long, Origin As Vector3, AxisSystem As Matrix3)
    'Generate triangles
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(-1, -1, -1), MakeVector3(-1, -1, 1), MakeVector3(-1, 1, 1), MakeVector3(-1, 1, -1), Origin, AxisSystem 'Left
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(1, 1, -1), MakeVector3(1, 1, 1), MakeVector3(1, -1, 1), MakeVector3(1, -1, -1), Origin, AxisSystem 'Right
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(-1, 1, -1), MakeVector3(-1, 1, 1), MakeVector3(1, 1, 1), MakeVector3(1, 1, -1), Origin, AxisSystem 'Top
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(-1, -1, -1), MakeVector3(1, -1, -1), MakeVector3(1, -1, 1), MakeVector3(-1, -1, 1), Origin, AxisSystem 'Bottom
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(1, -1, -1), MakeVector3(-1, -1, -1), MakeVector3(-1, 1, -1), MakeVector3(1, 1, -1), Origin, AxisSystem 'Front
    MakeNewQuad_Transformed Model, PartIndex, MakeVector3(1, 1, 1), MakeVector3(-1, 1, 1), MakeVector3(-1, -1, 1), MakeVector3(1, -1, 1), Origin, AxisSystem 'Back
End Sub

Public Sub CreateShape_Graphical_Sphere(Model As Long, PartIndex As Long, Origin As Vector3, AxisSystem As Matrix3, Sections As Long)
    'Generate triangles
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(-1, -1, -1), MakeVector3(-1, -1, 1), MakeVector3(-1, 1, 1), MakeVector3(-1, 1, -1), Sections, Origin, AxisSystem 'Left
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(1, 1, -1), MakeVector3(1, 1, 1), MakeVector3(1, -1, 1), MakeVector3(1, -1, -1), Sections, Origin, AxisSystem 'Right
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(-1, 1, -1), MakeVector3(-1, 1, 1), MakeVector3(1, 1, 1), MakeVector3(1, 1, -1), Sections, Origin, AxisSystem 'Top
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(-1, -1, -1), MakeVector3(1, -1, -1), MakeVector3(1, -1, 1), MakeVector3(-1, -1, 1), Sections, Origin, AxisSystem 'Bottom
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(1, -1, -1), MakeVector3(-1, -1, -1), MakeVector3(-1, 1, -1), MakeVector3(1, 1, -1), Sections, Origin, AxisSystem 'Front
    MakeNewNormalizedPlane_Transformed Model, PartIndex, MakeVector3(1, 1, 1), MakeVector3(-1, 1, 1), MakeVector3(-1, -1, 1), MakeVector3(1, -1, 1), Sections, Origin, AxisSystem 'Back
End Sub

Public Sub CreateShape_Graphical_Cone(Model As Long, PartIndex As Long, Origin As Vector3, AxisSystem As Matrix3, Sections As Long)
    'Generate triangles
    Static I As Long
    Static StartAngle As Single
    Static EndAngle As Single
    For I = 1 To Sections
        StartAngle = (I - 1) * (PI * 2) / Sections
        EndAngle = I * (PI * 2) / Sections
        
        'Top
        MakeNewTriangle_Transformed Model, PartIndex, MakeVector3(0, 1, 0), MakeVector3(Sin(StartAngle), -1, Cos(StartAngle)), MakeVector3(Sin(EndAngle), -1, Cos(EndAngle)), Origin, AxisSystem
        
        'Base
        MakeNewTriangle_Transformed Model, PartIndex, MakeVector3(0, -1, 0), MakeVector3(Sin(EndAngle), -1, Cos(EndAngle)), MakeVector3(Sin(StartAngle), -1, Cos(StartAngle)), Origin, AxisSystem
    Next I
End Sub

Public Sub CreateShape_Graphical_Cylinder(Model As Long, PartIndex As Long, Origin As Vector3, AxisSystem As Matrix3, Sections As Long)
    'Generate triangles
    Static I As Long
    Static StartAngle As Single
    Static EndAngle As Single
    For I = 1 To Sections
        StartAngle = (I - 1) * (PI * 2) / Sections
        EndAngle = I * (PI * 2) / Sections
        
        'Top
        MakeNewTriangle_Transformed Model, PartIndex, MakeVector3(0, 1, 0), MakeVector3(Sin(StartAngle), 1, Cos(StartAngle)), MakeVector3(Sin(EndAngle), 1, Cos(EndAngle)), Origin, AxisSystem
        
        'Edge
        MakeNewQuad_Transformed Model, PartIndex, MakeVector3(Sin(StartAngle), 1, Cos(StartAngle)), MakeVector3(Sin(StartAngle), -1, Cos(StartAngle)), MakeVector3(Sin(EndAngle), -1, Cos(EndAngle)), MakeVector3(Sin(EndAngle), 1, Cos(EndAngle)), Origin, AxisSystem
        
        'Base
        MakeNewTriangle_Transformed Model, PartIndex, MakeVector3(0, -1, 0), MakeVector3(Sin(EndAngle), -1, Cos(EndAngle)), MakeVector3(Sin(StartAngle), -1, Cos(StartAngle)), Origin, AxisSystem
    Next I
End Sub

Private Function GetShape(Shape As ShapeModel, ShapeType As Long, DetailLevel As Long)
    Dim Model As Long
    Dim Part As Long
    If Not (Shape.Generated) Then
        Model = frmMain.DGE.Model_CreateEmpty: RE
        Part = frmMain.DGE.Model_Part_Create_InSB(Model, 8)
        
        'MakeVector3(0, 0, 0) and MakeUnitMatrix3 will be removed when the preview models are transformed into the generated shape
        Select Case ShapeType
        Case ShapeType_Box
            CreateShape_Graphical_Box Model, Part, MakeVector3(0, 0, 0), MakeUnitMatrix3
        Case ShapeType_Sphere
            CreateShape_Graphical_Sphere Model, Part, MakeVector3(0, 0, 0), MakeUnitMatrix3, DetailLevel
        Case ShapeType_Cone
            CreateShape_Graphical_Cone Model, Part, MakeVector3(0, 0, 0), MakeUnitMatrix3, DetailLevel * 4
        Case ShapeType_Cylinder
            CreateShape_Graphical_Cylinder Model, Part, MakeVector3(0, 0, 0), MakeUnitMatrix3, DetailLevel * 4
        Case Else
            MsgBox GetNameOfShapeType(ShapeType) & " is not yet supported in GetShape"
        End Select
        Shape.Model = Model
        Shape.Generated = True
    End If
    GetShape = Shape.Model
End Function

Public Function GetBasicShapeModel(ShapeType As Long, DetailLevel As Long) As Long
    Select Case ShapeType
    Case ShapeType_Box
        GetBasicShapeModel = GetShape(Shape_Cube, ShapeType, 1)
    Case ShapeType_Cone
        GetBasicShapeModel = GetShape(Shape_Cone(DetailLevel), ShapeType, DetailLevel)
    Case ShapeType_Cylinder
        GetBasicShapeModel = GetShape(Shape_Cylinder(DetailLevel), ShapeType, DetailLevel)
    Case ShapeType_Sphere
        GetBasicShapeModel = GetShape(Shape_Sphere(DetailLevel), ShapeType, DetailLevel)
    Case Else
        MsgBox GetNameOfShapeType(ShapeType) & " is not yet supported in GetBasicShapeModel"
    End Select
End Function
