VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Geometry_Set"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

'Responsibilities:
'   * Init must be called before anything else is called in a new instance of the class.
'   * Record history
'       If a cell is modified in a significant way then the undo history must be recorded using *_Record or cleared using ClearUndoHistory.
'       The caller is responsible to end each sequence of recordings by calling DoneRecordingHistory.
'   * Set GeometryChanged
'       If visual appearance in either grid view or perspective changes then the GeometryChanged flag must be set to true before next call to NeedGraphics.
'   * Call UpdateCellBound
'       If the bounding box of a cell cell has changed then UpdateCellBound must be called with the cell before it is given to ReplaceCell_Record.
'       A cell once given to ReplaceCell_Record will be stored as it is and brought back if you undo and redo the action.
'   * Call GenerateCellFromPlanes
'       If the surfaces are not according to the plane equation or not existing then GenerateCellFromPlanes must be used before giving the result to *_Record.

Private Cells() As Cell
Private NumberOfCells As Long

'いい TODO: Make materials in a way that is compatible with undo history
Private NumberOfMaterials As Long

'Undo/redo history
Private Enum TypeOfChangeEnum
    AddingCell
    RemovingCell
End Enum
Private Type CellChange
    'The index of the cell to add or remove
    CellIndex As Long
    'The content of the added or removed cell
    Content As Cell
    'Adding adds Content at CellIndex on redo
    'Adding removes Content at CellIndex on undo
    'Not Adding removes Content at CellIndex on redo
    'Not Adding adds Content at CellIndex on undo
    TypeOfChange As TypeOfChangeEnum
    'The first event in the group has event index 0. Subtract the index to get the first change in the step.
    EventIndex As Long
End Type
Private HistoryBufferSize As Long
Private UndoBuffer() As CellChange 'Always HistoryBufferSize elements but using fixed module memory would reach the upper limits
Private EventCounter As Long 'How many changes are grouped in the current recording
Private UndoHistoryStart As Long 'Where does the first undo event begin
Private UndoHistorySize As Long 'Number of stored events
Private RedoSize As Long 'Number of events to redo

'Parsing
Private Enum StateEnum
    Root
    Material
    Cell
    Surface
End Enum

Private GeometryChanged_Preview As Boolean
Private GeometryChanged_Final As Boolean

Private Sub GeometryChanged()
    GeometryChanged_Preview = True
    GeometryChanged_Final = True
End Sub

Public Sub Init(CanUndo As Boolean)
    ReDim Cells(0 To 63)
    If CanUndo Then
        HistoryBufferSize = 16384
        ReDim UndoBuffer(0 To HistoryBufferSize - 1)
    End If
    Reset
End Sub

Public Sub Reset()
    NumberOfCells = 0
    NumberOfMaterials = 0
    GeometryChanged
End Sub

Public Sub Validate()
    Dim Errors As String
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        ValidateCell Cells(CellIndex), Errors
    Next CellIndex
    If Errors <> "" Then
        MsgBox Errors, vbCritical, "Validation failed!"
    End If
End Sub

'Fill the model with triangles to show the geometry
Public Sub NeedGraphics(Model As Long, Preview As Boolean)
    Dim PartIndex As Long
    Dim CellIndex As Long
    Dim SurfaceIndex As Long
    If Preview Then
        If GeometryChanged_Preview Then
            'Delete old parts
            For PartIndex = frmMain.DGE.Model_GetNumberOfParts(Model) - 1 To 0 Step -1
                frmMain.DGE.Model_Part_Delete Model, PartIndex: RE
            Next PartIndex
            'Create new parts
            InsertStringToEngine "Geometry": PartIndex = frmMain.DGE.Model_Part_Create_InSB(Model, 512): RE
            'Grid material for preview
            InsertStringToEngine "Editor_M_Position": frmMain.DGE.Model_Part_SetShader_ByName_InSB Model, PartIndex, 0: RE
            'Insert cells
            For CellIndex = 0 To NumberOfCells - 1
                For SurfaceIndex = 0 To Cells(CellIndex).NumberOfSurfaces - 1
                    If Cells(CellIndex).Surfaces(SurfaceIndex).SurfaceType <> Geometry_SurfaceType_Infinity Then
                        Dim Selected As Single
                        If Cells(CellIndex).Settings.Selected Then
                            Selected = 1
                        Else
                            Selected = 0
                        End If
                        CreatePolygon Model, PartIndex, CellIndex, Cells(CellIndex).Surfaces(SurfaceIndex), Selected, Preview
                    End If
                Next SurfaceIndex
            Next CellIndex
            GeometryChanged_Preview = False
        End If
    Else
        If GeometryChanged_Final Then
            'Delete old parts
            For PartIndex = frmMain.DGE.Model_GetNumberOfParts(Model) - 1 To 0 Step -1
                frmMain.DGE.Model_Part_Delete Model, PartIndex: RE
            Next PartIndex
            'Create new parts
            InsertStringToEngine "Geometry": PartIndex = frmMain.DGE.Model_Part_Create_InSB(Model, 512): RE
            'Material
            InsertStringToEngine "M_Diffuse_1Tex": frmMain.DGE.Model_Part_SetShader_ByName_InSB Model, PartIndex, 0: RE
            InsertStringToEngine "M_Shadow_Solid": frmMain.DGE.Model_Part_SetShader_ByName_InSB Model, PartIndex, 1: RE
            'Insert cells
            For CellIndex = 0 To NumberOfCells - 1
                For SurfaceIndex = 0 To Cells(CellIndex).NumberOfSurfaces - 1
                    If Cells(CellIndex).Surfaces(SurfaceIndex).SurfaceType <> Geometry_SurfaceType_Infinity Then
                        CreatePolygon Model, PartIndex, CellIndex, Cells(CellIndex).Surfaces(SurfaceIndex), 0, Preview
                    End If
                Next SurfaceIndex
            Next CellIndex
            GeometryChanged_Final = False
        End If
    End If
