Attribute VB_Name = "World"

Option Explicit

'Map dimensions
Public Const MapWidth As Long = 128
Public Const MapHeight As Long = 128

'View dimensions
Public Const ViewRadius As Long = 32

'The maze
Public Model_Maze As Long
Public Instance_Maze As Long
Public Drawsurface_Map As Long 'The color and heightmap for the tiles
Public HeightMap(0 To MapWidth - 1, 0 To MapHeight - 1) As Long 'The integer representation of what the draw surface will store in the alpha channel
Public HasWall(0 To MapWidth - 1, 0 To MapHeight - 1) As Boolean 'A helper for random generation

Public Sub World_Init()
    'Generate map
    Drawsurface_Map = frmMain.DGE.DrawSurface_CreateFixed(MapWidth, MapHeight, 0, False): RE
    frmMain.DGE.DrawSurface_FillWithColor Drawsurface_Map, 0.1, 0.5, 0.1, 0: RE
    GenerateMap
    
    'Generate 2D grid of triangles
    Model_Maze = GenerateTrianglePlane(-ViewRadius + 1, -ViewRadius + 1, ViewRadius, ViewRadius)
    Instance_Maze = frmMain.DGE.Instance_Create(Model_Maze)
End Sub

Public Sub GenerateMap()
    Dim Size As Long
    Dim Height As Long
    Dim MinX As Long
    Dim MinZ As Long
    Dim MaxX As Long
    Dim MaxZ As Long
    Dim I As Long
    Dim X As Long
    Dim Z As Long
    
    'Reset the CPU's height map
    For Z = MinZ To MaxZ
        For X = MinX To MaxX
            HeightMap(X, Z) = 0
            HasWall(X, Z) = False
        Next X
    Next Z
    
    'Create towers
    For I = 0 To MapWidth * MapHeight / 64
        Size = (Int(Rnd * 3) * 2) + 4
        Height = (Int(Rnd * 5) * 2) + 1
        MinX = Int(Rnd * (MapWidth - Size) / 2) * 2
        MinZ = Int(Rnd * (MapWidth - Size) / 2) * 2
        MaxX = MinX + Size
        MaxZ = MinZ + Size
        For Z = MinZ To MaxZ
            For X = MinX To MaxX
                'Depth mask
                If Height > HeightMap(X, Z) Then
                    HeightMap(X, Z) = Height
                End If
            Next X
        Next Z
    Next I
    
    'FillSmallGaps_CPU
    AddWalls_CPU
    
    'Copy from CPU to GPU
    For Z = 0 To MapWidth - 1
        For X = 0 To MapHeight - 1
            UpdateTile X, Z
        Next X
    Next Z
End Sub

Private Sub UpdateTile(X As Long, Z As Long)
    Dim Red As Single
    Dim Green As Single
    Dim Blue As Single
    If HasWall(X, Z) Then
        Red = 0.5
        Green = 0.5
        Blue = 0.5
    Else
        Red = 0.6
        Green = 0.5
        Blue = 0.4
    End If
    frmMain.DGE.DrawSurface_SetPixelColor Drawsurface_Map, X, Z, Red, Green, Blue, HeightMap(X, Z): RE
End Sub

'Modifying HeightMap to add walls
Private Sub AddWalls_CPU()
    Dim X As Long
    Dim Z As Long
    Dim CenterHeight As Long
    
    'Horizontal
    For Z = 0 To MapWidth - 1
        For X = 0 To MapHeight - 1
            CenterHeight = GetGroundHeight_Tile(X, Z)
            HasWall(X, Z) = (CenterHeight > GetGroundHeight_Tile(X + 1, Z) Or CenterHeight > GetGroundHeight_Tile(X - 1, Z) Or CenterHeight > GetGroundHeight_Tile(X, Z + 1) Or CenterHeight > GetGroundHeight_Tile(X, Z - 1) Or CenterHeight > GetGroundHeight_Tile(X + 1, Z - 1) Or CenterHeight > GetGroundHeight_Tile(X - 1, Z + 1) Or CenterHeight > GetGroundHeight_Tile(X + 1, Z + 1) Or CenterHeight > GetGroundHeight_Tile(X - 1, Z - 1))
        Next X
    Next Z
    For Z = 0 To MapWidth - 1
        For X = 0 To MapHeight - 1
            If HasWall(X, Z) Then
                If (X Mod 2 = 1) Xor (Z Mod 2 = 1) Then
                    HeightMap(X, Z) = HeightMap(X, Z) + 1
                Else
                    HeightMap(X, Z) = HeightMap(X, Z) + 2
                End If
            End If
        Next X
    Next Z
