GLS.SpacePartition.pas 65 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027
  1. //
  2. // The graphics engine GLScene https://github.com/glscene
  3. //
  4. unit GLS.SpacePartition;
  5. (*
  6. Space Partition speeds up geometrical queries, like what objects does an overlap.
  7. Note that the class TGLOctreeSpacePartition is optimized for dynamic scenes with
  8. objects that are small in relation to the size of the Octree space.
  9. The non-duplicating octree shouldn't really be used if you have big objects,
  10. and this especially if you have lots of big objects (the more objects you have
  11. the less efficient the partitionning, due to the "magnifying glass" effect of
  12. the non-discriminating volume).
  13. Theory on COctFlagMin and COctFlagMax:
  14. When a node is subdivided, each of the 8 children assumes 1/8th ownership of its
  15. parent's bounding box (defined by parent extents). Calculating a child's min/max
  16. extent only requires 3 values: the parent's min extent, the parent's max extent
  17. and the midpoint of the parent's extents (since the cube is divided in half twice).
  18. The following arrays assume that the children are numbered from 0 to 7, named Upper
  19. and Lower (Upper = top 4 cubes on Y axis, Bottom = lower 4 cubes), Left and Right, and
  20. Fore and Back (Fore facing furthest away from you the viewer).
  21. Each node can use its corresponding element in the array to flag the operation needed
  22. to find its new min/max extent. Note that min, mid and max refer to an array of
  23. 3 coordinates (x,y,z); each of which are flagged separately. Also note that these
  24. flags are based on the Y vector being the up vector.
  25. *)
  26. interface
  27. {$I GLScene.Defines.inc}
  28. uses
  29. Winapi.OpenGL,
  30. System.Classes,
  31. System.SysUtils,
  32. System.Math,
  33. GLScene.OpenGLTokens,
  34. GLS.Scene,
  35. GLS.Coordinates,
  36. GLScene.VectorTypes,
  37. GLScene.VectorGeometry,
  38. GLS.GeometryBB,
  39. GLS.Context,
  40. GLS.RenderContextInfo,
  41. GLS.SceneViewer,
  42. GLS.PersistentClasses,
  43. GLS.State;
  44. const
  45. COctree_LEAF_TRHESHOLD = 30;
  46. COctree_MAX_TREE_DEPTH = 8;
  47. COctree_GROW_GRAVY = 0.1;
  48. type
  49. TGLBaseSpacePartition = class;
  50. // Describes a cone, and is used for cone collision
  51. TGLConeSP = record
  52. // The base of the cone
  53. Base: TAffineVector;
  54. // The axis of the cone
  55. Axis: TAffineVector;
  56. // Angle of the cone
  57. Angle: Single;
  58. // Length of the cone
  59. Length: Single;
  60. end;
  61. // Extended frustum, used for fast intersection testing
  62. TGLExtendedFrustum = record
  63. Frustum: TFrustum;
  64. BSphere: TBSphere;
  65. // SPCone : TSPCone;
  66. end;
  67. // Used to store the actual objects in the SpacePartition
  68. TGLSpacePartitionLeaf = class(TGLPersistentObject)
  69. private
  70. FSpacePartition: TGLBaseSpacePartition;
  71. procedure SetSpacePartition(const Value: TGLBaseSpacePartition);
  72. public
  73. // This can be used by the space partitioner as it sees fit
  74. FPartitionTag: Pointer;
  75. (* Leaves cache their AABBs so they can be accessed when needed by
  76. the space partitioner *)
  77. FCachedAABB: TAABB;
  78. (* Leaves cache their BoundingSpheres so they can easily be accessed when
  79. needed by the space partitioner *)
  80. FCachedBSphere: TBSphere;
  81. (* Whenever the size or location of the leaf changes, the space partitioner
  82. should be notified through a call to Changed. In the basic version, all it
  83. does is update the cached AABB and BSphere. You do not need to override this
  84. method *)
  85. procedure Changed; virtual;
  86. // *** Override this!
  87. (* AABBs and BSpheres are cached for leafs, and this function should be
  88. overriden to update the cache from the structure that the leaf stores. This
  89. is the only function you MUST override to use space partitions. *)
  90. procedure UpdateCachedAABBAndBSphere; virtual;
  91. // The TGLBaseSpacePartition that owns this leaf
  92. property SpacePartition: TGLBaseSpacePartition read FSpacePartition write SetSpacePartition;
  93. // This tag can be used by the space partition to store vital information in the leaf
  94. property PartitionTag: Pointer read FPartitionTag;
  95. constructor CreateOwned(SpacePartition: TGLBaseSpacePartition);
  96. destructor Destroy; override;
  97. published
  98. end;
  99. // List for storing space partition leaves
  100. TGLSpacePartitionLeafList = class(TGLPersistentObjectList)
  101. private
  102. function GetItems(I: Integer): TGLSpacePartitionLeaf;
  103. procedure SetItems(I: Integer; const Value: TGLSpacePartitionLeaf);
  104. public
  105. property Items[I: Integer]: TGLSpacePartitionLeaf read GetItems write SetItems; default;
  106. constructor Create; override;
  107. end;
  108. // The Space Partition updating for a bounding sphere
  109. TGLSpacePartitionLeafS = class(TGLSpacePartitionLeaf)
  110. public
  111. GLBaseSceneObject: TGLBaseSceneObject;
  112. Direction: TAffineVector;
  113. procedure UpdateCachedAABBAndBSphere; override;
  114. constructor CreateGLOwned(SpacePartition: TGLBaseSpacePartition;
  115. aGLBaseSceneObject: TGLBaseSceneObject);
  116. end;
  117. TGLCullingMode = (CmFineCulling, CmGrossCulling);
  118. // Basic space partition, does not implement any actual space partitioning
  119. TGLBaseSpacePartition = class(TGLPersistentObject)
  120. private
  121. FCullingMode: TGLCullingMode;
  122. // Query space for Leaves that intersect a cone, result is returned through QueryResult
  123. function QueryCone(const ACone: TGLConeSP): Integer; virtual;
  124. protected
  125. FQueryResult: TGLSpacePartitionLeafList;
  126. FQueryInterObjectTests: Integer;
  127. // Empties the search result and resetting all search statistics
  128. procedure FlushQueryResult; virtual;
  129. public
  130. // The results from the last query
  131. property QueryResult: TGLSpacePartitionLeafList read FQueryResult;
  132. // Clear all internal storage Leaves
  133. procedure Clear; virtual;
  134. // ** Update space partition
  135. // Add a leaf
  136. procedure AddLeaf(ALeaf: TGLSpacePartitionLeaf); virtual;
  137. // Remove a leaf
  138. procedure RemoveLeaf(ALeaf: TGLSpacePartitionLeaf); virtual;
  139. // Called by leaf when it has changed
  140. procedure LeafChanged(ALeaf: TGLSpacePartitionLeaf); virtual;
  141. // ** Query space partition
  142. (* Query space for Leaves that intersect the axis aligned bounding box,
  143. result is returned through QueryResult *)
  144. function QueryAABB(const AAABB: TAABB): Integer; virtual;
  145. (* Query space for Leaves that intersect the bounding sphere, result is
  146. returned through QueryResult *)
  147. function QueryBSphere(const ABSphere: TBSphere): Integer; virtual;
  148. (* Query space for Leaves that intersect the bounding sphere or box
  149. of a leaf. Result is returned through QueryResult *)
  150. function QueryLeaf(const ALeaf: TGLSpacePartitionLeaf): Integer; virtual;
  151. (* Query space for Leaves that intersect a plane. Result is returned through
  152. QueryResult *)
  153. function QueryPlane(const Location, Normal: TAffineVector): Integer; virtual;
  154. (* Query space for Leaves that intersect a Frustum. Result is returned through
  155. QueryResult *)
  156. function QueryFrustum(const Frustum: TFrustum): Integer; virtual;
  157. (* Query space for Leaves that intersect an extended frustum. Result is
  158. returned through QueryResult. Extended frustum is slightly faster than the
  159. regular frustum because it uses a bounding sphere for the frustum *)
  160. function QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum): Integer; virtual;
  161. (* Once a query has been run, this number tells of how many inter object
  162. tests that were run. This value must be set by all that override the queries *)
  163. property QueryInterObjectTests: Integer read FQueryInterObjectTests;
  164. (* Some space partitioners delay processing changes until all changes have
  165. been made. ProcessUpdated should be called when all changes have been performed *)
  166. procedure ProcessUpdated; virtual;
  167. (* Determines if the spatial structure should do very simple preliminary
  168. culling (gross culling) or a more detailed form of culling (fine culling) *)
  169. property CullingMode: TGLCullingMode read FCullingMode write FCullingMode;
  170. constructor Create; override;
  171. destructor Destroy; override;
  172. end;
  173. (* Implements a list of all leaves added to the space partition, _not_ a
  174. good solution, but it can be used as a benchmark against more complex methods *)
  175. TGLLeavedSpacePartition = class(TGLBaseSpacePartition)
  176. private
  177. FLeaves: TGLSpacePartitionLeafList;
  178. // Query space for Leaves that intersect a cone, result is returned through QueryResult
  179. function QueryCone(const ACone: TGLConeSP): Integer; override;
  180. public
  181. // Clear all internal storage Leaves
  182. procedure Clear; override;
  183. // ** Update space partition
  184. // Add a leaf
  185. procedure AddLeaf(ALeaf: TGLSpacePartitionLeaf); override;
  186. // Remove a leaf
  187. procedure RemoveLeaf(ALeaf: TGLSpacePartitionLeaf); override;
  188. // ** Query space partition
  189. (* Query space for Leaves that intersect the axis aligned bounding box,
  190. result is returned through QueryResult. This override scans _all_ leaves
  191. in the list, so it's far from optimal *)
  192. function QueryAABB(const AAABB: TAABB): Integer; override;
  193. (* Query space for Leaves that intersect the bounding sphere, result is
  194. returned through QueryResult. This override scans _all_ leaves
  195. in the list, so it's far from optimal *)
  196. function QueryBSphere(const ABSphere: TBSphere): Integer; override;
  197. // Query space for Leaves that intersect a plane. Result is returned through QueryResult
  198. function QueryPlane(const FLocation, FNormal: TAffineVector): Integer; override;
  199. constructor Create; override;
  200. destructor Destroy; override;
  201. published
  202. property Leaves: TGLSpacePartitionLeafList read FLeaves;
  203. end;
  204. TGLSectoredSpacePartition = class;
  205. TGLSectorNode = class;
  206. TGLSectorNodeArray = array [0 .. 7] of TGLSectorNode;
  207. (* Implements a SectorNode node. Each node can have 0 or 8 children, each child
  208. being a portion of the size of the parent. For quadtrees, that's 1/4, for
  209. octrees, it's 1/8 *)
  210. TGLSectorNode = class
  211. private
  212. FLeaves: TGLSpacePartitionLeafList;
  213. FAABB: TAABB;
  214. FSectoredSpacePartition: TGLSectoredSpacePartition;
  215. FRecursiveLeafCount: Integer;
  216. FParent: TGLSectorNode;
  217. FNodeDepth: Integer;
  218. FChildCount: Integer;
  219. FChildren: TGLSectorNodeArray;
  220. FBSphere: TBSphere;
  221. function GetNoChildren: Boolean;
  222. procedure SetAABB(const Value: TAABB);
  223. function GetCenter: TAffineVector;
  224. protected
  225. (* Recursively counts the RecursiveLeafCount, this should only be used in
  226. debugging purposes, because the proprtyu RecursiveLeafCount is always up to
  227. date *)
  228. function CalcRecursiveLeafCount: Integer;
  229. (* Places a leaf in one of the children of this node, or in the node itself
  230. if it doesn't fit in any of the children *)
  231. function PlaceLeafInChild(ALeaf: TGLSpacePartitionLeaf): TGLSectorNode;
  232. (* Debug method that checks that FRecursiveLeafCount and
  233. CalcRecursiveLeafCount actually agree *)
  234. function VerifyRecursiveLeafCount: string;
  235. // Executed whenever the children of the node has changed
  236. procedure ChildrenChanged; virtual;
  237. public
  238. (* Clear deletes all children and empties the leaves. It doesn't destroy
  239. the leaves, as they belong to the SpacePartition *)
  240. procedure Clear;
  241. // The Axis Aligned Bounding Box for this node. All leaves MUST fit inside this box
  242. property AABB: TAABB read FAABB write SetAABB;
  243. // BSphere for this node
  244. property BSphere: TBSphere read FBSphere;
  245. // Center of the AABB for this node
  246. property Center: TAffineVector read GetCenter;
  247. // NoChildren is true if the node has no children
  248. property NoChildren: Boolean read GetNoChildren;
  249. // A list of the children for this node, only ChildCount children are none nil
  250. property Children: TGLSectorNodeArray read FChildren;
  251. // The number of child sectors that have been created
  252. property ChildCount: Integer read FChildCount;
  253. // Computes which child the AABB should go in. Returns nil if no such child exists
  254. function GetChildForAABB(const AABB: TAABB): TGLSectorNode; virtual;
  255. // The leaves that are stored in this node
  256. property Leaves: TGLSpacePartitionLeafList read FLeaves;
  257. // The Structure that owns this node
  258. property SectoredSpacePartition: TGLSectoredSpacePartition read FSectoredSpacePartition;
  259. // The parent node of this node. If parent is nil, that means that this node is the root node
  260. property Parent: TGLSectorNode read FParent;
  261. // The number of leaves stored in this node and all it's children
  262. property RecursiveLeafCount: Integer read FRecursiveLeafCount;
  263. (* The tree depth at which this node is located. For the root, this value
  264. is 0, for the roots children, it is 1 and so on *)
  265. property NodeDepth: Integer read FNodeDepth;
  266. // Checks if an AABB fits completely inside this node
  267. function AABBFitsInNode(const AAABB: TAABB): Boolean; virtual;
  268. // Checks if an AABB intersects this node
  269. function AABBIntersectsNode(const AAABB: TAABB): Boolean; virtual;
  270. // Checks if a BSphere fits completely inside this node
  271. function BSphereFitsInNode(const BSphere: TBSphere): Boolean; virtual;
  272. // Checks if a BSphere intersects this node
  273. function BSphereIntersectsNode(const BSphere: TBSphere): Boolean; virtual;
  274. // Checks if a AABB partially or completely contains this sector
  275. function AABBContainsSector(const AABB: TAABB): TSpaceContains; virtual;
  276. // Checks if a BSphere partially or completely contains this sector
  277. function BSphereContainsSector(const BSphere: TBSphere): TSpaceContains; virtual;
  278. // Checks if this node partially or completely contains a BSphere
  279. function ContainsBSphere(const ABSphere: TBSphere): TSpaceContains; virtual;
  280. // Checks if this node partially or completely contains an AABB
  281. function ContainsAABB(const AAABB: TAABB): TSpaceContains; virtual;
  282. (* Adds leaf to this node - or one of it's children. If the node has enough
  283. leaves and has no children, children will be created and all leaves will be
  284. spread among the children *)
  285. function AddLeaf(ALeaf: TGLSpacePartitionLeaf): TGLSectorNode;
  286. (* Remove leaf will remove a leaf from this node. If it is determined that
  287. this node has too few leaves after the delete, it may be collapsed. Returns
  288. true if the node was actually collapsed *)
  289. function RemoveLeaf(ALeaf: TGLSpacePartitionLeaf; OwnerByThis: Boolean): Boolean;
  290. // Query the node and its children for leaves that match the AABB
  291. procedure QueryAABB(const AAABB: TAABB; const QueryResult: TGLSpacePartitionLeafList);
  292. // Query the node and its children for leaves that match the BSphere
  293. procedure QueryBSphere(const ABSphere: TBSphere; const QueryResult: TGLSpacePartitionLeafList);
  294. // Query the node and its children for leaves that match the plane
  295. procedure QueryPlane(const Location, Normal: TAffineVector; const QueryResult: TGLSpacePartitionLeafList);
  296. // Query the node and its children for leaves that match the Frustum
  297. procedure QueryFrustum(const Frustum: TFrustum; const QueryResult: TGLSpacePartitionLeafList);
  298. // Query the node and its children for leaves that match the extended frustum
  299. procedure QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum; const QueryResult: TGLSpacePartitionLeafList);
  300. (* Adds all leaves to query result without testing if they intersect, and
  301. then do the same for all children. This is used when QueryAABB or
  302. QueryBSphere determines that a node fits completely in the searched space *)
  303. procedure AddAllLeavesRecursive(const QueryResult: TGLSpacePartitionLeafList);
  304. // Add children to this node and spread the leaves among it's children
  305. procedure ExpandNode;
  306. // Create the number of children this node type needs
  307. procedure CreateChildren; virtual;
  308. // Delete all children for this node, adding their leaves to this node
  309. procedure CollapseNode;
  310. // Returns the number of nodes in the Octree
  311. function GetNodeCount: Integer;
  312. constructor Create(ASectoredSpacePartition: TGLSectoredSpacePartition; AParent: TGLSectorNode);
  313. destructor Destroy; override;
  314. end;
  315. TGLGrowMethod = (gmNever, gmBestFit, gmIncreaseToFitAll);
  316. (* Implements sectored space partitioning, sectored space partitions include
  317. Octrees, Quadtrees and BSP-trees *)
  318. TGLSectoredSpacePartition = class(TGLLeavedSpacePartition)
  319. private
  320. FRootNode: TGLSectorNode;
  321. FLeafThreshold: Integer;
  322. FMaxTreeDepth: Integer;
  323. FGrowGravy: Single;
  324. FGrowMethod: TGLGrowMethod;
  325. procedure SetLeafThreshold(const Value: Integer);
  326. procedure SetMaxTreeDepth(const Value: Integer);
  327. protected
  328. FQueryNodeTests: Integer;
  329. // Empties the search result and resetting all search statistics
  330. procedure FlushQueryResult; override;
  331. public
  332. // ** Update space partition
  333. (* Add a leaf to the structure. If the leaf doesn't fit in the structure, the
  334. structure is either grown or an exception is raised. If GrowMethod is set to
  335. gmBestFit or gmIncreaseToFitAll, the octree will be grown *)
  336. procedure AddLeaf(ALeaf: TGLSpacePartitionLeaf); override;
  337. // Remove a leaf from the structure
  338. procedure RemoveLeaf(ALeaf: TGLSpacePartitionLeaf); override;
  339. // Called by leaf when it has changed, the leaf will be moved to an apropriate node
  340. procedure LeafChanged(ALeaf: TGLSpacePartitionLeaf); override;
  341. // ** Query space partition
  342. (* Query space for Leaves that intersect the axis aligned bounding box,
  343. result is returned through QueryResult. This method simply defers to the
  344. QueryAABB method of the root node *)
  345. function QueryAABB(const AAABB: TAABB): Integer; override;
  346. (* Query space for Leaves that intersect the bounding sphere, result is
  347. returned through QueryResult. This method simply defers to the
  348. QueryBSphere method of the root node *)
  349. function QueryBSphere(const ABSphere: TBSphere): Integer; override;
  350. (* Query space for Leaves that intersect the bounding sphere or box
  351. of a leaf. Result is returned through QueryResult *)
  352. function QueryLeaf(const ALeaf: TGLSpacePartitionLeaf): Integer; override;
  353. // Query space for Leaves that intersect a plane. Result is returned through QueryResult
  354. function QueryPlane(const Location, Normal: TAffineVector): Integer; override;
  355. // Query space for Leaves that intersect a Frustum. Result is returned through QueryResult
  356. function QueryFrustum(const Frustum: TFrustum): Integer; override;
  357. (* Query space for Leaves that intersect an extended frustum. Result is
  358. returned through QueryResult *)
  359. function QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum): Integer; override;
  360. (* After a query has been run, this value will contain the number of nodes
  361. that were checked during the query *)
  362. property QueryNodeTests: Integer read FQueryNodeTests;
  363. // Returns the number of nodes in the structure
  364. function GetNodeCount: Integer;
  365. // UpdateOctreeSize will grow and / or shrink the structure to fit the current leaves +-gravy
  366. procedure UpdateStructureSize(Gravy: Single);
  367. // Rebuild tree will change the tree to the newAABB size, and completely rebuild it
  368. procedure RebuildTree(const NewAABB: TAABB);
  369. // Returns the _total_ AABB in structure
  370. function GetAABB: TAABB;
  371. // CreateNewNode creates a new node of the TGLSectorNode subclass that this structure requires
  372. function CreateNewNode(AParent: TGLSectorNode): TGLSectorNode; virtual;
  373. procedure Clear; override;
  374. constructor Create; override;
  375. destructor Destroy; override;
  376. published
  377. // Root TGLSectorNode that all others stem from
  378. property RootNode: TGLSectorNode read FRootNode;
  379. // Determines how deep a tree should be allowed to grow
  380. property MaxTreeDepth: Integer read FMaxTreeDepth write SetMaxTreeDepth;
  381. // Determines when a node should be split up to form children
  382. property LeafThreshold: Integer read FLeafThreshold write SetLeafThreshold;
  383. (* Determines if the structure should grow with new leaves, or if an exception
  384. should be raised *)
  385. property GrowMethod: TGLGrowMethod read FGrowMethod write FGrowMethod;
  386. (* When the structure is recreated because it's no longer large enough to fit
  387. all leafs, it will become large enough to safely fit all leafs, plus
  388. GrowGravy. This is to prevent too many grows *)
  389. property GrowGravy: Single read FGrowGravy write FGrowGravy;
  390. end;
  391. // ** OCTTREE
  392. // Implements sector node that handles octrees
  393. TSPOctreeNode = class(TGLSectorNode)
  394. public
  395. // Create 8 TSPOctreeNode children
  396. procedure CreateChildren; override;
  397. // Checks if an AABB fits completely inside this node
  398. function AABBFitsInNode(const AAABB: TAABB): Boolean; override;
  399. // Checks if an AABB intersects this node
  400. function AABBIntersectsNode(const AAABB: TAABB): Boolean; override;
  401. // Checks if a BSphere fits completely inside this node
  402. function BSphereFitsInNode(const BSphere: TBSphere): Boolean; override;
  403. // Checks if a BSphere intersects this node
  404. function BSphereIntersectsNode(const BSphere: TBSphere): Boolean; override;
  405. end;
  406. // Implements octrees
  407. TGLOctreeSpacePartition = class(TGLSectoredSpacePartition)
  408. public
  409. // Set size updates the size of the Octree
  410. procedure SetSize(const Min, Max: TAffineVector);
  411. { CreateNewNode creates a new TSPOctreeNode }
  412. function CreateNewNode(AParent: TGLSectorNode): TGLSectorNode; override;
  413. end;
  414. // ** QUADTREE
  415. // Implements sector node that handles quadtrees
  416. TSPQuadtreeNode = class(TSPOctreeNode)
  417. protected
  418. (* Executed whenever the children of the node has changed. In the quadtree,
  419. we want to make sure the Y value of the AABB is correct up and down and that
  420. the bounding sphere is correct *)
  421. procedure ChildrenChanged; override;
  422. public
  423. // Create 4 TSPQuadtreeNode children
  424. procedure CreateChildren; override;
  425. // Checks if an AABB fits completely inside this node
  426. function AABBFitsInNode(const AAABB: TAABB): Boolean; override;
  427. // Checks if an AABB intersects this node
  428. function AABBIntersectsNode(const AAABB: TAABB): Boolean; override;
  429. // Checks if a BSphere fits completely inside this node
  430. function BSphereFitsInNode(const BSphere: TBSphere): Boolean; override;
  431. // Checks if a BSphere intersects this node
  432. function BSphereIntersectsNode(const BSphere: TBSphere): Boolean; override;
  433. // Computes which child the AABB should go in. Returns nil if no such child exists
  434. function GetChildForAABB(const AABB: TAABB): TGLSectorNode; override;
  435. end;
  436. (* Implements quadtrees.
  437. Quadtrees are hardcoded to completely ignore the Y axis, only using X and Z
  438. to determine positioning.
  439. This means that they're well suited for 2d-ish situations (landscapes with
  440. trees for instance) but not for fully 3d situations (space fighting) *)
  441. TGLQuadtreeSpacePartition = class(TGLSectoredSpacePartition)
  442. public
  443. // Set size updates the size of the Octree
  444. procedure SetSize(const Min, Max: TAffineVector);
  445. // CreateNewNode creates a new TSPOctreeNode
  446. function CreateNewNode(AParent: TGLSectorNode): TGLSectorNode; override;
  447. end;
  448. // Object for holding glscene objects in a spatial partitioning
  449. TGLSceneObj = class(TGLSpacePartitionLeaf)
  450. public
  451. Obj: TGLBaseSceneObject;
  452. procedure UpdateCachedAABBAndBSphere; override;
  453. constructor CreateObj(Owner: TGLSectoredSpacePartition; aObj: TGLBaseSceneObject);
  454. destructor Destroy; override;
  455. end;
  456. (*Render a spacial partitioning descending from TGLSectoredSpacePartition
  457. (octree and quadtree) as a grid - great for debugging and visualisation *)
  458. procedure RenderSpatialPartitioning(var rci: TGLRenderContextInfo;
  459. const Space: TGLSectoredSpacePartition);
  460. (*Create an extended frustum from a GLSceneViewer - this makes the unit
  461. specific to the windows platform!*)
  462. function ExtendedFrustumMakeFromSceneViewer(const AFrustum: TFrustum;
  463. const vWidth, vHeight: integer; AGLCamera: TGLCamera): TGLExtendedFrustum; overload;
  464. function ExtendedFrustumMakeFromSceneViewer(const AFrustum: TFrustum;
  465. const AGLSceneViewer: TGLSceneViewer): TGLExtendedFrustum; overload;
  466. // Renders an AABB as a line
  467. procedure RenderAABB(var rci: TGLRenderContextInfo; const AABB: TAABB; w, r, g, b: single); overload;
  468. procedure RenderAABB(var rci: TGLRenderContextInfo; const AABB: TAABB); overload;
  469. // Determines to which extent one Cone contains an BSphere
  470. function ConeContainsBSphere(const Cone: TGLConeSP; const BSphere: TBSphere): TSpaceContains;
  471. // Determines if a extended frustum intersects an BSphere
  472. function ExtendedFrustumIntersectsBSphere(const AExtendedFrustum: TGLExtendedFrustum; const ABSphere: TBSphere): Boolean;
  473. // Create an extended frustum from a number of values
  474. function ExtendedFrustumMake(const AFrustum: TFrustum; const ANearDist, AFarDist, AFieldOfViewRadians: Single;
  475. const ACameraPosition, ALookVector: TAffineVector { ;
  476. const AScreenWidth, AScreenHeight : integer { } ): TGLExtendedFrustum;
  477. //---------------------------------------------------
  478. implementation
  479. //---------------------------------------------------
  480. const
  481. CMIN = 0;
  482. CMID = 1;
  483. CMAX = 2;
  484. COctFlagMIN: array [0 .. 7] of array [0 .. 2] of Byte = ((CMIN, CMID, CMID),
  485. // Upper Fore Left
  486. (CMID, CMID, CMID), // Upper Fore Right
  487. (CMIN, CMID, CMIN), // Upper Back Left
  488. (CMID, CMID, CMIN), // Upper Back Right
  489. (CMIN, CMIN, CMID), // Lower Fore Left (similar to above except height/2)
  490. (CMID, CMIN, CMID), // Lower Fore Right
  491. (CMIN, CMIN, CMIN), // Lower Back Left
  492. (CMID, CMIN, CMIN) // Lower Back Right
  493. );
  494. COctFlagMax: array [0 .. 7] of array [0 .. 2] of Byte = ((CMID, CMAX, CMAX),
  495. // Upper Fore Left
  496. (CMAX, CMAX, CMAX), // Upper Fore Right
  497. (CMID, CMAX, CMID), // Upper Back Left
  498. (CMAX, CMAX, CMID), // Upper Back Right
  499. (CMID, CMID, CMAX), // Lower Fore Left (similar to above except height/2)
  500. (CMAX, CMID, CMAX), // Lower Fore Right
  501. (CMID, CMID, CMID), // Lower Back Left
  502. (CMAX, CMID, CMID) // Lower Back Right
  503. );
  504. function ConeContainsBSphere(const Cone: TGLConeSP; const BSphere: TBSphere): TSpaceContains;
  505. var
  506. U, D: TAffineVector;
  507. E, Dsqr: Single;
  508. begin
  509. // NOTE: This code hasn't been verified
  510. // U = K.vertex - (Sphere.radius/K.sin)*K.axis;
  511. U := VectorSubtract(Cone.Base, VectorScale(Cone.Axis, BSphere.Radius / Sin(Cone.Angle)));
  512. // D = S.center - U;
  513. D := VectorSubtract(BSphere.Center, U);
  514. // dsqr = Dot(D,D)
  515. Dsqr := VectorDotProduct(D, D);
  516. // e = Dot(K.axis,D);
  517. E := VectorDotProduct(Cone.Axis, D);
  518. if (E > 0) and (E * E >= Dsqr * Sqr(Cos(Cone.Angle))) then
  519. begin
  520. // D = S.center - K.vertex;
  521. D := VectorSubtract(BSphere.Center, Cone.Base);
  522. // dsqr = Dot(D,D);
  523. Dsqr := VectorDotProduct(D, D);
  524. // e = -Dot(K.axis,D);
  525. E := -VectorDotProduct(Cone.Axis, D);
  526. if (E > 0) and (E * E >= Dsqr * (Sqr(Sin(Cone.Angle)))) then
  527. begin
  528. if Dsqr <= BSphere.Radius * BSphere.Radius then
  529. Result := ScContainsPartially
  530. else
  531. Result := ScNoOverlap;
  532. end
  533. else
  534. Result := ScContainsPartially;
  535. end
  536. else
  537. Result := ScNoOverlap;
  538. end; // }
  539. function ExtendedFrustumIntersectsBSphere(const AExtendedFrustum: TGLExtendedFrustum; const ABSphere: TBSphere): Boolean;
  540. begin
  541. // Test if the bounding sphere of the node intersect the bounding sphere of the
  542. // frustum? This test is exremely fast
  543. if not BSphereIntersectsBSphere(ABSphere, AExtendedFrustum.BSphere) then
  544. Result := False
  545. // Test if the bsphere of the node intersects the frustum
  546. else if IsVolumeClipped(ABSphere.Center, ABSphere.Radius, AExtendedFrustum.Frustum) then
  547. Result := False
  548. else
  549. Result := True;
  550. end;
  551. function ExtendedFrustumMake(const AFrustum: TFrustum; const ANearDist, AFarDist, AFieldOfViewRadians: Single;
  552. const ACameraPosition, ALookVector: TAffineVector { ;
  553. const AScreenWidth, AScreenHeight : integer{ } ): TGLExtendedFrustum;
  554. var
  555. ViewLen: Single;
  556. Height, Width: Single;
  557. // Depth, Corner, NewFov : single;
  558. P, Q, VDiff: TAffineVector; // }
  559. begin
  560. // See http://www.flipcode.com/articles/article_frustumculling.shtml for
  561. // details calculate the radius of the frustum sphere
  562. Result.Frustum := AFrustum;
  563. // ************
  564. // Creates a bounding sphere for the entire frustum - only bspheres that
  565. // intersect this bounding sphere can in turn intersect the frustum
  566. ViewLen := AFarDist - ANearDist;
  567. // use some trig to find the height of the frustum at the far plane
  568. Height := ViewLen * Sin(AFieldOfViewRadians / 2); // was tan( !?
  569. // with an aspect ratio of 1, the width will be the same
  570. Width := Height;
  571. // halfway point between near/far planes starting at the origin and extending along the z axis
  572. P := AffineVectorMake(0, 0, ANearDist + ViewLen / 2);
  573. // the calculate far corner of the frustum
  574. Q := AffineVectorMake(Width, Height, ViewLen);
  575. // the vector between P and Q
  576. VDiff := VectorSubtract(P, Q);
  577. // the radius becomes the length of this vector
  578. Result.BSphere.Radius := VectorLength(VDiff);
  579. // calculate the center of the sphere
  580. Result.BSphere.Center := VectorAdd(ACameraPosition, VectorScale(ALookVector, ViewLen / 2 + ANearDist));
  581. // ************
  582. // Creates a cone
  583. // calculate the length of the fov triangle
  584. { Depth := AScreenHeight / tan(AFieldOfViewRadians / 2);
  585. // calculate the corner of the screen
  586. Corner := sqrt(AScreenHeight * AScreenHeight + AScreenWidth * AScreenWidth);
  587. // now calculate the new fov
  588. NewFov := ArcTan2(Corner, Depth);
  589. // apply to the cone
  590. result.SPCone.Axis := ALookVector;
  591. result.SPCone.Base := ACameraPosition;
  592. result.SPCone.Angle := NewFov; // }
  593. end;
  594. //-------------------------
  595. // TGLSpacePartitionLeaf
  596. //-------------------------
  597. procedure TGLSpacePartitionLeaf.UpdateCachedAABBAndBSphere;
  598. begin
  599. // You MUST override TGLSpacePartitionLeaf.UpdateCachedAABBAndBSphere, if you
  600. // only have easy access to a bounding sphere, or only an axis aligned
  601. // bounding box, you can easily convert from one to the other by using
  602. // AABBToBSphere and BSphereToAABB.
  603. //
  604. // You MUST set both FCachedAABB AND FCachedBSphere
  605. Assert(False, 'You MUST override TGLSpacePartitionLeaf.UpdateCachedAABBAndBSphere!');
  606. end;
  607. procedure TGLSpacePartitionLeaf.Changed;
  608. begin
  609. UpdateCachedAABBAndBSphere;
  610. SpacePartition.LeafChanged(Self);
  611. end;
  612. constructor TGLSpacePartitionLeaf.CreateOwned(SpacePartition: TGLBaseSpacePartition);
  613. begin
  614. inherited Create;
  615. FSpacePartition := SpacePartition;
  616. if SpacePartition <> nil then
  617. SpacePartition.AddLeaf(Self);
  618. end;
  619. destructor TGLSpacePartitionLeaf.Destroy;
  620. begin
  621. if Assigned(FSpacePartition) then
  622. FSpacePartition.RemoveLeaf(Self);
  623. inherited;
  624. end;
  625. procedure TGLSpacePartitionLeaf.SetSpacePartition(const Value: TGLBaseSpacePartition);
  626. begin
  627. if Assigned(FSpacePartition) then
  628. FSpacePartition.RemoveLeaf(Self);
  629. FSpacePartition := Value;
  630. if Assigned(FSpacePartition) then
  631. FSpacePartition.AddLeaf(Self);
  632. end;
  633. //------------------------------
  634. // TGLSpacePartitionLeafList
  635. //-------------------------------
  636. constructor TGLSpacePartitionLeafList.Create;
  637. begin
  638. inherited;
  639. GrowthDelta := 128;
  640. end;
  641. function TGLSpacePartitionLeafList.GetItems(I: Integer): TGLSpacePartitionLeaf;
  642. begin
  643. Result := TGLSpacePartitionLeaf(Get(I));
  644. end;
  645. procedure TGLSpacePartitionLeafList.SetItems(I: Integer; const Value: TGLSpacePartitionLeaf);
  646. begin
  647. Put(I, Value);
  648. end;
  649. //------------------------------
  650. // TGLSpacePartitionLeafs
  651. //-------------------------------
  652. constructor TGLSpacePartitionLeafS.CreateGLOwned(SpacePartition
  653. : TGLBaseSpacePartition; aGLBaseSceneObject: TGLBaseSceneObject);
  654. begin
  655. GLBaseSceneObject := aGLBaseSceneObject;
  656. // Set them all off in the same direction
  657. Direction.X := Random();
  658. Direction.Y := Random();
  659. Direction.Z := Random(); // }
  660. NormalizeVector(Direction);
  661. inherited CreateOwned(SpacePartition);
  662. end;
  663. procedure TGLSpacePartitionLeafS.UpdateCachedAABBAndBSphere;
  664. begin
  665. FCachedAABB := GLBaseSceneObject.AxisAlignedBoundingBox();
  666. FCachedAABB.Min := GLBaseSceneObject.LocalToAbsolute(FCachedAABB.Min);
  667. FCachedAABB.Max := GLBaseSceneObject.LocalToAbsolute(FCachedAABB.Max);
  668. FCachedBSphere.Radius := GLBaseSceneObject.BoundingSphereRadius;
  669. FCachedBSphere.Center := GLBaseSceneObject.Position.AsAffineVector;
  670. end;
  671. //--------------------------------------
  672. // TGLBaseSpacePartition
  673. //--------------------------------------
  674. procedure TGLBaseSpacePartition.AddLeaf(ALeaf: TGLSpacePartitionLeaf);
  675. begin
  676. // Virtual
  677. ALeaf.UpdateCachedAABBAndBSphere;
  678. end;
  679. procedure TGLBaseSpacePartition.Clear;
  680. begin
  681. // Virtual
  682. end;
  683. constructor TGLBaseSpacePartition.Create;
  684. begin
  685. inherited;
  686. FQueryResult := TGLSpacePartitionLeafList.Create
  687. end;
  688. destructor TGLBaseSpacePartition.Destroy;
  689. begin
  690. FreeAndNil(FQueryResult);
  691. inherited;
  692. end;
  693. procedure TGLBaseSpacePartition.FlushQueryResult;
  694. begin
  695. FQueryResult.Count := 0;
  696. FQueryInterObjectTests := 0;
  697. end;
  698. procedure TGLBaseSpacePartition.LeafChanged(ALeaf: TGLSpacePartitionLeaf);
  699. begin
  700. // Virtual
  701. end;
  702. procedure TGLBaseSpacePartition.ProcessUpdated;
  703. begin
  704. // Virtual
  705. end;
  706. function TGLBaseSpacePartition.QueryAABB(const AAABB: TAABB): Integer;
  707. begin
  708. // Virtual
  709. Result := 0;
  710. end;
  711. function TGLBaseSpacePartition.QueryBSphere(const ABSphere: TBSphere): Integer;
  712. begin
  713. // Virtual
  714. Result := 0;
  715. end;
  716. function TGLBaseSpacePartition.QueryCone(const ACone: TGLConeSP): Integer;
  717. begin
  718. // Virtual
  719. Result := 0;
  720. end;
  721. function TGLBaseSpacePartition.QueryPlane(const Location, Normal: TAffineVector): Integer;
  722. begin
  723. // Virtual
  724. Result := 0;
  725. end;
  726. function TGLBaseSpacePartition.QueryLeaf(const ALeaf: TGLSpacePartitionLeaf): Integer;
  727. begin
  728. QueryBSphere(ALeaf.FCachedBSphere);
  729. // Remove self if it was included (it should have been)
  730. FQueryResult.Remove(ALeaf);
  731. Result := FQueryResult.Count;
  732. end;
  733. procedure TGLBaseSpacePartition.RemoveLeaf(ALeaf: TGLSpacePartitionLeaf);
  734. begin
  735. // Virtual
  736. end;
  737. function TGLBaseSpacePartition.QueryFrustum(const Frustum: TFrustum): Integer;
  738. begin
  739. // Virtual
  740. Result := 0;
  741. end;
  742. function TGLBaseSpacePartition.QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum): Integer;
  743. begin
  744. // Virtual
  745. Result := 0;
  746. end;
  747. { TGLLeavedSpacePartition }
  748. procedure TGLLeavedSpacePartition.AddLeaf(ALeaf: TGLSpacePartitionLeaf);
  749. begin
  750. FLeaves.Add(ALeaf);
  751. ALeaf.UpdateCachedAABBAndBSphere;
  752. end;
  753. procedure TGLLeavedSpacePartition.Clear;
  754. var
  755. I: Integer;
  756. begin
  757. inherited;
  758. for I := 0 to FLeaves.Count - 1 do
  759. begin
  760. FLeaves[I].FSpacePartition := nil;
  761. FLeaves[I].Free;
  762. end;
  763. FLeaves.Clear;
  764. end;
  765. constructor TGLLeavedSpacePartition.Create;
  766. begin
  767. inherited;
  768. FLeaves := TGLSpacePartitionLeafList.Create;
  769. end;
  770. destructor TGLLeavedSpacePartition.Destroy;
  771. begin
  772. Clear;
  773. FreeAndNil(FLeaves);
  774. inherited;
  775. end;
  776. procedure TGLLeavedSpacePartition.RemoveLeaf(ALeaf: TGLSpacePartitionLeaf);
  777. begin
  778. FLeaves.Remove(ALeaf);
  779. end;
  780. function TGLLeavedSpacePartition.QueryAABB(const AAABB: TAABB): Integer;
  781. var
  782. I: Integer;
  783. begin
  784. // Very brute force!
  785. FlushQueryResult;
  786. for I := 0 to Leaves.Count - 1 do
  787. begin
  788. Inc(FQueryInterObjectTests);
  789. if IntersectAABBsAbsolute(AAABB, Leaves[I].FCachedAABB) then
  790. FQueryResult.Add(Leaves[I]);
  791. end;
  792. Result := FQueryResult.Count;
  793. end;
  794. function TGLLeavedSpacePartition.QueryBSphere(const ABSphere: TBSphere): Integer;
  795. var
  796. I: Integer;
  797. Distance2: Single;
  798. Leaf: TGLSpacePartitionLeaf;
  799. begin
  800. // Very brute force!
  801. FlushQueryResult;
  802. for I := 0 to Leaves.Count - 1 do
  803. begin
  804. Leaf := Leaves[I];
  805. Distance2 := VectorDistance2(Leaf.FCachedBSphere.Center, ABSphere.Center);
  806. Inc(FQueryInterObjectTests);
  807. if Distance2 < Sqr(Leaf.FCachedBSphere.Radius + ABSphere.Radius) then
  808. FQueryResult.Add(Leaf);
  809. end;
  810. Result := FQueryResult.Count;
  811. end;
  812. function TGLLeavedSpacePartition.QueryCone(const ACone: TGLConeSP): Integer;
  813. var
  814. I: Integer;
  815. begin
  816. // Very brute force!
  817. FlushQueryResult;
  818. for I := 0 to Leaves.Count - 1 do
  819. begin
  820. Inc(FQueryInterObjectTests);
  821. if ConeContainsBSphere(ACone, Leaves[I].FCachedBSphere) <> ScNoOverlap then
  822. FQueryResult.Add(Leaves[I]);
  823. end;
  824. Result := FQueryResult.Count;
  825. end;
  826. function TGLLeavedSpacePartition.QueryPlane(const FLocation, FNormal: TAffineVector): Integer;
  827. var
  828. I: Integer;
  829. CurrentPenetrationDepth: Single;
  830. Leaf: TGLSpacePartitionLeaf;
  831. begin
  832. // Very brute force!
  833. FlushQueryResult;
  834. for I := 0 to Leaves.Count - 1 do
  835. begin
  836. Inc(FQueryInterObjectTests);
  837. Leaf := Leaves[I];
  838. CurrentPenetrationDepth := -(PointPlaneDistance(Leaf.FCachedBSphere.Center, FLocation, FNormal) -
  839. Leaf.FCachedBSphere.Radius);
  840. // Correct the node location
  841. if CurrentPenetrationDepth > 0 then
  842. FQueryResult.Add(Leaves[I]);
  843. end; // }
  844. Result := FQueryResult.Count;
  845. end;
  846. //-------------------------------------
  847. // TGLSectorNode
  848. //-------------------------------------
  849. function TGLSectorNode.AABBFitsInNode(const AAABB: TAABB): Boolean;
  850. begin
  851. Result := ContainsAABB(AAABB) in [ScContainsFully];
  852. end;
  853. function TGLSectorNode.AABBIntersectsNode(const AAABB: TAABB): Boolean;
  854. begin
  855. Result := ContainsAABB(AAABB) in [ScContainsPartially, ScContainsFully];
  856. end;
  857. procedure TGLSectorNode.AddAllLeavesRecursive(const QueryResult: TGLSpacePartitionLeafList);
  858. var
  859. I: Integer;
  860. begin
  861. for I := 0 to FLeaves.Count - 1 do
  862. QueryResult.Add(FLeaves[I]);
  863. for I := 0 to FChildCount - 1 do
  864. FChildren[I].AddAllLeavesRecursive(QueryResult);
  865. end;
  866. function TGLSectorNode.AddLeaf(ALeaf: TGLSpacePartitionLeaf): TGLSectorNode;
  867. begin
  868. // Time to grow the node?
  869. if NoChildren and (FLeaves.Count >= FSectoredSpacePartition.FLeafThreshold) and
  870. (FNodeDepth < FSectoredSpacePartition.FMaxTreeDepth) then
  871. begin
  872. ExpandNode;
  873. end;
  874. Inc(FRecursiveLeafCount);
  875. if NoChildren then
  876. begin
  877. FLeaves.Add(ALeaf);
  878. ChildrenChanged;
  879. ALeaf.FPartitionTag := Self;
  880. Result := Self;
  881. end
  882. else
  883. begin
  884. // Does it fit completely in any of the children?
  885. Result := PlaceLeafInChild(ALeaf);
  886. end;
  887. end;
  888. function TGLSectorNode.BSphereFitsInNode(const BSphere: TBSphere): Boolean;
  889. begin
  890. Result := ContainsBSphere(BSphere) in [ScContainsFully];
  891. end;
  892. function TGLSectorNode.BSphereIntersectsNode(const BSphere: TBSphere): Boolean;
  893. begin
  894. Result := ContainsBSphere(BSphere) in [ScContainsPartially, ScContainsFully];
  895. end;
  896. function TGLSectorNode.CalcRecursiveLeafCount: Integer;
  897. var
  898. I: Integer;
  899. begin
  900. Result := FLeaves.Count;
  901. for I := 0 to FChildCount - 1 do
  902. Result := Result + FChildren[I].CalcRecursiveLeafCount;
  903. end;
  904. procedure TGLSectorNode.Clear;
  905. var
  906. I: Integer;
  907. begin
  908. for I := 0 to FChildCount - 1 do
  909. FreeAndNil(FChildren[I]);
  910. FChildCount := 0;
  911. FLeaves.Clear;
  912. end;
  913. constructor TGLSectorNode.Create(ASectoredSpacePartition: TGLSectoredSpacePartition; AParent: TGLSectorNode);
  914. begin
  915. FLeaves := TGLSpacePartitionLeafList.Create;
  916. FChildCount := 0;
  917. FParent := AParent;
  918. FSectoredSpacePartition := ASectoredSpacePartition;
  919. if AParent = nil then
  920. FNodeDepth := 0
  921. else
  922. FNodeDepth := AParent.FNodeDepth + 1;
  923. end;
  924. procedure TGLSectorNode.ExpandNode;
  925. var
  926. I: Integer;
  927. OldLeaves: TGLSpacePartitionLeafList;
  928. begin
  929. CreateChildren;
  930. // The children have been added, now move all leaves to the children - if
  931. // we can
  932. OldLeaves := FLeaves;
  933. try
  934. FLeaves := TGLSpacePartitionLeafList.Create;
  935. for I := 0 to OldLeaves.Count - 1 do
  936. PlaceLeafInChild(OldLeaves[I]);
  937. finally
  938. OldLeaves.Free;
  939. end;
  940. end;
  941. procedure TGLSectorNode.CollapseNode;
  942. var
  943. I, J: Integer;
  944. begin
  945. for I := 0 to FChildCount - 1 do
  946. begin
  947. FChildren[I].CollapseNode;
  948. for J := 0 to FChildren[I].FLeaves.Count - 1 do
  949. begin
  950. FChildren[I].FLeaves[J].FPartitionTag := Self;
  951. FLeaves.Add(FChildren[I].FLeaves[J]);
  952. end;
  953. FChildren[I].FLeaves.Clear;
  954. FreeAndNil(FChildren[I]);
  955. end;
  956. FChildCount := 0;
  957. end;
  958. destructor TGLSectorNode.Destroy;
  959. begin
  960. Clear;
  961. FreeAndNil(FLeaves);
  962. inherited;
  963. end;
  964. function TGLSectorNode.GetNoChildren: Boolean;
  965. begin
  966. Result := FChildCount = 0;
  967. end;
  968. function TGLSectorNode.GetNodeCount: Integer;
  969. var
  970. I: Integer;
  971. begin
  972. Result := 1;
  973. for I := 0 to FChildCount - 1 do
  974. Result := Result + FChildren[I].GetNodeCount;
  975. end;
  976. function TGLSectorNode.PlaceLeafInChild(ALeaf: TGLSpacePartitionLeaf): TGLSectorNode;
  977. var
  978. ChildNode: TGLSectorNode;
  979. begin
  980. // Which child does it fit in?
  981. ChildNode := GetChildForAABB(ALeaf.FCachedAABB);
  982. if ChildNode <> nil then
  983. begin
  984. Result := ChildNode.AddLeaf(ALeaf);
  985. Exit;
  986. end; // }
  987. // Doesn't fit the any child
  988. ALeaf.FPartitionTag := Self;
  989. FLeaves.Add(ALeaf);
  990. ChildrenChanged;
  991. Result := Self;
  992. end;
  993. procedure TGLSectorNode.QueryAABB(const AAABB: TAABB; const QueryResult: TGLSpacePartitionLeafList);
  994. var
  995. I: Integer;
  996. SpaceContains: TSpaceContains;
  997. begin
  998. Inc(FSectoredSpacePartition.FQueryNodeTests);
  999. SpaceContains := AABBContainsSector(AAABB);
  1000. if SpaceContains = ScContainsFully then
  1001. begin
  1002. AddAllLeavesRecursive(QueryResult);
  1003. end
  1004. else if SpaceContains = ScContainsPartially then
  1005. begin
  1006. // Add all leaves that overlap
  1007. if FSectoredSpacePartition.CullingMode = CmFineCulling then
  1008. begin
  1009. for I := 0 to FLeaves.Count - 1 do
  1010. begin
  1011. Inc(FSectoredSpacePartition.FQueryInterObjectTests);
  1012. if IntersectAABBsAbsolute(FLeaves[I].FCachedAABB, AAABB) then
  1013. QueryResult.Add(FLeaves[I]);
  1014. end;
  1015. end
  1016. else
  1017. begin
  1018. for I := 0 to FLeaves.Count - 1 do
  1019. QueryResult.Add(FLeaves[I]);
  1020. end;
  1021. // Recursively let the children add their leaves
  1022. for I := 0 to FChildCount - 1 do
  1023. FChildren[I].QueryAABB(AAABB, QueryResult);
  1024. end;
  1025. end;
  1026. procedure TGLSectorNode.QueryBSphere(const ABSphere: TBSphere; const QueryResult: TGLSpacePartitionLeafList);
  1027. var
  1028. I: Integer;
  1029. SpaceContains: TSpaceContains;
  1030. begin
  1031. Inc(FSectoredSpacePartition.FQueryNodeTests);
  1032. SpaceContains := BSphereContainsSector(ABSphere);
  1033. if SpaceContains = ScContainsFully then
  1034. begin
  1035. AddAllLeavesRecursive(QueryResult);
  1036. end
  1037. else if SpaceContains = ScContainsPartially then
  1038. begin
  1039. // Add all leaves that overlap
  1040. if FSectoredSpacePartition.CullingMode = CmFineCulling then
  1041. begin
  1042. for I := 0 to FLeaves.Count - 1 do
  1043. begin
  1044. Inc(FSectoredSpacePartition.FQueryInterObjectTests);
  1045. if BSphereContainsAABB(ABSphere, FLeaves[I].FCachedAABB) <> ScNoOverlap then
  1046. QueryResult.Add(FLeaves[I]);
  1047. end;
  1048. end
  1049. else
  1050. for I := 0 to FLeaves.Count - 1 do
  1051. QueryResult.Add(FLeaves[I]);
  1052. // Recursively let the children add their leaves
  1053. for I := 0 to FChildCount - 1 do
  1054. FChildren[I].QueryBSphere(ABSphere, QueryResult);
  1055. end;
  1056. end;
  1057. procedure TGLSectorNode.QueryPlane(const Location, Normal: TAffineVector; const QueryResult: TGLSpacePartitionLeafList);
  1058. var
  1059. I: Integer;
  1060. SpaceContains: TSpaceContains;
  1061. begin
  1062. Inc(FSectoredSpacePartition.FQueryNodeTests);
  1063. SpaceContains := PlaneContainsBSphere(Location, Normal, FBSphere);
  1064. if SpaceContains = ScContainsFully then
  1065. begin
  1066. AddAllLeavesRecursive(QueryResult);
  1067. end
  1068. else if SpaceContains = ScContainsPartially then
  1069. begin
  1070. // Add all leaves that overlap
  1071. if FSectoredSpacePartition.CullingMode = CmFineCulling then
  1072. begin
  1073. for I := 0 to FLeaves.Count - 1 do
  1074. if PlaneContainsBSphere(Location, Normal, FLeaves[I].FCachedBSphere) <> ScNoOverlap then
  1075. QueryResult.Add(FLeaves[I]);
  1076. end
  1077. else
  1078. for I := 0 to FLeaves.Count - 1 do
  1079. QueryResult.Add(FLeaves[I]);
  1080. // Recursively let the children add their leaves
  1081. for I := 0 to FChildCount - 1 do
  1082. begin
  1083. Inc(FSectoredSpacePartition.FQueryInterObjectTests);
  1084. FChildren[I].QueryPlane(Location, Normal, QueryResult);
  1085. end;
  1086. end;
  1087. // *)
  1088. end;
  1089. function TGLSectorNode.RemoveLeaf(ALeaf: TGLSpacePartitionLeaf; OwnerByThis: Boolean): Boolean;
  1090. begin
  1091. Result := False;
  1092. Dec(FRecursiveLeafCount);
  1093. if OwnerByThis then
  1094. begin
  1095. ALeaf.FPartitionTag := nil;
  1096. FLeaves.Remove(ALeaf);
  1097. ChildrenChanged;
  1098. end;
  1099. // If there aren't enough leaves anymore, it's time to remove the node!
  1100. if not NoChildren and (FRecursiveLeafCount + 1 < FSectoredSpacePartition.FLeafThreshold) then
  1101. begin
  1102. CollapseNode;
  1103. Result := True;
  1104. end;
  1105. if Parent <> nil then
  1106. Parent.RemoveLeaf(ALeaf, False);
  1107. end;
  1108. function TGLSectorNode.VerifyRecursiveLeafCount: string;
  1109. var
  1110. I: Integer;
  1111. begin
  1112. if FRecursiveLeafCount <> CalcRecursiveLeafCount then
  1113. begin
  1114. Result := Format('Node at depth %d mismatches, %d<>%d!', [FNodeDepth, FRecursiveLeafCount, CalcRecursiveLeafCount]);
  1115. Exit;
  1116. end;
  1117. for I := 0 to FChildCount - 1 do
  1118. begin
  1119. Result := FChildren[I].VerifyRecursiveLeafCount;
  1120. if Result <> '' then
  1121. Exit;
  1122. end;
  1123. end;
  1124. procedure TGLSectorNode.CreateChildren;
  1125. begin
  1126. Assert(False, 'You must override CreateChildren!');
  1127. end;
  1128. function TGLSectorNode.AABBContainsSector(const AABB: TAABB): TSpaceContains;
  1129. begin
  1130. Result := AABBContainsAABB(AABB, FAABB);
  1131. end;
  1132. function TGLSectorNode.BSphereContainsSector(const BSphere: TBSphere): TSpaceContains;
  1133. begin
  1134. Result := BSphereContainsAABB(BSphere, FAABB);
  1135. end;
  1136. function TGLSectorNode.ContainsAABB(const AAABB: TAABB): TSpaceContains;
  1137. begin
  1138. Result := AABBContainsAABB(FAABB, AAABB);
  1139. end;
  1140. function TGLSectorNode.ContainsBSphere(const ABSphere: TBSphere): TSpaceContains;
  1141. begin
  1142. Result := AABBContainsBSphere(FAABB, ABSphere);
  1143. end;
  1144. procedure TGLSectorNode.SetAABB(const Value: TAABB);
  1145. begin
  1146. FAABB := Value;
  1147. AABBToBSphere(FAABB, FBSphere);
  1148. end;
  1149. function TGLSectorNode.GetChildForAABB(const AABB: TAABB): TGLSectorNode;
  1150. var
  1151. Location: TAffineVector;
  1152. ChildNode: TGLSectorNode;
  1153. ChildNodeIndex: Integer;
  1154. begin
  1155. Assert(FChildCount > 0, 'There are no children in this node!');
  1156. // Instead of looping through all children, we simply determine on which
  1157. // side of the center node the child is located
  1158. ChildNodeIndex := 0;
  1159. Location := AABB.Min;
  1160. // Upper / Lower
  1161. if Location.Y < FBSphere.Center.Y then
  1162. ChildNodeIndex := 4;
  1163. // Left / Right
  1164. if Location.Z < FBSphere.Center.Z then
  1165. ChildNodeIndex := ChildNodeIndex or 2;
  1166. // Fore / Back
  1167. if Location.X > FBSphere.Center.X then
  1168. ChildNodeIndex := ChildNodeIndex or 1;
  1169. Assert((ChildNodeIndex >= 0) and (ChildNodeIndex <= 8), Format('ChildNodeIndex is out of range (%d)!', [ChildNodeIndex]));
  1170. ChildNode := FChildren[ChildNodeIndex];
  1171. Assert(Assigned(ChildNode), 'ChildNode not assigned');
  1172. if ChildNode.AABBFitsInNode(AABB) then
  1173. Result := ChildNode
  1174. else
  1175. Result := nil;
  1176. end;
  1177. function TGLSectorNode.GetCenter: TAffineVector;
  1178. begin
  1179. Result := FBSphere.Center;
  1180. end;
  1181. procedure TGLSectorNode.QueryFrustum(const Frustum: TFrustum; const QueryResult: TGLSpacePartitionLeafList);
  1182. var
  1183. SpaceContains: TSpaceContains;
  1184. I: Integer;
  1185. begin
  1186. Inc(FSectoredSpacePartition.FQueryNodeTests);
  1187. // Check if the frustum contains the bsphere of the node
  1188. if not IsVolumeClipped(BSphere.Center, BSphere.Radius, Frustum) then
  1189. SpaceContains := FrustumContainsAABB(Frustum, AABB)
  1190. else
  1191. SpaceContains := ScNoOverlap;
  1192. // If the frustum fully contains the leaf, then we need not check every piece,
  1193. // just add them all
  1194. if SpaceContains = ScContainsFully then
  1195. begin
  1196. AddAllLeavesRecursive(QueryResult);
  1197. end
  1198. else
  1199. // If the frustum partiall contains the leaf, then we should add the leaves
  1200. // that intersect the frustum and recurse for all children
  1201. if SpaceContains = ScContainsPartially then
  1202. begin
  1203. for I := 0 to FLeaves.Count - 1 do
  1204. begin
  1205. Inc(FSectoredSpacePartition.FQueryInterObjectTests);
  1206. if not IsVolumeClipped(FLeaves[I].FCachedBSphere.Center, FLeaves[I].FCachedBSphere.Radius, Frustum) then
  1207. QueryResult.Add(FLeaves[I]);
  1208. end;
  1209. // Recursively let the children add their leaves
  1210. for I := 0 to FChildCount - 1 do
  1211. FChildren[I].QueryFrustum(Frustum, QueryResult);
  1212. end;
  1213. end;
  1214. procedure TGLSectorNode.ChildrenChanged;
  1215. begin
  1216. // Do nothing in the basic case
  1217. end;
  1218. procedure TGLSectorNode.QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum; const QueryResult: TGLSpacePartitionLeafList);
  1219. var
  1220. SpaceContains: TSpaceContains;
  1221. I: Integer;
  1222. begin
  1223. Inc(FSectoredSpacePartition.FQueryNodeTests);
  1224. // Does the extended frustum intersect the bsphere at all?
  1225. if not ExtendedFrustumIntersectsBSphere(ExtendedFrustum, BSphere) then
  1226. SpaceContains := ScNoOverlap
  1227. else
  1228. // Test if the bounding frustum intersects the AABB of the node
  1229. SpaceContains := FrustumContainsAABB(ExtendedFrustum.Frustum, AABB); // }
  1230. // If the frustum fully contains the leaf, then we need not check every piece,
  1231. // just add them all
  1232. if SpaceContains = ScContainsFully then
  1233. begin
  1234. AddAllLeavesRecursive(QueryResult);
  1235. end
  1236. else
  1237. // If the frustum partially contains the leaf, then we should add the leaves
  1238. // that intersect the frustum and recurse for all children
  1239. if SpaceContains = ScContainsPartially then
  1240. begin
  1241. for I := 0 to FLeaves.Count - 1 do
  1242. begin
  1243. // Early out 1
  1244. if not BSphereIntersectsBSphere(FLeaves[I].FCachedBSphere, ExtendedFrustum.BSphere) then
  1245. Continue;
  1246. Inc(FSectoredSpacePartition.FQueryInterObjectTests);
  1247. if not IsVolumeClipped(FLeaves[I].FCachedBSphere.Center, FLeaves[I].FCachedBSphere.Radius, ExtendedFrustum.Frustum) then
  1248. QueryResult.Add(FLeaves[I]);
  1249. end;
  1250. // Recursively let the children add their leaves
  1251. for I := 0 to FChildCount - 1 do
  1252. FChildren[I].QueryFrustumEx(ExtendedFrustum, QueryResult);
  1253. end;
  1254. end;
  1255. //-------------------------------------
  1256. // TGLSectoredSpacePartition
  1257. //-------------------------------------
  1258. procedure TGLSectoredSpacePartition.AddLeaf(ALeaf: TGLSpacePartitionLeaf);
  1259. begin
  1260. inherited;
  1261. FRootNode.AddLeaf(ALeaf);
  1262. if not FRootNode.AABBFitsInNode(ALeaf.FCachedAABB) then
  1263. begin
  1264. if FGrowMethod in [gmBestFit, gmIncreaseToFitAll] then
  1265. UpdateStructureSize(GrowGravy)
  1266. else
  1267. Assert(False, 'Node is outside Octree!');
  1268. end;
  1269. end;
  1270. procedure TGLSectoredSpacePartition.Clear;
  1271. begin
  1272. inherited Clear;
  1273. if Assigned(FRootNode) then
  1274. FRootNode.Clear;
  1275. end;
  1276. constructor TGLSectoredSpacePartition.Create;
  1277. begin
  1278. FLeafThreshold := COctree_LEAF_TRHESHOLD;
  1279. FMaxTreeDepth := COctree_MAX_TREE_DEPTH;
  1280. FRootNode := CreateNewNode(nil);
  1281. FGrowMethod := gmIncreaseToFitAll;
  1282. FGrowGravy := COctree_GROW_GRAVY;
  1283. inherited Create;
  1284. end;
  1285. function TGLSectoredSpacePartition.CreateNewNode(AParent: TGLSectorNode): TGLSectorNode;
  1286. begin
  1287. Result := TGLSectorNode.Create(Self, AParent);
  1288. end;
  1289. destructor TGLSectoredSpacePartition.Destroy;
  1290. begin
  1291. inherited Destroy;
  1292. FRootNode.Free;
  1293. end;
  1294. function TGLSectoredSpacePartition.GetAABB: TAABB;
  1295. var
  1296. I: Integer;
  1297. begin
  1298. if FLeaves.Count = 0 then
  1299. begin
  1300. MakeVector(Result.Min, 0, 0, 0);
  1301. MakeVector(Result.Max, 0, 0, 0);
  1302. end
  1303. else
  1304. begin
  1305. Result := FLeaves[0].FCachedAABB;
  1306. for I := 1 to FLeaves.Count - 1 do
  1307. AddAABB(Result, FLeaves[I].FCachedAABB);
  1308. end;
  1309. end;
  1310. function TGLSectoredSpacePartition.GetNodeCount: Integer;
  1311. begin
  1312. Result := FRootNode.GetNodeCount;
  1313. end;
  1314. procedure TGLSectoredSpacePartition.LeafChanged(ALeaf: TGLSpacePartitionLeaf);
  1315. var
  1316. Node: TGLSectorNode;
  1317. begin
  1318. // If the leaf still fits in the old node, leave it there - or in one of the
  1319. // children
  1320. Node := TGLSectorNode(ALeaf.FPartitionTag);
  1321. Assert(Node <> nil, 'No leaf node could be found!');
  1322. if Node.AABBFitsInNode(ALeaf.FCachedAABB) then
  1323. begin
  1324. // If the node has children, try to add the leaf to them - otherwise just
  1325. // leave it!
  1326. if Node.FChildCount > 0 then
  1327. begin
  1328. Node.FLeaves.Remove(ALeaf);
  1329. Node.PlaceLeafInChild(ALeaf);
  1330. Node.ChildrenChanged;
  1331. end;
  1332. end
  1333. else
  1334. begin
  1335. Node.RemoveLeaf(ALeaf, True);
  1336. // Does this leaf still fit in the Octree?
  1337. if not FRootNode.AABBFitsInNode(ALeaf.FCachedAABB) then
  1338. begin
  1339. if FGrowMethod in [gmBestFit, gmIncreaseToFitAll] then
  1340. UpdateStructureSize(COctree_GROW_GRAVY)
  1341. else
  1342. Assert(False, 'Node is outside Octree!');
  1343. end
  1344. else
  1345. FRootNode.AddLeaf(ALeaf);
  1346. end;
  1347. end;
  1348. function TGLSectoredSpacePartition.QueryAABB(const AAABB: TAABB): Integer;
  1349. begin
  1350. FlushQueryResult;
  1351. FRootNode.QueryAABB(AAABB, FQueryResult);
  1352. Result := FQueryResult.Count;
  1353. end;
  1354. function TGLSectoredSpacePartition.QueryBSphere(const ABSphere: TBSphere): Integer;
  1355. begin
  1356. FlushQueryResult;
  1357. FRootNode.QueryBSphere(ABSphere, FQueryResult);
  1358. Result := FQueryResult.Count;
  1359. end;
  1360. function TGLSectoredSpacePartition.QueryPlane(const Location, Normal: TAffineVector): Integer;
  1361. begin
  1362. FlushQueryResult;
  1363. FRootNode.QueryPlane(Location, Normal, FQueryResult);
  1364. Result := FQueryResult.Count;
  1365. end;
  1366. function TGLSectoredSpacePartition.QueryLeaf(const ALeaf: TGLSpacePartitionLeaf): Integer;
  1367. var
  1368. I: Integer;
  1369. Node: TGLSectorNode;
  1370. TestLeaf: TGLSpacePartitionLeaf;
  1371. begin
  1372. // Query current node and all nodes upwards until we find the root, no need
  1373. // to check intersections, because we know that the leaf partially intersects
  1374. // all it's parents.
  1375. Node := TGLSectorNode(ALeaf.FPartitionTag);
  1376. FlushQueryResult;
  1377. // First, query downwards!
  1378. Node.QueryAABB(ALeaf.FCachedAABB, QueryResult);
  1379. // Now, query parents and upwards!
  1380. Node := Node.Parent;
  1381. while Node <> nil do
  1382. begin
  1383. Inc(FQueryNodeTests);
  1384. // Add all leaves that overlap
  1385. for I := 0 to Node.FLeaves.Count - 1 do
  1386. begin
  1387. TestLeaf := Node.FLeaves[I];
  1388. Inc(FQueryInterObjectTests);
  1389. if IntersectAABBsAbsolute(TestLeaf.FCachedAABB, ALeaf.FCachedAABB) then
  1390. QueryResult.Add(TestLeaf);
  1391. end;
  1392. // Try the parent
  1393. Node := Node.Parent;
  1394. end;
  1395. QueryResult.Remove(ALeaf);
  1396. Result := QueryResult.Count;
  1397. end;
  1398. procedure TGLSectoredSpacePartition.RemoveLeaf(ALeaf: TGLSpacePartitionLeaf);
  1399. begin
  1400. inherited;
  1401. TGLSectorNode(ALeaf.FPartitionTag).RemoveLeaf(ALeaf, True);
  1402. end;
  1403. procedure TGLSectoredSpacePartition.SetLeafThreshold(const Value: Integer);
  1404. begin
  1405. FLeafThreshold := Value;
  1406. end;
  1407. procedure TGLSectoredSpacePartition.SetMaxTreeDepth(const Value: Integer);
  1408. begin
  1409. FMaxTreeDepth := Value;
  1410. end;
  1411. procedure TGLSectoredSpacePartition.RebuildTree(const NewAABB: TAABB);
  1412. var
  1413. I: Integer;
  1414. OldLeaves: TGLSpacePartitionLeafList;
  1415. TempGrowMethod: TGLGrowMethod;
  1416. begin
  1417. // Delete ALL nodes in the tree
  1418. FRootNode.Free;
  1419. FRootNode := CreateNewNode(nil);
  1420. FRootNode.AABB := NewAABB;
  1421. // Insert all nodes again
  1422. OldLeaves := FLeaves;
  1423. FLeaves := TGLSpacePartitionLeafList.Create;
  1424. // This will cause an except if the build goes badly, which is better than
  1425. // an infinite loop
  1426. TempGrowMethod := FGrowMethod;
  1427. for I := 0 to OldLeaves.Count - 1 do
  1428. AddLeaf(OldLeaves[I]);
  1429. OldLeaves.Free;
  1430. FGrowMethod := TempGrowMethod;
  1431. end;
  1432. procedure TGLSectoredSpacePartition.UpdateStructureSize(Gravy: Single);
  1433. var
  1434. MaxAABB, NewAABB: TAABB;
  1435. AABBSize: TAffineVector;
  1436. begin
  1437. // Creates the new extents for the Octree
  1438. MaxAABB := GetAABB;
  1439. AABBSize := VectorSubtract(MaxAABB.Max, MaxAABB.Min);
  1440. if FGrowMethod = gmBestFit then
  1441. begin
  1442. NewAABB.Min := VectorSubtract(MaxAABB.Min, VectorScale(AABBSize, Gravy));
  1443. NewAABB.Max := VectorAdd(MaxAABB.Max, VectorScale(AABBSize, Gravy)); // }
  1444. end
  1445. else if FGrowMethod = gmIncreaseToFitAll then
  1446. begin
  1447. NewAABB.Min := VectorSubtract(MaxAABB.Min, VectorScale(AABBSize, Gravy));
  1448. NewAABB.Max := VectorAdd(MaxAABB.Max, VectorScale(AABBSize, Gravy)); // }
  1449. AddAABB(NewAABB, FRootNode.AABB);
  1450. end;
  1451. RebuildTree(NewAABB);
  1452. end;
  1453. procedure TGLSectoredSpacePartition.FlushQueryResult;
  1454. begin
  1455. inherited;
  1456. FQueryNodeTests := 0;
  1457. end;
  1458. function TGLSectoredSpacePartition.QueryFrustum(const Frustum: TFrustum): Integer;
  1459. begin
  1460. FlushQueryResult;
  1461. FRootNode.QueryFrustum(Frustum, FQueryResult);
  1462. Result := FQueryResult.Count;
  1463. end;
  1464. function TGLSectoredSpacePartition.QueryFrustumEx(const ExtendedFrustum: TGLExtendedFrustum): Integer;
  1465. begin
  1466. FlushQueryResult;
  1467. FRootNode.QueryFrustumEx(ExtendedFrustum, FQueryResult);
  1468. Result := FQueryResult.Count;
  1469. end;
  1470. //-------------------------------------
  1471. // TSPOctreeNode
  1472. //-------------------------------------
  1473. function TSPOctreeNode.AABBFitsInNode(const AAABB: TAABB): Boolean;
  1474. begin
  1475. // Faster than inherited method
  1476. Result := AABBFitsInAABBAbsolute(AAABB, FAABB);
  1477. end;
  1478. function TSPOctreeNode.AABBIntersectsNode(const AAABB: TAABB): Boolean;
  1479. begin
  1480. // Faster than inherited method
  1481. Result := IntersectAABBsAbsolute(FAABB, AAABB);
  1482. end;
  1483. function TSPOctreeNode.BSphereFitsInNode(const BSphere: TBSphere): Boolean;
  1484. var
  1485. AABB: TAABB;
  1486. begin
  1487. // Faster than inherited method
  1488. BSphereToAABB(BSphere, AABB);
  1489. Result := AABBFitsInAABBAbsolute(AABB, FAABB); // }
  1490. end;
  1491. function TSPOctreeNode.BSphereIntersectsNode(const BSphere: TBSphere): Boolean;
  1492. var
  1493. AABB: TAABB;
  1494. begin
  1495. // Faster than inherited method
  1496. BSphereToAABB(BSphere, AABB);
  1497. Result := IntersectAABBsAbsolute(AABB, FAABB); // }
  1498. end;
  1499. procedure TSPOctreeNode.CreateChildren;
  1500. var
  1501. I: Integer;
  1502. AABB: TAABB;
  1503. function GetExtent(const Flags: array of Byte): TAffineVector;
  1504. var
  1505. N: Integer;
  1506. begin
  1507. for N := 0 to 2 do
  1508. begin
  1509. case Flags[N] of
  1510. CMIN:
  1511. Result.V[N] := FAABB.Min.V[N];
  1512. CMID:
  1513. Result.V[N] := (FAABB.Max.V[N] + FAABB.Min.V[N]) / 2;
  1514. CMAX:
  1515. Result.V[N] := FAABB.Max.V[N];
  1516. end;
  1517. end;
  1518. end;
  1519. begin
  1520. Assert(FChildCount = 0, 'Children allready exist!');
  1521. for I := 0 to 7 do
  1522. begin
  1523. FChildren[I] := FSectoredSpacePartition.CreateNewNode(Self);
  1524. // Generate new extents based on parent's extents
  1525. AABB.Min := GetExtent(COctFlagMIN[I]);
  1526. AABB.Max := GetExtent(COctFlagMax[I]);
  1527. FChildren[I].AABB := AABB;
  1528. end;
  1529. FChildCount := 8;
  1530. end;
  1531. //-------------------------------------
  1532. // TGLOctreeSpacePartition
  1533. //-------------------------------------
  1534. function TGLOctreeSpacePartition.CreateNewNode(AParent: TGLSectorNode): TGLSectorNode;
  1535. begin
  1536. Result := TSPOctreeNode.Create(Self, AParent);
  1537. end;
  1538. procedure TGLOctreeSpacePartition.SetSize(const Min, Max: TAffineVector);
  1539. var
  1540. AABB: TAABB;
  1541. begin
  1542. AABB.Min := Min;
  1543. AABB.Max := Max;
  1544. RebuildTree(AABB);
  1545. end;
  1546. //-------------------------------------
  1547. // TSPQuadtreeNode
  1548. //-------------------------------------
  1549. function TSPQuadtreeNode.AABBFitsInNode(const AAABB: TAABB): Boolean;
  1550. begin
  1551. Result := (AAABB.Min.X >= FAABB.Min.X) and
  1552. (AAABB.Min.Z >= FAABB.Min.Z) and
  1553. (AAABB.Max.X <= FAABB.Max.X) and
  1554. (AAABB.Max.Z <= FAABB.Max.Z);
  1555. end;
  1556. function TSPQuadtreeNode.AABBIntersectsNode(const AAABB: TAABB): Boolean;
  1557. begin
  1558. Assert(False, Format('AABBIntersectsNode not implemented on %s', [ClassName]));
  1559. Result := False;
  1560. end;
  1561. function TSPQuadtreeNode.BSphereFitsInNode(const BSphere: TBSphere): Boolean;
  1562. begin
  1563. Assert(False, Format('BSphereFitsInNode not implemented on %s', [ClassName]));
  1564. Result := False;
  1565. end;
  1566. function TSPQuadtreeNode.BSphereIntersectsNode(const BSphere: TBSphere): Boolean;
  1567. begin
  1568. Assert(False, Format('BSphereIntersectsNode not implemented on %s', [ClassName]));
  1569. Result := False;
  1570. end;
  1571. procedure TSPQuadtreeNode.ChildrenChanged;
  1572. var
  1573. I: Integer;
  1574. NewMin, NewMax: Single;
  1575. begin
  1576. inherited;
  1577. // Establish a baseline
  1578. if Leaves.Count > 0 then
  1579. begin
  1580. NewMin := Leaves[0].FCachedAABB.Min.Y;
  1581. NewMax := Leaves[0].FCachedAABB.Max.Y;
  1582. end
  1583. else
  1584. if FChildCount > 0 then
  1585. begin
  1586. NewMin := FChildren[0].AABB.Min.Y;
  1587. NewMax := FChildren[0].AABB.Max.Y;
  1588. end
  1589. else
  1590. begin
  1591. // This should never happen!
  1592. NewMin := 1E9;
  1593. NewMax := -1E9;
  1594. end;
  1595. for I := 0 to Leaves.Count - 1 do
  1596. begin
  1597. NewMin := Min(NewMin, Leaves[I].FCachedAABB.Min.Y);
  1598. NewMax := Max(NewMax, Leaves[I].FCachedAABB.Max.Y);
  1599. end;
  1600. for I := 0 to FChildCount - 1 do
  1601. begin
  1602. NewMin := Min(NewMin, FChildren[I].AABB.Min.Y);
  1603. NewMax := Max(NewMax, FChildren[I].AABB.Max.Y);
  1604. end;
  1605. if (AABB.Max.Y <> NewMax) and (AABB.Min.Y <> NewMin) then
  1606. begin
  1607. FAABB.Max.Y := NewMax;
  1608. FAABB.Min.Y := NewMin;
  1609. // Make sure the parent updates it's bounds as well
  1610. if Assigned(Parent) then
  1611. Parent.ChildrenChanged; // }
  1612. end;
  1613. end;
  1614. procedure TSPQuadtreeNode.CreateChildren;
  1615. var
  1616. ChildNodeIndex: Integer;
  1617. AABB: TAABB;
  1618. X, Z: Integer;
  1619. begin
  1620. for ChildNodeIndex := 0 to 3 do
  1621. begin
  1622. FChildren[ChildNodeIndex] := FSectoredSpacePartition.CreateNewNode(Self);
  1623. // Y is ignored so it's set to a very large number
  1624. AABB.Min.Y := FAABB.Min.Y;
  1625. AABB.Max.Y := FAABB.Max.Y;
  1626. // Generate new extents based on parent's extents
  1627. if ((ChildNodeIndex and 1) > 0) then
  1628. X := 1
  1629. else
  1630. X := 0;
  1631. if ((ChildNodeIndex and 2) > 0) then
  1632. Z := 1
  1633. else
  1634. Z := 0;
  1635. if X = 0 then
  1636. begin
  1637. AABB.Min.X := FAABB.Min.X + (FAABB.Max.X + FAABB.Min.X) / 2 * X;
  1638. AABB.Max.X := (FAABB.Max.X + FAABB.Min.X) / 2 * (1 + X);
  1639. end
  1640. else
  1641. begin
  1642. AABB.Min.X := (FAABB.Max.X + FAABB.Min.X) / 2;
  1643. AABB.Max.X := FAABB.Max.X;
  1644. end;
  1645. if Z = 0 then
  1646. begin
  1647. AABB.Min.Z := FAABB.Min.Z;
  1648. AABB.Max.Z := (FAABB.Max.Z + FAABB.Min.Z) / 2;
  1649. end
  1650. else
  1651. begin
  1652. AABB.Min.Z := (FAABB.Max.Z + FAABB.Min.Z) / 2;
  1653. AABB.Max.Z := FAABB.Max.Z;
  1654. end;
  1655. FChildren[ChildNodeIndex].AABB := AABB;
  1656. end;
  1657. FChildCount := 4;
  1658. end;
  1659. function TSPQuadtreeNode.GetChildForAABB(const AABB: TAABB): TGLSectorNode;
  1660. var
  1661. Location: TAffineVector;
  1662. ChildNode: TGLSectorNode;
  1663. ChildNodeIndex: Integer;
  1664. begin
  1665. // Instead of looping through all children, we simply determine on which
  1666. // side of the center node the child is located
  1667. ChildNodeIndex := 0;
  1668. Location := AABB.Min;
  1669. // Fore / Back
  1670. if Location.X > FBSphere.Center.X then
  1671. ChildNodeIndex := ChildNodeIndex or 1;
  1672. // Left / Right
  1673. if Location.Z > FBSphere.Center.Z then
  1674. ChildNodeIndex := ChildNodeIndex or 2;
  1675. Assert(ChildNodeIndex < ChildCount, 'Bad ChildNodeIndex!');
  1676. ChildNode := FChildren[ChildNodeIndex];
  1677. if ChildNode.AABBFitsInNode(AABB) then
  1678. begin
  1679. Result := ChildNode;
  1680. Exit;
  1681. end;
  1682. Result := nil;
  1683. end;
  1684. //-----------------------------------
  1685. // TGLQuadtreeSpacePartition
  1686. //-----------------------------------
  1687. function TGLQuadtreeSpacePartition.CreateNewNode(AParent: TGLSectorNode): TGLSectorNode;
  1688. begin
  1689. Result := TSPQuadtreeNode.Create(Self, AParent);
  1690. end;
  1691. procedure TGLQuadtreeSpacePartition.SetSize(const Min, Max: TAffineVector);
  1692. var
  1693. AABB: TAABB;
  1694. begin
  1695. AABB.Min := Min;
  1696. AABB.Max := Max;
  1697. RebuildTree(AABB);
  1698. end;
  1699. procedure RenderAABB(var rci: TGLRenderContextInfo; const AABB: TAABB);
  1700. begin
  1701. RenderAABB(rci, AABB, 1, 0.8, 0.8, 0.8);
  1702. end;
  1703. procedure RenderAABB(var rci: TGLRenderContextInfo; const AABB: TAABB; w, r, g, b: single);
  1704. begin
  1705. gl.Color3f(r, g, b);
  1706. rci.GLStates.LineWidth := w;
  1707. gl.Begin_(GL_LINE_STRIP);
  1708. gl.Vertex3f(AABB.min.X, AABB.min.Y, AABB.min.Z);
  1709. gl.Vertex3f(AABB.min.X, AABB.max.Y, AABB.min.Z);
  1710. gl.Vertex3f(AABB.max.X, AABB.max.Y, AABB.min.Z);
  1711. gl.Vertex3f(AABB.max.X, AABB.min.Y, AABB.min.Z);
  1712. gl.Vertex3f(AABB.min.X, AABB.min.Y, AABB.min.Z);
  1713. gl.Vertex3f(AABB.min.X, AABB.min.Y, AABB.max.Z);
  1714. gl.Vertex3f(AABB.min.X, AABB.max.Y, AABB.max.Z);
  1715. gl.Vertex3f(AABB.max.X, AABB.max.Y, AABB.max.Z);
  1716. gl.Vertex3f(AABB.max.X, AABB.min.Y, AABB.max.Z);
  1717. gl.Vertex3f(AABB.min.X, AABB.min.Y, AABB.max.Z);
  1718. gl.End_;
  1719. gl.Begin_(GL_LINES);
  1720. gl.Vertex3f(AABB.min.X, AABB.max.Y, AABB.min.Z);
  1721. gl.Vertex3f(AABB.min.X, AABB.max.Y, AABB.max.Z);
  1722. gl.Vertex3f(AABB.max.X, AABB.max.Y, AABB.min.Z);
  1723. gl.Vertex3f(AABB.max.X, AABB.max.Y, AABB.max.Z);
  1724. gl.Vertex3f(AABB.max.X, AABB.min.Y, AABB.min.Z);
  1725. gl.Vertex3f(AABB.max.X, AABB.min.Y, AABB.max.Z);
  1726. gl.End_;
  1727. end;
  1728. procedure RenderSpatialPartitioning(var rci: TGLRenderContextInfo;
  1729. const Space: TGLSectoredSpacePartition);
  1730. procedure RenderSectorNode(Node: TGLSectorNode);
  1731. var
  1732. i: integer;
  1733. AABB: TAABB;
  1734. begin
  1735. if Node.NoChildren then
  1736. begin
  1737. AABB := Node.AABB;
  1738. if Node.RecursiveLeafCount > 0 then
  1739. RenderAABB(rci, AABB, 1, 0, 0, 0)
  1740. else
  1741. RenderAABB(rci, AABB, 1, 0.8, 0.8, 0.8) //}
  1742. end
  1743. else
  1744. begin
  1745. for i := 0 to Node.ChildCount - 1 do
  1746. RenderSectorNode(Node.Children[i]);
  1747. end;
  1748. end;
  1749. begin
  1750. rci.GLStates.Disable(stLighting);
  1751. RenderSectorNode(Space.RootNode);
  1752. end;
  1753. function ExtendedFrustumMakeFromSceneViewer(const AFrustum: TFrustum;
  1754. const AGLSceneViewer: TGLSceneViewer): TGLExtendedFrustum; //old version
  1755. begin
  1756. Assert(Assigned(AGLSceneViewer.Camera), 'GLSceneViewer must have camera specified!');
  1757. result := ExtendedFrustumMake(AFrustum,
  1758. AGLSceneViewer.Camera.NearPlane,
  1759. AGLSceneViewer.Camera.DepthOfView,
  1760. AGLSceneViewer.FieldOfView,
  1761. AGLSceneViewer.Camera.Position.AsAffineVector,
  1762. AGLSceneViewer.Camera.Direction.AsAffineVector);
  1763. end;
  1764. function ExtendedFrustumMakeFromSceneViewer(const AFrustum: TFrustum;
  1765. const vWidth, vHeight: integer; AGLCamera: TGLCamera): TGLExtendedFrustum; //changed version
  1766. var
  1767. buffov: single;
  1768. begin
  1769. if vWidth < vHeight then
  1770. buffov := AGLCamera.GetFieldOfView(vWidth)
  1771. else
  1772. buffov := AGLCamera.GetFieldOfView(vHeight);
  1773. result := ExtendedFrustumMake(AFrustum,
  1774. AGLCamera.NearPlane,
  1775. AGLCamera.DepthOfView,
  1776. buffov,
  1777. AGLCamera.Position.AsAffineVector,
  1778. AGLCamera.Direction.AsAffineVector);
  1779. end;
  1780. //------------------------------------
  1781. // TGLSceneObj
  1782. //------------------------------------
  1783. constructor TGLSceneObj.CreateObj(Owner: TGLSectoredSpacePartition; aObj: TGLBaseSceneObject);
  1784. begin
  1785. Obj := aObj;
  1786. inherited CreateOwned(Owner);
  1787. end;
  1788. destructor TGLSceneObj.Destroy;
  1789. begin
  1790. inherited;
  1791. end;
  1792. procedure TGLSceneObj.UpdateCachedAABBAndBSphere;
  1793. begin
  1794. FCachedAABB := Obj.AxisAlignedBoundingBox;
  1795. FCachedAABB.min := Obj.LocalToAbsolute(FCachedAABB.min);
  1796. FCachedAABB.max := Obj.LocalToAbsolute(FCachedAABB.max);
  1797. FCachedBSphere.Radius := Obj.BoundingSphereRadius;
  1798. FCachedBSphere.Center := AffineVectorMake(Obj.AbsolutePosition);
  1799. end;
  1800. end.