End Sub

Private Sub CreatePolygon(Model As Long, PartIndex As Long, CellIndex As Long, S As Surface, Selected As Single, Preview As Boolean)
    Dim P As Long
    Dim Pos(0 To 2) As Vector3
    Dim Normal As Vector3
    Normal = ApproximateFractionNormal(S.SurfacePlane.Normal)
    If Preview Then
        'Generate one extra triangle per polygon to show edges smoothly
        Dim Center As Vector3
        Center = GetSurfaceCenter(Cells(CellIndex), S)
        For P = 0 To S.NumberOfIndices - 1
            Pos(0) = Cells(CellIndex).Positions(S.Indices(P))
            Pos(1) = Cells(CellIndex).Positions(S.Indices((P + 1) Mod S.NumberOfIndices))
            Pos(2) = Center
            CreateTriangle Model, PartIndex, CellIndex, Pos(0), Pos(1), Pos(2), 1, 0, 0, Selected, Normal, Preview
        Next P
    Else
        'Generate as few triangles as possible to optimize size and speed
        For P = 1 To S.NumberOfIndices - 2
            Pos(0) = Cells(CellIndex).Positions(S.Indices(P))
            Pos(1) = Cells(CellIndex).Positions(S.Indices(P + 1))
            Pos(2) = Cells(CellIndex).Positions(S.Indices(0))
            CreateTriangle Model, PartIndex, CellIndex, Pos(0), Pos(1), Pos(2), 1, ZeroOne(P = S.NumberOfIndices - 2), ZeroOne(P = 1), Selected, Normal, Preview
        Next P
    End If
End Sub

Private Sub CreateTriangle(Model As Long, Part As Long, CellIndex As Long, PosA As Vector3, PosB As Vector3, PosC As Vector3, EdgeA As Single, EdgeB As Single, EdgeC As Single, Selected As Single, Normal As Vector3, Preview As Boolean)
    Dim OtherCell As Long
    Dim Tri As Long
    Dim Vert As Long
    'いい Detect when a triangle is overlapped by multiple other cells.
    'いい Also cut triangles into multiple smaller triangles. This will cause new vertices to not be aligned with other polygons and must therefore be done earlier to subdivide neighbors.
    If Not Preview Then
        For OtherCell = 0 To NumberOfCells - 1
            If BoxesTouches(Cells(CellIndex).Bound, Cells(OtherCell).Bound) Then
                If OtherCell <> CellIndex And PointInsideCell(PosA, Cells(OtherCell)) And PointInsideCell(PosB, Cells(OtherCell)) And PointInsideCell(PosC, Cells(OtherCell)) Then
                    Exit Sub
                End If
            End If
        Next OtherCell
    End If
    
    Tri = frmMain.DGE.Model_Part_InsertTriangle(Model, Part)
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 0, PosA.X, PosA.Y, PosA.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 1, PosB.X, PosB.Y, PosB.Z: RE
    frmMain.DGE.Model_Part_Vertice_SetPos Model, Part, Tri, 2, PosC.X, PosC.Y, PosC.Z: RE
    
    'Tell the shaders where polygon edges are for preview
    If Preview Then
        frmMain.DGE.Model_Part_Vertice_SetColor Model, Part, Tri, 0, 0, 0, 0, EdgeA: RE
        frmMain.DGE.Model_Part_Vertice_SetColor Model, Part, Tri, 1, 0, 0, 0, EdgeB: RE
        frmMain.DGE.Model_Part_Vertice_SetColor Model, Part, Tri, 2, 0, 0, 5, EdgeC: RE
    Else
        'Apply a cube projection
        Dim Pos(0 To 2) As Vector3
        Pos(0) = PosA
        Pos(1) = PosB
        Pos(2) = PosC
        For Vert = 0 To 2
            Dim UV As Vector2
            If Abs(Normal.X) > Abs(Normal.Y) And Abs(Normal.X) > Abs(Normal.Z) Then
                UV = MakeVector2(Pos(Vert).Z, -Pos(Vert).Y)
            ElseIf Abs(Normal.Y) > Abs(Normal.Z) Then
                UV = MakeVector2(Pos(Vert).Z, Pos(Vert).X)
            Else
                UV = MakeVector2(Pos(Vert).X, -Pos(Vert).Y)
            End If
            UV = MulVector2(UV, 0.25)
            frmMain.DGE.Model_Part_Vertice_SetTexCoord Model, Part, Tri, Vert, UV.X, UV.Y, UV.X, UV.Y: RE
        Next Vert
    End If
    
    For Vert = 0 To 2
        frmMain.DGE.Model_Part_Vertice_SetSelected Model, Part, Tri, Vert, Selected
        frmMain.DGE.Model_Part_Vertice_SetNormal Model, Part, Tri, Vert, Normal.X, Normal.Y, Normal.Z
    Next Vert