End Sub

'Fill places that are difficult to stand on
Private Sub FillSmallGaps_CPU()
    Dim X As Long
    Dim Z As Long
    For X = 1 To MapHeight - 2
        For Z = 1 To MapWidth - 2
            If HeightMap(X, Z) < HeightMap(X - 1, Z) And HeightMap(X, Z) < HeightMap(X + 1, Z) Then
                HeightMap(X, Z) = Min_Long(HeightMap(X - 1, Z), HeightMap(X + 1, Z))
            ElseIf HeightMap(X, Z) < HeightMap(X, Z - 1) And HeightMap(X, Z) < HeightMap(X, Z + 1) Then
                HeightMap(X, Z) = Min_Long(HeightMap(X, Z - 1), HeightMap(X, Z + 1))
            End If
        Next Z
    Next X
End Sub

Public Function GenerateTrianglePlane(MinX As Long, MinZ As Long, MaxX As Long, MaxZ As Long) As Long
    Dim Model As Long
    Dim Part As Long
    Dim Tri As Long
    Dim Vert As Long
    Dim X As Long
    Dim Z As Long
    Dim MidX As Long
    Dim MidZ As Long
    Dim Pos(0 To 2) As Vector3
    
    'Create a model
    Model = frmMain.DGE.Model_CreateEmpty: RE
    
    'Disable culling
    InsertStringToEngine "None": frmMain.DGE.Model_SetCullingUsingName_InSB Model: RE
    
    'Create a part in the model
    InsertStringToEngine "MazePart": Part = frmMain.DGE.Model_Part_Create_InSB(Model, (MaxX - MinX) * (MaxZ - MinZ)): RE
        
        'Give shaders
        InsertStringToEngine "M_Maze": frmMain.DGE.Model_Part_SetShader_ByName_InSB Model, Part, 0 'Visible geometry
        InsertStringToEngine "M_Maze_Shadow": frmMain.DGE.Model_Part_SetShader_ByName_InSB Model, Part, 1 'Shadows
        
        'Give textures
        InsertStringToEngine "Sand": frmMain.DGE.Model_Part_SetTexture_ByName_InSB Model, Part, 0: RE
        frmMain.DGE.Model_Part_SetTextureOverride Model, Part, 1, 0: RE 'Textures given to override channel 0 will be given to texture channel 1
        
        MidX = (MinX + MaxX) / 2
        MidZ = (MinZ + MaxZ) / 2
        
        'Create triangles from inside and out for fewer redrawn pixels
        For X = MidX To MinX Step -1
            For Z = MidZ To MinZ Step -1
                Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
                Pos(0) = MakeVector3((X), 0, (Z))
                Pos(1) = MakeVector3((X), 0, Z + 1)
                Pos(2) = MakeVector3((X) + 1, 0, (Z))
                For Vert = 0 To 2
                    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, Vert, Pos(Vert).X, Pos(Vert).Y, Pos(Vert).Z: RE
                    frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, 0, 1, 0: RE
                Next Vert
            Next Z
        Next X
        For X = MidX To MinX Step -1
            For Z = MidZ + 1 To MaxZ - 1
                Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
                Pos(0) = MakeVector3((X), 0, (Z))
                Pos(1) = MakeVector3((X), 0, Z + 1)
                Pos(2) = MakeVector3((X) + 1, 0, (Z))
                For Vert = 0 To 2
                    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, Vert, Pos(Vert).X, Pos(Vert).Y, Pos(Vert).Z: RE
                    frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, 0, 1, 0: RE
                Next Vert
            Next Z
        Next X
        For X = MidX + 1 To MaxX - 1
            For Z = MidZ To MinZ Step -1
                Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
                Pos(0) = MakeVector3((X), 0, (Z))
                Pos(1) = MakeVector3((X), 0, Z + 1)
                Pos(2) = MakeVector3((X) + 1, 0, (Z))
                For Vert = 0 To 2
                    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, Vert, Pos(Vert).X, Pos(Vert).Y, Pos(Vert).Z: RE
                    frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, 0, 1, 0: RE
                Next Vert
            Next Z
        Next X
        For X = MidX + 1 To MaxX - 1
            For Z = MidZ + 1 To MaxZ - 1
                Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part): RE
                Pos(0) = MakeVector3((X), 0, (Z))
                Pos(1) = MakeVector3((X), 0, Z + 1)
                Pos(2) = MakeVector3((X) + 1, 0, (Z))
                For Vert = 0 To 2
                    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, Vert, Pos(Vert).X, Pos(Vert).Y, Pos(Vert).Z: RE
                    frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, 0, 1, 0: RE
                Next Vert
            Next Z
        Next X
    
    'Return the model's reference number
    GenerateTrianglePlane = Model
