Attribute VB_Name = "Grid"

'A 3D grid for storing 32 bit integers in 3D positions

Option Explicit

Private Const MaxElementsPerBucket As Long = 64
Private Type Bucket
    Elements(0 To MaxElementsPerBucket - 1) As Long
    NumberOfElements As Long
End Type

Dim MinX As Single
Dim MinY As Single
Dim MinZ As Single
Dim MaxX As Single
Dim MaxY As Single
Dim MaxZ As Single

Private Const Sections As Long = 32

'The grid that makes it fast to get a vertice by index
Dim Grid(0 To Sections - 1, 0 To Sections - 1, 0 To Sections - 1) As Bucket

'Holds the elements that did not fit into the grid
Dim Spills() As Long
Dim NumberOfSpills As Long

'Holds the elements from the last query
Dim QueryResults() As Long
Public Grid_NumberOfQueryResults As Long

Public Sub Grid_Reset(NewMinX As Single, NewMinY As Single, NewMinZ As Single, NewMaxX As Single, NewMaxY As Single, NewMaxZ As Single)
    Dim X As Long
    Dim Y As Long
    Dim Z As Long
    For X = 0 To Sections - 1
        For Y = 0 To Sections - 1
            For Z = 0 To Sections - 1
                Grid(X, Y, Z).NumberOfElements = 0
            Next Z
        Next Y
    Next X
    ReDim Spills(0 To 255)
    ReDim QueryResults(0 To 255)
    MinX = NewMinX
    MinY = NewMinY
    MinZ = NewMinZ
    MaxX = NewMaxX
    MaxY = NewMaxY
    MaxZ = NewMaxZ
End Sub

Public Sub Grid_Insert(NewIndex As Long, X As Single, Y As Single, Z As Single)
    Dim Location As Vector3
    Dim BucketX As Long
    Dim BucketY As Long
    Dim BucketZ As Long
    Location = MulVector3(InverseLerpVector3(MakeVector3(MinX, MinY, MinZ), MakeVector3(MaxX, MaxY, MaxZ), MakeVector3(X, Y, Z)), Sections)
    BucketX = Clamp_Long(Int(Location.X), 0, Sections - 1)
    BucketY = Clamp_Long(Int(Location.Y), 0, Sections - 1)
    BucketZ = Clamp_Long(Int(Location.Z), 0, Sections - 1)
    If Grid(BucketX, BucketY, BucketZ).NumberOfElements >= MaxElementsPerBucket Then
        'Add to spill
        AddToDynamicArray Spills, NumberOfSpills, NewIndex
    Else
        'Add to grid
        Grid(BucketX, BucketY, BucketZ).Elements(Grid(BucketX, BucketY, BucketZ).NumberOfElements) = NewIndex
        Grid(BucketX, BucketY, BucketZ).NumberOfElements = Grid(BucketX, BucketY, BucketZ).NumberOfElements + 1
    End If
End Sub

'Store data about the search in a dynamic array
Public Sub Grid_Query(QX As Single, QY As Single, QZ As Single, Tolerance As Single)
    Dim QMin As Vector3
    Dim QMax As Vector3
    Dim MinLocation As Vector3
    Dim MaxLocation As Vector3
    Dim MinBucketX As Long
    Dim MinBucketY As Long
    Dim MinBucketZ As Long
    Dim MaxBucketX As Long
    Dim MaxBucketY As Long
    Dim MaxBucketZ As Long
    Dim X As Long
    Dim Y As Long
    Dim Z As Long
    Dim E As Long
    Dim MayHaveSpill As Boolean
    QMin = MakeVector3(QX - Tolerance, QY - Tolerance, QZ - Tolerance)
    QMax = MakeVector3(QX + Tolerance, QY + Tolerance, QZ + Tolerance)
    MinLocation = MulVector3(InverseLerpVector3(MakeVector3(MinX, MinY, MinZ), MakeVector3(MaxX, MaxY, MaxZ), QMin), Sections)
    MinBucketX = Clamp_Long(Int(MinLocation.X), 0, Sections - 1)
    MinBucketY = Clamp_Long(Int(MinLocation.Y), 0, Sections - 1)
    MinBucketZ = Clamp_Long(Int(MinLocation.Z), 0, Sections - 1)
    MaxLocation = MulVector3(InverseLerpVector3(MakeVector3(MinX, MinY, MinZ), MakeVector3(MaxX, MaxY, MaxZ), QMax), Sections)
    MaxBucketX = Clamp_Long(Int(MaxLocation.X), 0, Sections - 1)
    MaxBucketY = Clamp_Long(Int(MaxLocation.Y), 0, Sections - 1)
    MaxBucketZ = Clamp_Long(Int(MaxLocation.Z), 0, Sections - 1)
    Grid_NumberOfQueryResults = 0
    MayHaveSpill = False
    For X = MinBucketX To MaxBucketX
        For Y = MinBucketY To MaxBucketY
            For Z = MinBucketZ To MaxBucketZ
                For E = 0 To Grid(X, Y, Z).NumberOfElements - 1
                    AddToDynamicArray QueryResults, Grid_NumberOfQueryResults, Grid(X, Y, Z).Elements(E)
                Next E
                If Grid(X, Y, Z).NumberOfElements >= MaxElementsPerBucket Then
                    MayHaveSpill = True
                End If
            Next Z
        Next Y
    Next X
    If MayHaveSpill Then
        For E = 0 To NumberOfSpills - 1
            AddToDynamicArray QueryResults, Grid_NumberOfQueryResults, Spills(E)
        Next E
    End If
End Sub

Private Sub AddToDynamicArray(ByRef A As Variant, ByRef Counter As Long, ByVal NewIndex As Long)
    If Counter > UBound(A) Then
        ReDim Preserve A(0 To UBound(A) * 2)
    End If
    A(Counter) = NewIndex
    Counter = Counter + 1
End Sub

'Precondition: 0 <= Index < Grid_NumberOfQueryResults
Public Function Grid_GetQueryResult(Index As Long) As Long
    Debug.Assert 0 <= Index
    Debug.Assert Index < Grid_NumberOfQueryResults
    Grid_GetQueryResult = QueryResults(Index)
End Function