End Sub

'Fill the model with physical shapes that can be used to generate the final physics in a game
Public Sub NeedPhysics(Model As Long)
    'Delete old shapes
    Dim Shape As Long
    For Shape = frmMain.DGE.Model_GetNumberOfShapes(Model) - 1 To 0 Step -1
        frmMain.DGE.Model_Shape_Delete Model, Shape: RE
    Next Shape
    'Create new shapes
    Dim CellIndex As Long
    Dim P As Long
    Dim P2 As Long
    For CellIndex = 0 To NumberOfCells - 1
        If IsCellBox(Cells(CellIndex), 0.01) Then
            'Create a box
            InsertStringToEngine "Box": Shape = frmMain.DGE.Model_Shape_Create_InSB(Model, ShapeType_Box): RE
            Dim Bound As Box
            Bound = GetBoundingBox(Cells(CellIndex))
            Dim Center As Vector3
            Center = GetBoxCenter(Bound)
            frmMain.DGE.Model_Shape_SetPos Model, Shape, Center.X, Center.Y, Center.Z
            frmMain.DGE.Model_Shape_SetHalfWidth Model, Shape, (Bound.Max.X - Bound.Min.X) / 2
            frmMain.DGE.Model_Shape_SetHalfHeight Model, Shape, (Bound.Max.Y - Bound.Min.Y) / 2
            frmMain.DGE.Model_Shape_SetHalfDepth Model, Shape, (Bound.Max.Z - Bound.Min.Z) / 2
        Else
            'Fill a buffer with unique indices to get rid of any unused positions
            Dim Indices(0 To Geometry_MaxIndices - 1) As Long
            Dim NumberOfIndices As Long
            'いい Generate a new shape from surface planes with an offset for convex hulls so that the convex hulls are not too large in the Bullet physics engine
            '     Levels exported to other physics engine might not want that offset so it will be stored as compensation normals for each hull to multiply with the radius inwards
            NumberOfIndices = 0
            Dim S As Long
            For S = 0 To Cells(CellIndex).NumberOfSurfaces - 1
                For P = 0 To Cells(CellIndex).Surfaces(S).NumberOfIndices - 1
                    Dim Exists As Boolean
                    Exists = False
                    For P2 = 0 To NumberOfIndices - 1
                        If Cells(CellIndex).Surfaces(S).Indices(P) = Indices(P2) Then
                            Exists = True
                            Exit For
                        End If
                    Next P2
                    If Not (Exists) Then
                        Indices(NumberOfIndices) = Cells(CellIndex).Surfaces(S).Indices(P)
                        NumberOfIndices = NumberOfIndices + 1
                    End If
                Next P
            Next S
            
            'Insert unique indices to a new convex hull
            InsertStringToEngine "Hull": Shape = frmMain.DGE.Model_Shape_Create_InSB(Model, ShapeType_ConvexHull): RE
            For P = 0 To NumberOfIndices - 1
                Dim Pos As Vector3
                Dim Dir As Vector3
                Dim PointIndex As Long
                Pos = Cells(CellIndex).Positions(Indices(P))
                PointIndex = frmMain.DGE.Model_Shape_InsertPoint(Model, Shape, Pos.X, Pos.Y, Pos.Z): RE
                Dir = GetCornerDirection(Cells(CellIndex), Indices(P))
                frmMain.DGE.Model_Shape_SetPointDir Model, Shape, PointIndex, Dir.X, Dir.Y, Dir.Z: RE
            Next P
        End If
    Next CellIndex
End Sub