End Function

Public Function GetGroundHeight_Tile(X As Long, Z As Long) As Long
    If X < 0 Or Z < 0 Or X >= MapWidth Or Z >= MapHeight Then
        GetGroundHeight_Tile = 0
    Else
        GetGroundHeight_Tile = HeightMap(X, Z)
    End If
End Function

Public Function GetGroundHeight_Point(Pos As Vector3, Tolerance As Single) As Single
    Dim X As Long
    Dim Z As Long
    X = Int(Pos.X)
    Z = Int(Pos.Z)
    GetGroundHeight_Point = GetGroundHeight_Tile(X, Z)
    If GetGroundHeight_Point > Pos.Y + Tolerance Then
        GetGroundHeight_Point = 0
    End If
End Function

Public Function GetGroundHeight_4Point(Pos As Vector3, Tolerance As Single, Radius As Single) As Single
    GetGroundHeight_4Point = Max_Float( _
        Max_Float(GetGroundHeight_Point(AddVector3(Pos, MakeVector3(Radius, 0, Radius)), Tolerance), _
                  GetGroundHeight_Point(AddVector3(Pos, MakeVector3(Radius, 0, -Radius)), Tolerance)), _
        Max_Float(GetGroundHeight_Point(AddVector3(Pos, MakeVector3(-Radius, 0, -Radius)), Tolerance), _
                  GetGroundHeight_Point(AddVector3(Pos, MakeVector3(-Radius, 0, Radius)), Tolerance)))
End Function

Public Function DestroyTile(Pos As Vector3, Depth As Single) As Boolean
    Dim X As Long
    Dim Z As Long
    Dim R As Single
    Dim G As Single
    Dim B As Single
    Dim OldHeight As Long
    X = Int(Pos.X)
    Z = Int(Pos.Z)
    DestroyTile = False
    If Not (X < 0 Or Z < 0 Or X >= MapWidth Or Z >= MapHeight) Then
        OldHeight = HeightMap(X, Z)
        If OldHeight > 0 And Pos.Y - Depth < OldHeight Then
            HeightMap(X, Z) = OldHeight - 1
            UpdateTile X, Z
            DestroyTile = True
        End If
    End If
End Function

Public Function GetPressureFromSphere(Pos As Vector3, Radius As Single) As Vector3
    Dim X As Long
    Dim Z As Long
    Dim MinX As Long
    Dim MaxX As Long
    Dim MinZ As Long
    Dim MaxZ As Long
    Dim GroundHeight As Single
    Dim ClosestPoint As Vector3
    Dim Diff As Vector3
    Dim Dist As Single
    MinX = Max_Long(0, Int(Pos.X) - 1 - Radius)
    MaxX = Min_Long(MapWidth, Int(Pos.X) + 1 + Radius)
    MinZ = Max_Long(0, Int(Pos.Z) - 1 - Radius)
    MaxZ = Min_Long(MapHeight, Int(Pos.Z) + 1 + Radius)
    GetPressureFromSphere = MakeVector3(0, 0, 0)
    For X = MinX To MaxX
        For Z = MinZ To MaxZ
            GroundHeight = GetGroundHeight_Tile(X, Z)
            ClosestPoint = ClosestPointAtBox(Pos, MakeBox_FromArgs((X), -1000000000, (Z), X + 1, GroundHeight, Z + 1))
            Diff = ToVector3(ClosestPoint, Pos)
            Dist = AbsVector3(Diff)
            If Dist < Radius And Dist > 0.0001 Then
                GetPressureFromSphere = AddVector3(GetPressureFromSphere, MulVector3(NormalVector3(Diff), Radius - Dist))
            End If
        Next Z
    Next X
End Function
