PureBoard

Code: Alles auswählen

;Creates an auto-cleaning end-node-value only octree.
;Pros: Enables creating a 3D grid of much higher dimensions without preallocating the whole array.
;Cons: Memory usage is much higher and grows with the amount of elements.
;Note: This implementation behaves pretty much like a 3D-array, but does not support parent node values as of now.

Structure Octree
  *Child[8]
EndStructure

Procedure.i SetOctree(*Octree.Octree, X.i, Y.i, Z.i, Depth.i, Value.i, FirstNode.i = 1)
  ;Traverses the octree, creates new memory cells, and if Value is 0, destroys everything that is empty on its way back.
  
  ;Input variables:
  ;*Octree: Pointer to the tree root.
  ;X/Y/Z: Position in the tree.
  ;Depth: The node depth in the tree. The maximum dimensions are (2^Depth)-1.
  ;Value: This is the value the tree end note is set to.
  ;FirstNode: This is a flag that prevents out-of-bounds allocation and deletion of the tree root.
  
  ;Return values:
  ;Internally, it returns 1 (data exists), or 0 (data does not exist). If 0, it deletes unused elements until a node with used data is reached.
  ;Externally, there are 3 return values: -1 (out of bounds), 0 (no data left in tree), and 1 (data left in tree).
  
  Protected TwoPowerDepth.i = 1<<(Depth-1)
  
  If FirstNode ;Prevent out-of-bounds allocation. Only check on first node.
    If Depth = 0 Or X > TwoPowerDepth*2-1 Or Y > TwoPowerDepth*2-1 Or Z > TwoPowerDepth*2-1 Or X < 0 Or Y < 0 Or Z < 0
      ProcedureReturn -1
    EndIf
  EndIf
  
  ;Chunks indicate the cell that will be worked with.
  Protected ChunkX.i = Bool(X>=TwoPowerDepth)
  Protected ChunkY.i = Bool(Y>=TwoPowerDepth)
  Protected ChunkZ.i = Bool(Z>=TwoPowerDepth)
  Protected ChunkIndex.i = (ChunkX)+(ChunkY<<1)+(ChunkZ<<2)
  
  ;To prune the tree correctly, we need an always-empty memory location to compare an tree cell to.
  Protected *Null = AllocateMemory(SizeOf(Octree))
  
  Select Depth
    Case 1 ;End node
      Select Value
        Case 0
          ;Last node has only values, and does not point to other nodes.
          ;If the user assigns a pointer as a value, he has to keep track of it, lest it will cause memory leaks.
          *Octree\Child[ChunkIndex] = 0
          ;If the node is empty, flag for deletion.
          If CompareMemory(*Octree, *Null, SizeOf(Octree))
            FreeMemory(*Null)
            ProcedureReturn 0
          EndIf
          FreeMemory(*Null) ;Else, do not.
          ProcedureReturn 1
        Default
          ;Any other value will just be assigned.
          *Octree\Child[ChunkIndex] = Value
          FreeMemory(*Null)
          ProcedureReturn 1
      EndSelect
      
    Default ;Normal node
      ;If a child node does not exist, create it. Could optimize with (Value = 0) check.
      If *Octree\Child[ChunkIndex] = 0 
        *Octree\Child[ChunkIndex] = AllocateMemory(SizeOf(Octree))
      EndIf
      Select SetOctree(*Octree\Child[ChunkIndex], X-TwoPowerDepth*ChunkX, Y-TwoPowerDepth*ChunkY, Z-TwoPowerDepth*ChunkZ, Depth-1, Value, 0) ;Recursively call
        Case 0 ;Flag for deletion.
          FreeMemory(*Octree\Child[ChunkIndex]) ;Free unused memory.
          *Octree\Child[ChunkIndex] = 0
          If CompareMemory(*Octree, *Null, SizeOf(Octree)) ;If the node is empty, flag for deletion.
            FreeMemory(*Null)
            ProcedureReturn 0
          EndIf
          FreeMemory(*Null)
          ProcedureReturn 1 ;Else, stop deletion check of parent nodes.
        Case 1 ;Do not delete.
          FreeMemory(*Null)
          ProcedureReturn 1
      EndSelect
      
      
  EndSelect
EndProcedure