'Side-effects:
'   Tries to cut Cell(CellIndex) in two pieces along CuttingPlane.
'   If the cutting plane cannot make the cut from being outside or getting rounding errors during hole filling then the action is aborted.
'Postcondition:
'   Returns 1 if the side-effect was applied.
'   Returns 0 if the plane was outside.
'   Returns -1 if generating one of the fragments failed.
Friend Function SplitCell(CellIndex As Long, CuttingPlane As FractionPlane) As Integer
    If CellIntersectsPlane(Cells(CellIndex), CuttingPlane) Then
        Dim OldCell As Cell
        Dim A As Cell
        Dim B As Cell
        OldCell = Cells(CellIndex)
        A = GetFragmentOfCell(OldCell, CuttingPlane)
        If A.Settings.IsBroken Then
            SplitCell = -1
        Else
            B = GetFragmentOfCell(OldCell, FlipFractionPlane(CuttingPlane))
            If B.Settings.IsBroken Then
                SplitCell = -1
            Else
                RemoveCell_Record CellIndex
                AddCell_Record CellIndex, A
                AddCell_Record CellIndex + 1, B
                GeometryChanged
                SplitCell = 1
            End If
        End If
    Else
        SplitCell = 0
    End If
End Function

Friend Sub AddBox(B As FractionBox, MaterialIndex As Long, Optional Selected As Boolean = False)
    If FractionIsGreater(B.Max.X, B.Min.X) And FractionIsGreater(B.Max.Y, B.Min.Y) And FractionIsGreater(B.Max.Z, B.Min.Z) Then
        Dim NewCell As Cell
        NewCell = MakeCell_Box(B, MakeCellSettings(MaterialIndex, Selected, False), False)
        AddCell NewCell
    End If
End Sub

Friend Sub SelectAll()
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        Cells(CellIndex).Settings.Selected = True
    Next CellIndex
    GeometryChanged
End Sub

Friend Sub DeselectAll()
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        Cells(CellIndex).Settings.Selected = False
    Next CellIndex
    GeometryChanged
End Sub

Friend Sub Refresh()
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        Cells(CellIndex).Settings.Selected = False
    Next CellIndex
    GeometryChanged
End Sub

Friend Sub DeleteSelected()
    Dim CellIndex As Long
    'Deleting invalidates the reference integrity of all indices after each new deleted cell so we loop backwards
    For CellIndex = NumberOfCells - 1 To 0 Step -1
        If Cells(CellIndex).Settings.Selected Then
            DeleteCell CellIndex
        End If
    Next CellIndex
End Sub

Friend Function LineIntersection(L As Line3) As CellIntersectionResult
    Dim CellIndex As Long
    Dim Hit As CellIntersectionResult
    LineIntersection.PlaneIntersection.Collided = False
    LineIntersection.CellIndex = -1
    LineIntersection.SurfaceIndex = -1
    For CellIndex = 0 To NumberOfCells - 1
        Hit = LineToCellIntersection(Cells(CellIndex), CellIndex, L)
        If Hit.CellIndex > -1 Then
            L.EndPoint = Hit.PlaneIntersection.PointOfImpact
            LineIntersection = Hit
        End If
    Next CellIndex
End Function

Friend Sub SelectCell(Beam As Beam3, MakeSelected As Boolean)
    Dim Hit As CellIntersectionResult
    Hit = LineIntersection(LineFromBeam(Beam, 10000))
    If Hit.CellIndex > -1 Then
        Cells(Hit.CellIndex).Settings.Selected = MakeSelected
        GeometryChanged
    End If
End Sub

Friend Sub SelectCellsUsingBox(SelectionBox As Box, MakeSelected As Boolean)
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        If BoxInBox(Cells(CellIndex).Bound, SelectionBox) Then
            Cells(CellIndex).Settings.Selected = MakeSelected
            GeometryChanged
        End If
    Next CellIndex
End Sub

Friend Sub RemovePlaneUsingBeam(Beam As Beam3)
    Dim Hit As CellIntersectionResult
    Hit = LineIntersection(LineFromBeam(Beam, 10000))
    If Hit.CellIndex > -1 Then
        ReplaceCell_Record Hit.CellIndex, RemovePlaneFromCell(Cells(Hit.CellIndex), Hit.SurfaceIndex)
        GeometryChanged
    End If
End Sub

Friend Sub ApplyTranslation(Translation As FractionPoint)
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        If Cells(CellIndex).Settings.Selected Then
            Dim NewCell As Cell
            NewCell = GetTranslationOfCell(Cells(CellIndex), Translation)
            If Not NewCell.Settings.IsBroken Then
                ReplaceCell_Record CellIndex, NewCell
                GeometryChanged
            End If
        End If
    Next CellIndex
End Sub

Friend Sub MirrorSelected(Dimension As Integer)
    Dim CellIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        If Cells(CellIndex).Settings.Selected Then
            Dim NewCell As Cell
            NewCell = GetReflectionOfCell(Cells(CellIndex), DrawTarget, Dimension)
            If Not NewCell.Settings.IsBroken Then
                ReplaceCell_Record CellIndex, NewCell
                GeometryChanged
            End If
        End If
    Next CellIndex
End Sub

Friend Sub Split(P As FractionPlane)
    Dim CellIndex As Long
    'Splitting adds new cells at the end that does not need to be divided again so we loop backwards
    For CellIndex = NumberOfCells - 1 To 0 Step -1
        If Cells(CellIndex).Settings.Selected Then
            SplitCell CellIndex, P
        End If
    Next CellIndex
