Nicht besonders schnell, aber relativ einfach zu bedienen.
Vielleicht findet jemand das nützlich. :3
Beizeiten werden noch 'n paar andere Funktionen dazukommen, sowie 'ne schöne Dokumentation.
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