Procedure.i GetOctree(*Octree.Octree, X.i, Y.i, Z.i, Depth.i, Value.i = 0, FirstNode.i = 1)
  ;Gets a value from a point in an octree.
  
  ;Input variables:
  ;*Octree: Pointer to the tree root.
  ;X/Y/Z: Position in the tree.
  ;Depth: The node depth in the quadtree. The maximum dimensions are (2^Depth)-1.
  ;Value: The starting value. If the node does not exist, this value will be returned.
  ;FirstNode: This is a flag that prevents out-of-bounds queries.
  
  ;Return values:
  ;Value: Well, uh, the value that is stored in the tree, or the value that you put in if the node doesn't exist.
  
  Protected TwoPowerDepth.i = 1<<(Depth-1)
  
  If FirstNode ;Out of bounds check on first node.
    If Depth = 0 Or X > TwoPowerDepth*2-1 Or Y > TwoPowerDepth*2-1 Or Z > TwoPowerDepth*2-1 Or X < 0 Or Y < 0 Or Z < 0
      ProcedureReturn Value
    EndIf
  EndIf
  
  Protected ChunkX.i = Bool(X>=TwoPowerDepth)
  Protected ChunkY.i = Bool(Y>=TwoPowerDepth)
  Protected ChunkZ.i = Bool(Z>=TwoPowerDepth)
  Protected ChunkIndex.i = (ChunkX)+(ChunkY<<1)+(ChunkZ<<2)
  
  Select Depth
    Case 1 ;End node.
      Value = *Octree\Child[ChunkIndex]
    Default ;Normal node.
      If *Octree\Child[ChunkIndex]
        Value = GetOctree(*Octree\Child[ChunkIndex], X-TwoPowerDepth*ChunkX, Y-TwoPowerDepth*ChunkY, Z-TwoPowerDepth*ChunkZ, Depth-1, Value, 0)
      EndIf
  EndSelect
  
  ProcedureReturn Value
  
EndProcedure

Procedure.i PurgeOctree(*Octree.Octree, Depth.i, FirstNode.i = 1)
  ;Frees all elements in an octree.
  
  ;Input variables:
  ;*Octree: Pointer to the tree root.
  ;Depth: The node depth in the octree.
  ;Value: This is the value the octree end note is set to.
  ;FirstNode: This is a flag that prevents out-of-bounds allocation and deletion of the tree root.
  
  ;Return values: Always 0.
  Protected a.i
  If Depth > 1
    For a = 0 To 7
      If *Octree\Child[a] <> 0
        PurgeOctree(*Octree\Child[a], Depth-1, 0)
      EndIf
    Next
  EndIf
  
  If Not FirstNode
    FreeMemory(*Octree)
  Else
    For a = 0 To 7
      *Octree\Child[a] = 0
    Next
  EndIf
  ProcedureReturn 0
  
EndProcedure

CompilerIf #PB_Compiler_IsMainFile
  Octree.Octree
  F.f = 0.3
  O.l = 0
  X.i = 13
  Y.i = 12
  Z.i = 0
  D.i = 8
  
  ;Can you assign floating point values? Kinda.
  ;Be careful with 32/64bit differences.
  SetOctree(@Octree, X, Y, Z, D, PeekI(@F))
  O = GetOctree(@Octree, X, Y, Z, D)
  Debug "___"
  Debug F
  Debug O
  Debug PeekF(@O)
  CallDebugger
  ;Integers are always the same size as pointers.
  ;These pointers are handled as values, and are NOT freed when set to 0 or purged.
  
  ;Basic test.
  SetOctree(@Octree, X, Y, Z, D, 15)
  SetOctree(@Octree, X-1, Y, Z, D, 13)
  Debug "___"
  ;Should read 15 and 13, respectively.
  Debug GetOctree(@Octree, X, Y, Z, D)
  Debug GetOctree(@Octree, X-1, Y, Z, D)
  CallDebugger
  
  ;Stress test time!
  For c = 0 To (1<<D)-1
    For b = 0 To (1<<D)-1
      For a = 0 To (1<<D)-1
        SetOctree(@Octree, a, b, c, D, 32)
      Next
    Next
  Next
  CallDebugger
  ;Now free the whole tree!
  PurgeOctree(@Octree, D)
  CallDebugger
  
  ;If the purge didn't mess up, this should not bring up an error.
  SetOctree(@Octree, X, Y, Z, D, 30)
  SetOctree(@Octree, X-1, Y, Z, D, 35)
  Debug "___"
  Debug GetOctree(@Octree, X, Y, Z, D)
  Debug GetOctree(@Octree, X-1, Y, Z, D)
  
  
  
  CallDebugger
  End
  
CompilerEndIf