End Sub

Friend Sub Duplicate()
    Dim CellIndex As Long
    For CellIndex = NumberOfCells - 1 To 0 Step -1
        If Cells(CellIndex).Settings.Selected Then
            Dim Clone As Cell
            Clone = Cells(CellIndex) 'Since adding cells may reallocate, the reference must be cloned by value
            AddCell Clone 'Clone the selected cell and inherit selection
            Cells(CellIndex).Settings.Selected = False 'Deselect the original to avoid affecting it
        End If
    Next CellIndex
End Sub

'Using SelectedOnly, it is possible to only serialize what is selected
Friend Function SerializeSet(Indentation As String, SelectedOnly As Boolean) As String
    Dim CellIndex As Long
    Dim SurfaceIndex As Long
    Dim MaximumMaterialIndex As Long
    For CellIndex = 0 To NumberOfCells - 1
        If (Cells(CellIndex).Settings.Selected Or Not SelectedOnly) Then
            If Cells(CellIndex).Settings.MaterialIndex > MaximumMaterialIndex Then
                MaximumMaterialIndex = Cells(CellIndex).Settings.MaterialIndex
            End If
        End If
    Next CellIndex
    Dim MaterialIndex As Long
    Dim FirstCellInMaterial As Boolean
    For MaterialIndex = 0 To MaximumMaterialIndex
        FirstCellInMaterial = True
        For CellIndex = 0 To NumberOfCells - 1
            If (Cells(CellIndex).Settings.Selected Or Not SelectedOnly) Then
                If Cells(CellIndex).Settings.MaterialIndex = MaterialIndex Then
                    If FirstCellInMaterial Then
                        SerializeSet = SerializeSet & Indentation & "<M>" & vbNewLine
                        'いい Store material name, default scale, shaders and textures
                    End If
                    SerializeSet = SerializeSet & Indentation & vbTab & "<C>" & vbNewLine
                    For SurfaceIndex = 0 To Cells(CellIndex).NumberOfSurfaces - 1
                        If Cells(CellIndex).Surfaces(SurfaceIndex).SurfaceType <> Geometry_SurfaceType_Infinity Then
                            SerializeSet = SerializeSet & Indentation & vbTab & vbTab & "<S>(P=" & FractionPlaneToString(Cells(CellIndex).Surfaces(SurfaceIndex).SurfacePlane) & ")" & vbNewLine
                        End If
                    Next SurfaceIndex
                    FirstCellInMaterial = False
                End If
            End If
        Next CellIndex
    Next MaterialIndex
End Function

Friend Sub ParseSet(ByRef Content As String, ByVal RecordHistory As Boolean, ByVal Selected As Boolean)
    Dim Location As Long
    Dim ScopeStart As Long
    Dim ScopeEnd As Long
    Dim ScopeName As String
    Dim PropertyStart As Long
    Dim PropertyEqual As Long
    Dim PropertyEnd As Long
    Dim PropertyName As String
    Dim PropertyContent As String
    Dim State As StateEnum
    Dim MaterialIndex As Long
    Dim SurfaceIndex As Long
    Dim RecordingCell As Boolean
    Dim CurrentCell As Cell
    If Not RecordHistory Then
        ClearRedoHistory
    End If
    Location = 1
    State = StateEnum.Root
    MaterialIndex = -1
    SurfaceIndex = -1
    Do
        ScopeStart = InStr(Location, Content, "<", vbTextCompare)
        PropertyStart = InStr(Location, Content, "(", vbTextCompare)
        If ScopeStart > 0 And ScopeStart < PropertyStart Then
            ScopeEnd = InStr(ScopeStart + 1, Content, ">", vbTextCompare)
            ScopeName = NoWhiteSpace(MidRange(Content, ScopeStart + 1, ScopeEnd - 1))
            Select Case ScopeName
            Case "M", "Material"
                State = StateEnum.Material
                MaterialIndex = NumberOfMaterials
                NumberOfMaterials = NumberOfMaterials + 1
                SurfaceIndex = -1
                If RecordingCell Then
                    AddCell GenerateCellFromPlanes(CurrentCell), RecordHistory
                    RecordingCell = False
                End If
            Case "C", "Cell"
                Debug.Assert MaterialIndex >= 0
                State = StateEnum.Cell
                If RecordingCell Then AddCell GenerateCellFromPlanes(CurrentCell), RecordHistory
                RecordingCell = True
                CurrentCell = MakeCell_Infinite(MakeCellSettings(MaterialIndex, Selected))
                SurfaceIndex = -1
            Case "S", "Surface"
                Debug.Assert MaterialIndex >= 0
                Debug.Assert RecordingCell
                Debug.Assert CurrentCell.NumberOfSurfaces < Geometry_MaxSufraces
                SurfaceIndex = CurrentCell.NumberOfSurfaces
                CurrentCell.NumberOfSurfaces = CurrentCell.NumberOfSurfaces + 1
                State = StateEnum.Surface
            Case Else
                MsgBox "Unexpected scope name " & ScopeName & ".", vbCritical, "Parsing error!"
                Exit Sub
            End Select
            Location = ScopeEnd + 1
        ElseIf PropertyStart > 0 Then
            PropertyEqual = InStr(PropertyStart + 1, Content, "=", vbTextCompare)
            If PropertyEqual = 0 Then
                MsgBox "Properties must be assigned values.", vbCritical, "Parsing error!"
                Exit Sub
            Else
                PropertyEnd = InStr(PropertyEqual + 1, Content, ")", vbTextCompare)
                If PropertyEnd = 0 Then
                    MsgBox "Properties must end with "")"".", vbCritical, "Parsing error!"
                    Exit Sub
                Else
                    PropertyName = NoWhiteSpace(MidRange(Content, PropertyStart + 1, PropertyEqual - 1))
                    PropertyContent = NoWhiteSpace(MidRange(Content, PropertyEqual + 1, PropertyEnd - 1))
                    Select Case PropertyName
                    Case "P", "Plane"
                        Debug.Assert MaterialIndex >= 0
                        Debug.Assert RecordingCell
                        Debug.Assert SurfaceIndex >= 0
                        CurrentCell.Surfaces(SurfaceIndex).SurfacePlane = FractionPlaneFromString(PropertyContent)
                    Case Else
                        MsgBox "Unexpected property name " & PropertyName & ".", vbCritical, "Parsing error!"
                        Exit Sub
                    End Select
                    Location = PropertyEnd + 1
                End If
            End If
        Else
            'Complete
            If RecordingCell Then AddCell GenerateCellFromPlanes(CurrentCell), RecordHistory
            GeometryChanged
            If RecordHistory Then DoneRecordingHistory
            Exit Sub
        End If
    Loop
End Sub

'Merges CellB into CellA
'Precondition: CellA <> CellB
'Returns true iff the cells at CellA and CellB are merged
Private Function MergeCells(CellA As Long, CellB As Long) As Boolean
    Debug.Assert CellA <> CellB
    If Cells(CellA).Settings.MaterialIndex <> Cells(CellB).Settings.MaterialIndex Then
        MergeCells = False 'Cells had different materials
    Else
        Dim GapIndexA As Long
        Dim Gap As FractionPlane
        GapIndexA = FindGapIndexA(Cells(CellA), Cells(CellB))
        If GapIndexA = -1 Then
            MergeCells = False 'Could not find a unique plane between the cells
        Else
            Gap = Cells(CellA).Surfaces(GapIndexA).SurfacePlane
            Dim CellC As Cell 'A + B
            CellC = CombineCells(Cells(CellA), Cells(CellB))
            If Not (CellInsideCell(Cells(CellA), CellC) And CellInsideCell(Cells(CellB), CellC)) Then
                MergeCells = False 'The merged cell does not contain the original cells
            Else
                Dim CellD As Cell 'C - B = A
                Dim CellE As Cell 'C - A = B
                If Not CellIntersectsPlane(CellC, Gap) Then
                    MergeCells = False 'The fragment might be too small for the tolerance
                Else
                    'Since merge is the inverse of split, we can perform the split on the result and check for equality
                    CellD = GetFragmentOfCell(CellC, FlipFractionPlane(Gap))
                    CellE = GetFragmentOfCell(CellC, Gap)
                    If CellInsideCell(CellD, Cells(CellA)) And CellInsideCell(CellE, Cells(CellB)) Then
                        CombineCell_Record CellA, CellB, CellC
                        GeometryChanged
                        MergeCells = True 'Apply the merge
                    Else
                        MergeCells = False 'The result of the merge does not fit inside the original cells
                    End If
                End If
            End If
        End If
    End If
End Function

'Precondition: At most two cells are selected
'いい TODO: Handle more by selecting random pairs from the selection
Friend Sub MergeSelected()
    Dim CellIndex As Long
    Dim LastCell As Long
    LastCell = -1
    For CellIndex = NumberOfCells - 1 To 0 Step -1
        If Cells(CellIndex).Settings.Selected Then
            If LastCell > -1 Then
                If MergeCells(LastCell, CellIndex) Then
                    LastCell = -1
                ElseIf MergeCells(CellIndex, LastCell) Then
                    'いいいい This still happens! Why?
                    'MsgBox "Merging is not symmetrical!", vbCritical, "Internal error!"
                    LastCell = -1
                End If
            End If
            LastCell = CellIndex
        End If
    Next CellIndex
    DoneRecordingHistory
End Sub

'Carve into a cell using another cell
'Precondition: NewCell may not point to Cells
Private Sub CarveCellUsingCell(TargetCellIndex As Long, CarveShape As Cell)
    'Reduce fragmentation by not carving into distant cells
    If BoxesOverlaps(Cells(TargetCellIndex).Bound, CarveShape.Bound) Then
        'Cut away a part of the target cell and forget it until all is inside the carver shape and can be deleted.
        'Planes without thickness will vanish and by being convex, make the whole cell vanish.
        Dim SurfaceIndex As Long
        Dim Result As Integer
        For SurfaceIndex = 0 To CarveShape.NumberOfSurfaces - 1
            Result = SplitCell(TargetCellIndex, FlipFractionPlane(CarveShape.Surfaces(SurfaceIndex).SurfacePlane))
        Next SurfaceIndex
        If CellInsideCell(Cells(TargetCellIndex), CarveShape) Then 'Check if the last cell is within the carving cell in case of only leaving one cell from the last cut
            DeleteCell TargetCellIndex
        End If
    End If
End Sub

Friend Sub CarveUsingBox(Volume As FractionBox, SelectionOnly As Boolean)
    Dim CarveShape As Cell
    Dim CellIndex As Long
    CarveShape = MakeCell_Box(Volume, MakeCellSettings(0), False)
    For CellIndex = NumberOfCells - 1 To 0 Step -1
        If Cells(CellIndex).Settings.Selected Or Not SelectionOnly Then
            CarveCellUsingCell CellIndex, CarveShape
        End If
    Next CellIndex
End Sub

'Carve into unselected cells using the selected cells
'いい TODO: Better cell to cell intersection tests
Friend Sub CarveUsingSelection()
    Dim A As Long
    Dim B As Long
    For A = 0 To NumberOfCells - 1
        If Cells(A).Settings.Selected Then
            For B = NumberOfCells - 1 To 0 Step -1
                If Not Cells(B).Settings.Selected Then
                    Dim Carver As Cell
                    Carver = Cells(A)
                    CarveCellUsingCell B, Carver
                End If
            Next B
        End If
    Next A
    DoneRecordingHistory
End Sub

Private Sub DebugUndoHistory()
    Debug.Print "History from " & UndoHistoryStart & " of length " & UndoHistorySize
    Dim I As Long
    Dim H As Long
    H = UndoHistoryStart
    For I = 0 To UndoHistorySize - 1
        Dim EventType As String
        If I >= UndoHistorySize - RedoSize Then
            EventType = "Redo"
        Else
            EventType = "Undo"
        End If
        If UndoBuffer(H).EventIndex = 0 Then Debug.Print "  --------"
        Debug.Print "   " & EventType & " @" & H & " EventIndex = " & UndoBuffer(H).EventIndex & " CellIndex = " & UndoBuffer(H).CellIndex
        H = (H + 1) Mod HistoryBufferSize
    Next I
    If EventCounter = 0 Then Debug.Print "  --------"
End Sub

Private Sub RecordChange(Change As CellChange, Optional ByVal RecordHistory As Boolean = True)
    If HistoryBufferSize = 0 Then RecordHistory = False
    If RecordHistory Then
        'Erase redo history ahead so that new things can be written
        ClearRedoHistory
        'Force a division of actions when reaching half of the total undo buffer.
        If EventCounter >= HistoryBufferSize / 2 Then
            EventCounter = 0
        End If
    End If
    
    'Apply the change
    ApplyChange Change
    
    'Record the change
    If RecordHistory Then
        Dim ApplyIndex As Long
        ApplyIndex = (UndoHistoryStart + UndoHistorySize - RedoSize) Mod HistoryBufferSize
        UndoBuffer(ApplyIndex) = Change
        UndoHistorySize = UndoHistorySize + 1
        EventCounter = EventCounter + 1
    End If
    'DebugUndoHistory
End Sub

Private Sub AddCell_Record(CellIndex As Long, NewValue As Cell, Optional ByVal RecordHistory As Boolean = True)
    Dim Change As CellChange
    Change.CellIndex = CellIndex
    Change.Content = NewValue
    Change.TypeOfChange = TypeOfChangeEnum.AddingCell
    Change.EventIndex = EventCounter
    
    RecordChange Change, RecordHistory
End Sub

Private Sub RemoveCell_Record(CellIndex As Long, Optional ByVal RecordHistory As Boolean = True)
    Dim Change As CellChange
    Change.CellIndex = CellIndex
    Change.Content = Cells(CellIndex)
    Change.TypeOfChange = TypeOfChangeEnum.RemovingCell
    Change.EventIndex = EventCounter
    
    RecordChange Change, RecordHistory
End Sub

Private Sub ReplaceCell_Record(CellIndex As Long, NewValue As Cell, Optional ByVal RecordHistory As Boolean = True)
    'Combination of two atomic undo/redo events
    RemoveCell_Record CellIndex, RecordHistory
    AddCell_Record CellIndex, NewValue, RecordHistory
End Sub

Private Sub CombineCell_Record(RemoveIndexA As Long, RemoveIndexB As Long, NewValue As Cell, Optional ByVal RecordHistory As Boolean = True)
    If RemoveIndexA < RemoveIndexB Then
        RemoveCell_Record RemoveIndexB, RecordHistory
        RemoveCell_Record RemoveIndexA, RecordHistory
        AddCell_Record RemoveIndexA, NewValue, RecordHistory
    Else
        RemoveCell_Record RemoveIndexA, RecordHistory
        RemoveCell_Record RemoveIndexB, RecordHistory
        AddCell_Record RemoveIndexB, NewValue, RecordHistory
    End If
End Sub

Friend Sub DoneRecordingHistory()
    EventCounter = 0
End Sub

Private Sub EraseOldestRecording()
    Do Until UndoBuffer(UndoHistoryStart).EventIndex = 0 Or UndoHistorySize <= 0
        UndoHistoryStart = Forward(UndoHistoryStart, HistoryBufferSize)
        UndoHistorySize = UndoHistorySize - 1
    Loop
End Sub

'Redo history is erased when making an action
Private Sub ClearRedoHistory()
    UndoHistorySize = UndoHistorySize - RedoSize
    RedoSize = 0
End Sub

'Undo history is erased when starting something new or performing an action with no turning back
Private Sub ClearUndoHistory()
    UndoHistorySize = 0
    RedoSize = 0
End Sub

Private Sub ApplyChange(Change As CellChange)
    Select Case Change.TypeOfChange
    Case TypeOfChangeEnum.AddingCell
        Action_Add Change.CellIndex, Change.Content
    Case TypeOfChangeEnum.RemovingCell
        Action_Remove Change.CellIndex
    Case Else
        MsgBox "Applying unknown type of change"
    End Select
End Sub

Private Sub ReverseChange(Change As CellChange)
    Select Case Change.TypeOfChange
    Case TypeOfChangeEnum.AddingCell
        Action_Remove Change.CellIndex
    Case TypeOfChangeEnum.RemovingCell
        Action_Add Change.CellIndex, Change.Content
    Case Else
        MsgBox "Reversing unknown type of change"
    End Select
End Sub

Private Sub Action_Add(CellIndex As Long, Content As Cell)
    If NumberOfCells > UBound(Cells) Then
        ReDim Preserve Cells(((UBound(Cells) + 1) * 2) - 1)
    End If
    NumberOfCells = NumberOfCells + 1
    Dim I As Long
    For I = NumberOfCells - 2 To CellIndex Step -1
        Cells(I + 1) = Cells(I) 'Shift right to make space
    Next I
    Cells(CellIndex) = Content
End Sub

Private Sub Action_Remove(CellIndex As Long)
    Dim I As Long
    For I = CellIndex To NumberOfCells - 2
        Cells(I) = Cells(I + 1) 'Shift left to fill the hole
    Next I
    Cells(NumberOfCells - 1) = DefaultCell 'Restore unused memory with the default cell for safety
    NumberOfCells = NumberOfCells - 1
End Sub

Friend Sub Undo()
    If EventCounter > 0 Then
        MsgBox "Cannot undo while recording changes. Automatically calling DoneRecording to recover.", vbCritical, "Recording in progress!"
        DoneRecordingHistory
    End If
    Dim UndoIndex As Long
    Do
        If UndoHistorySize - RedoSize <= 0 Then
            MsgBox "Cannot undo because there is no more history stored.", vbInformation, "Cannot undo more!"
            Exit Sub
        Else
            RedoSize = RedoSize + 1
            UndoIndex = (UndoHistoryStart + UndoHistorySize - RedoSize) Mod HistoryBufferSize
            ReverseChange UndoBuffer(UndoIndex)
        End If
    Loop Until UndoBuffer(UndoIndex).EventIndex = 0
    DeselectAll
    GeometryChanged
    'DebugUndoHistory
End Sub

Friend Sub Redo()
    If EventCounter > 0 Then
        MsgBox "Cannot redo while recording changes. Automatically calling DoneRecording to recover.", vbCritical, "Recording in progress!"
        DoneRecordingHistory
    End If
    Dim RedoIndex As Long
    Dim Started As Boolean
    Do Until RedoSize <= 0
        RedoIndex = (UndoHistoryStart + UndoHistorySize - RedoSize) Mod HistoryBufferSize
        If Started And UndoBuffer(RedoIndex).EventIndex = 0 Then Exit Do
        ApplyChange UndoBuffer(RedoIndex)
        RedoSize = RedoSize - 1
        Started = True
    Loop
    DeselectAll
    GeometryChanged
    'DebugUndoHistory
End Sub

'Precondition: NewCell may not point to Cells
Private Sub AddCell(NewCell As Cell, Optional ByVal RecordHistory As Boolean = True)
    'Reallocate if needed
    AddCell_Record NumberOfCells, NewCell, RecordHistory
    GeometryChanged
End Sub

Private Sub DeleteCell(CellIndex As Long, Optional ByVal RecordHistory As Boolean = True)
    RemoveCell_Record CellIndex, RecordHistory
    GeometryChanged
End Sub
