DEADSOFTWARE

grid now has fixed tile size
[d2df-sdl.git] / src / game / z_aabbtree.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE ../shared/a_modes.inc}
17 {.$DEFINE aabbtree_many_asserts}
18 {$DEFINE aabbtree_query_count}
19 {.$DEFINE aabbtree_use_floats}
20 unit z_aabbtree;
22 interface
24 uses
25 e_log, g_grid;
28 // ////////////////////////////////////////////////////////////////////////// //
29 type
30 {$IFDEF aabbtree_use_floats}TreeNumber = Single;{$ELSE}TreeNumber = Integer;{$ENDIF}
33 // ////////////////////////////////////////////////////////////////////////// //
34 type
35 Ray2D = record
36 public
37 origX, origY: Single;
38 dirX, dirY: Single;
40 function getOrigN (idx: Integer): Single; inline;
41 function getDirN (idx: Integer): Single; inline;
43 public
44 constructor Create (ax, ay: Single; aangle: Single); overload;
45 constructor Create (ax0, ay0, ax1, ay1: Single); overload;
46 constructor Create (constref aray: Ray2D); overload;
48 procedure copyFrom (constref aray: Ray2D); inline;
50 procedure normalizeDir (); inline;
52 procedure setXYAngle (ax, ay: Single; aangle: Single); inline;
53 procedure setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline;
55 procedure atTime (time: Single; out rx, ry: Integer); inline;
57 property orig[idx: Integer]: Single read getOrigN;
58 property dir[idx: Integer]: Single read getDirN;
59 end;
61 // ////////////////////////////////////////////////////////////////////////// //
62 type
63 AABB2D = record
64 public
65 minX, minY, maxX, maxY: TreeNumber;
67 private
68 function getvalid (): Boolean; inline;
69 function getcenterX (): TreeNumber; inline;
70 function getcenterY (): TreeNumber; inline;
71 function getextentX (): TreeNumber; inline;
72 function getextentY (): TreeNumber; inline;
73 function getMinN (idx: Integer): TreeNumber; inline;
74 function getMaxN (idx: Integer): TreeNumber; inline;
76 public
77 constructor Create (x0, y0, x1, y1: TreeNumber); overload;
78 constructor Create (constref aabb: AABB2D); overload;
79 constructor Create (constref aabb0, aabb1: AABB2D); overload;
81 constructor CreateWH (ax, ay, w, h: TreeNumber);
83 procedure copyFrom (constref aabb: AABB2D); inline;
84 procedure setDims (x0, y0, x1, y1: TreeNumber); inline;
86 procedure setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
88 function volume (): TreeNumber; inline;
90 procedure merge (constref aabb: AABB2D); inline;
92 // return true if the current AABB contains the AABB given in parameter
93 function contains (constref aabb: AABB2D): Boolean; inline; overload;
94 function contains (ax, ay: TreeNumber): Boolean; inline; overload;
96 // return true if the current AABB is overlapping with the AABB in parameter
97 // two AABBs overlap if they overlap in the two axes at the same time
98 function overlaps (constref aabb: AABB2D): Boolean; inline; overload;
100 // ray direction must be normalized
101 function intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
102 function intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload;
103 function intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload;
105 property valid: Boolean read getvalid;
106 property centerX: TreeNumber read getcenterX;
107 property centerY: TreeNumber read getcenterY;
108 property extentX: TreeNumber read getextentX;
109 property extentY: TreeNumber read getextentY;
111 property min[idx: Integer]: TreeNumber read getMinN;
112 property max[idx: Integer]: TreeNumber read getMaxN;
113 end;
116 // ////////////////////////////////////////////////////////////////////////// //
117 (* Dynamic AABB tree (bounding volume hierarchy)
118 * based on the code from ReactPhysics3D physics library, http://www.reactphysics3d.com
119 * Copyright (c) 2010-2016 Daniel Chappuis
121 * This software is provided 'as-is', without any express or implied warranty.
122 * In no event will the authors be held liable for any damages arising from the
123 * use of this software.
125 * Permission is granted to anyone to use this software for any purpose,
126 * including commercial applications, and to alter it and redistribute it
127 * freely, subject to the following restrictions:
129 * 1. The origin of this software must not be misrepresented; you must not claim
130 * that you wrote the original software. If you use this software in a
131 * product, an acknowledgment in the product documentation would be
132 * appreciated but is not required.
134 * 2. Altered source versions must be plainly marked as such, and must not be
135 * misrepresented as being the original software.
137 * 3. This notice may not be removed or altered from any source distribution.
138 *)
139 // ////////////////////////////////////////////////////////////////////////// //
140 (*
141 * This class implements a dynamic AABB tree that is used for broad-phase
142 * collision detection. This data structure is inspired by Nathanael Presson's
143 * dynamic tree implementation in BulletPhysics. The following implementation is
144 * based on the one from Erin Catto in Box2D as described in the book
145 * "Introduction to Game Physics with Box2D" by Ian Parberry.
146 *)
147 // ////////////////////////////////////////////////////////////////////////// //
148 // Dynamic AABB Tree: can be used to speed up broad phase in various engines
149 type
150 generic TDynAABBTreeBase<ITP> = class(TObject)
151 public
152 type TTreeFlesh = ITP;
154 private
155 type
156 PTreeNode = ^TTreeNode;
157 TTreeNode = record
158 public
159 const NullTreeNode = -1;
160 const Left = 0;
161 const Right = 1;
162 public
163 // a node is either in the tree (has a parent) or in the free nodes list (has a next node)
164 parentId: Integer;
165 //nextNodeId: Integer;
166 // a node is either a leaf (has data) or is an internal node (has children)
167 children: array [0..1] of Integer; // left and right child of the node (children[0] = left child)
168 // height of the node in the tree (-1 for free nodes)
169 height: SmallInt;
170 // fat axis aligned bounding box (AABB) corresponding to the node
171 aabb: AABB2D;
172 //TODO: `flesh` can be united with `children`
173 flesh: TTreeFlesh;
174 fleshX, fleshY: TreeNumber;
175 tag: Integer; // just a user-defined tag
176 public
177 // return true if the node is a leaf of the tree
178 procedure clear (); inline;
179 function leaf (): Boolean; inline;
180 function isfree (): Boolean; inline;
181 property nextNodeId: Integer read parentId write parentId;
182 //property flesh: Integer read children[0] write children[0];
184 procedure dumpToLog ();
185 end;
187 TVisitCheckerCB = function (node: PTreeNode): Boolean of object;
188 //TVisitVisitorCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested;
190 const ModeNoChecks = 0;
191 const ModeAABB = 1;
192 const ModePoint = 2;
194 public
195 // return `true` to stop
196 type TForEachLeafCB = function (abody: TTreeFlesh; constref aabb: AABB2D): Boolean is nested; // WARNING! don't modify AABB here!
198 public
199 // in the broad-phase collision detection (dynamic AABB tree), the AABBs are
200 // also inflated in direction of the linear motion of the body by mutliplying the
201 // followin constant with the linear velocity and the elapsed time between two frames
202 {$IFDEF aabbtree_use_floats}
203 const LinearMotionGapMultiplier = 1.7;
204 {$ELSE}
205 const LinearMotionGapMultiplier = 17; // *10
206 {$ENDIF}
208 public
209 // called when a overlapping node has been found during the call to forEachAABBOverlap()
210 // return `true` to stop
211 type TQueryOverlapCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested;
212 type TSegQueryCallback = function (abody: TTreeFlesh; var ray: Ray2D): Single is nested; // return hit time
214 PSegmentQueryResult = ^TSegmentQueryResult;
215 TSegmentQueryResult = record
216 time: Single; // <0: nothing was hit
217 flesh: TTreeFlesh;
219 constructor Create (fuckyoufpc: Boolean);
220 procedure reset (); inline;
221 function valid (): Boolean; inline;
222 end;
224 private
225 mNodes: array of TTreeNode; // nodes of the tree
226 mRootNodeId: Integer; // id of the root node of the tree
227 mFreeNodeId: Integer; // id of the first node of the list of free (allocated) nodes in the tree that we can use
228 mAllocCount: Integer; // number of allocated nodes in the tree
229 mNodeCount: Integer; // number of nodes in the tree
231 // extra AABB Gap used to allow the collision shape to move a little bit
232 // without triggering a large modification of the tree which can be costly
233 mExtraGap: TreeNumber;
235 chkAABB: AABB2D; // for checkers
236 qSRes: PSegmentQueryResult; // for queries
237 // for segment query
238 curax, curay: Single;
239 curbx, curby: Single;
240 dirx, diry: Single;
241 traceRay: Ray2D;
242 sqcb: TSegQueryCallback;
243 vstack: array of Integer; // for `visit()`
244 vstused: Integer; // to support recursive queries
246 function checkerAABB (node: PTreeNode): Boolean;
247 function checkerPoint (node: PTreeNode): Boolean;
248 function checkerRay (node: PTreeNode): Boolean;
249 function visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean;
251 type TQueryOverlapDg = function (abody: TTreeFlesh; atag: Integer): Boolean of object;
253 private
254 function allocateNode (): Integer;
255 procedure releaseNode (nodeId: Integer);
256 procedure insertLeafNode (nodeId: Integer);
257 procedure removeLeafNode (nodeId: Integer);
258 function balanceSubTreeAtNode (nodeId: Integer): Integer;
259 function computeHeight (nodeId: Integer): Integer;
260 function insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
261 procedure setup ();
262 function visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
264 function forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean;
266 public
267 {$IFDEF aabbtree_query_count}
268 mNodesVisited, mNodesDeepVisited: Integer;
269 {$ENDIF}
271 public
272 constructor Create (extraAABBGap: TreeNumber=0);
273 destructor Destroy (); override;
275 // clear all the nodes and reset the tree
276 procedure reset ();
278 function forEachLeaf (dg: TForEachLeafCB): Boolean; // WARNING! don't modify AABB/tree here!
279 procedure getRootAABB (out aabb: AABB2D);
281 function isValidId (id: Integer): Boolean; inline;
282 function getNodeObjectId (nodeid: Integer): TTreeFlesh; inline;
283 procedure getNodeFatAABB (out aabb: AABB2D; nodeid: Integer); inline;
285 // returns `false` if nodeid is not leaf
286 function getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
288 // return `false` for invalid flesh
289 function getFleshAABB (out aabb: AABB2D; flesh: TTreeFlesh; tag: Integer): Boolean; virtual; abstract;
291 // insert an object into the tree
292 // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error
293 // AABB for static object will not be "fat" (simple optimization)
294 // WARNING! inserting the same object several times *WILL* break everything!
295 function insertObject (flesh: TTreeFlesh; tag: Integer=-1; staticObject: Boolean=false): Integer;
297 // remove an object from the tree
298 // WARNING: ids of removed objects can be reused on later insertions!
299 procedure removeObject (nodeId: Integer);
301 (** update the dynamic tree after an object has moved.
303 * if the new AABB of the object that has moved is still inside its fat AABB, then nothing is done.
304 * otherwise, the corresponding node is removed and reinserted into the tree.
305 * the method returns true if the object has been reinserted into the tree.
306 * the `dispX` and `dispY` parameters are the linear velocity of the AABB multiplied by the elapsed time between two frames.
307 * if the `forceReinsert` parameter is `true`, we force a removal and reinsertion of the node
308 * (this can be useful if the shape AABB has become much smaller than the previous one for instance).
310 * note that you should call this method if body's AABB was modified, even if the body wasn't moved.
312 * if `forceReinsert` = `true` and both `dispX` and `dispY` are zeroes, convert object to "static" (don't extrude AABB).
314 * return `true` if the tree was modified.
315 *)
316 function updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload;
317 function updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload;
319 function aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
320 function pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
321 function segmentQuery (out qr: TSegmentQueryResult; const ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
323 function computeTreeHeight (): Integer; // compute the height of the tree
325 property extraGap: TreeNumber read mExtraGap write mExtraGap;
326 property nodeCount: Integer read mNodeCount;
327 property nodeAlloced: Integer read mAllocCount;
328 {$IFDEF aabbtree_query_count}
329 property nodesVisited: Integer read mNodesVisited;
330 property nodesDeepVisited: Integer read mNodesDeepVisited;
331 {$ELSE}
332 const nodesVisited = 0;
333 const nodesDeepVisited = 0;
334 {$ENDIF}
335 end;
338 function dtMinI (a, b: Integer): Integer; inline;
339 function dtMaxI (a, b: Integer): Integer; inline;
341 function dtMinF (a, b: TreeNumber): TreeNumber; inline;
342 function dtMaxF (a, b: TreeNumber): TreeNumber; inline;
344 function minSingle (a, b: Single): Single; inline;
345 function maxSingle (a, b: Single): Single; inline;
348 implementation
350 uses
351 SysUtils;
354 // ////////////////////////////////////////////////////////////////////////// //
355 function dtMinI (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
356 function dtMaxI (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
358 function dtMinF (a, b: TreeNumber): TreeNumber; inline; begin if (a < b) then result := a else result := b; end;
359 function dtMaxF (a, b: TreeNumber): TreeNumber; inline; begin if (a > b) then result := a else result := b; end;
361 function minSingle (a, b: Single): Single; inline; begin if (a < b) then result := a else result := b; end;
362 function maxSingle (a, b: Single): Single; inline; begin if (a > b) then result := a else result := b; end;
365 // ////////////////////////////////////////////////////////////////////////// //
366 constructor Ray2D.Create (ax, ay: Single; aangle: Single); begin setXYAngle(ax, ay, aangle); end;
367 constructor Ray2D.Create (ax0, ay0, ax1, ay1: Single); begin setX0Y0X1Y1(ax0, ay0, ax1, ay1); end;
368 constructor Ray2D.Create (constref aray: Ray2D); overload; begin copyFrom(aray); end;
371 function Ray2D.getOrigN (idx: Integer): Single; inline; begin if (idx = 0) then result := origX else if (idx = 1) then result := origY else result := 0; end;
372 function Ray2D.getDirN (idx: Integer): Single; inline; begin if (idx = 0) then result := dirX else if (idx = 1) then result := dirY else result := 0; end;
375 procedure Ray2D.copyFrom (constref aray: Ray2D); inline;
376 begin
377 origX := aray.origX;
378 origY := aray.origY;
379 dirX := aray.dirX;
380 dirY := aray.dirY;
381 end;
383 procedure Ray2D.normalizeDir (); inline;
384 var
385 invlen: Single;
386 begin
387 invlen := 1.0/sqrt(dirX*dirX+dirY*dirY);
388 dirX *= invlen;
389 dirY *= invlen;
390 end;
392 procedure Ray2D.setXYAngle (ax, ay: Single; aangle: Single); inline;
393 begin
394 origX := ax;
395 origY := ay;
396 dirX := cos(aangle);
397 dirY := sin(aangle);
398 end;
400 procedure Ray2D.setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline;
401 begin
402 origX := ax0;
403 origY := ay0;
404 dirX := ax1-ax0;
405 dirY := ay1-ay0;
406 normalizeDir();
407 end;
410 procedure Ray2D.atTime (time: Single; out rx, ry: Integer); inline;
411 begin
412 rx := round(origX+dirX*time);
413 ry := round(origY+dirY*time);
414 end;
417 // ////////////////////////////////////////////////////////////////////////// //
418 constructor AABB2D.Create (x0, y0, x1, y1: TreeNumber); overload;
419 begin
420 setDims(x0, y0, x1, y1);
421 end;
423 constructor AABB2D.Create (constref aabb: AABB2D); overload;
424 begin
425 copyFrom(aabb);
426 end;
428 constructor AABB2D.Create (constref aabb0, aabb1: AABB2D); overload;
429 begin
430 setMergeTwo(aabb0, aabb1);
431 end;
433 constructor AABB2D.CreateWH (ax, ay, w, h: TreeNumber);
434 begin
435 minX := ax;
436 minY := ay;
437 maxX := ax+w-1;
438 maxY := ay+h-1;
439 end;
441 function AABB2D.getvalid (): Boolean; inline; begin result := (minX <= maxX) and (minY <= maxY); end;
443 {$IFDEF aabbtree_use_floats}
444 function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX)/2.0; end;
445 function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY)/2.0; end;
446 {$ELSE}
447 function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX) div 2; end;
448 function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY) div 2; end;
449 {$ENDIF}
450 function AABB2D.getextentX (): TreeNumber; inline; begin result := maxX-minX+1; end;
451 function AABB2D.getextentY (): TreeNumber; inline; begin result := maxY-minY+1; end;
453 function AABB2D.getMinN (idx: Integer): TreeNumber; inline; begin if (idx = 0) then result := minX else if (idx = 1) then result := minY else result := 0; end;
454 function AABB2D.getMaxN (idx: Integer): TreeNumber; inline; begin if (idx = 0) then result := maxX else if (idx = 1) then result := maxY else result := 0; end;
456 procedure AABB2D.copyFrom (constref aabb: AABB2D); inline;
457 begin
458 minX := aabb.minX;
459 minY := aabb.minY;
460 maxX := aabb.maxX;
461 maxY := aabb.maxY;
462 {$IF DEFINED(D2F_DEBUG)}
463 if not valid then raise Exception.Create('copyFrom: result is fucked');
464 {$ENDIF}
465 end;
468 procedure AABB2D.setDims (x0, y0, x1, y1: TreeNumber); inline;
469 begin
470 minX := dtMinF(x0, x1);
471 minY := dtMinF(y0, y1);
472 maxX := dtMaxF(x0, x1);
473 maxY := dtMaxF(y0, y1);
474 {$IF DEFINED(D2F_DEBUG)}
475 if not valid then raise Exception.Create('setDims: result is fucked');
476 {$ENDIF}
477 end;
480 procedure AABB2D.setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
481 begin
482 {$IF DEFINED(D2F_DEBUG)}
483 if not aabb0.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked');
484 if not aabb1.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked');
485 {$ENDIF}
486 minX := dtMinF(aabb0.minX, aabb1.minX);
487 minY := dtMinF(aabb0.minY, aabb1.minY);
488 maxX := dtMaxF(aabb0.maxX, aabb1.maxX);
489 maxY := dtMaxF(aabb0.maxY, aabb1.maxY);
490 {$IF DEFINED(D2F_DEBUG)}
491 if not valid then raise Exception.Create('setMergeTwo: result is fucked');
492 {$ENDIF}
493 end;
496 function AABB2D.volume (): TreeNumber; inline;
497 begin
498 result := (maxX-minX+1)*(maxY-minY+1);
499 end;
502 procedure AABB2D.merge (constref aabb: AABB2D); inline;
503 begin
504 {$IF DEFINED(D2F_DEBUG)}
505 if not aabb.valid then raise Exception.Create('merge: aabb is fucked');
506 {$ENDIF}
507 minX := dtMinF(minX, aabb.minX);
508 minY := dtMinF(minY, aabb.minY);
509 maxX := dtMaxF(maxX, aabb.maxX);
510 maxY := dtMaxF(maxY, aabb.maxY);
511 {$IF DEFINED(D2F_DEBUG)}
512 if not valid then raise Exception.Create('setMergeTwo: result is fucked');
513 {$ENDIF}
514 end;
517 function AABB2D.contains (constref aabb: AABB2D): Boolean; inline; overload;
518 begin
519 result :=
520 (aabb.minX >= minX) and (aabb.minY >= minY) and
521 (aabb.maxX <= maxX) and (aabb.maxY <= maxY);
522 end;
525 function AABB2D.contains (ax, ay: TreeNumber): Boolean; inline; overload;
526 begin
527 result := (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY);
528 end;
531 function AABB2D.overlaps (constref aabb: AABB2D): Boolean; inline; overload;
532 begin
533 result := false;
534 // exit with no intersection if found separated along any axis
535 if (maxX < aabb.minX) or (minX > aabb.maxX) then exit;
536 if (maxY < aabb.minY) or (minY > aabb.maxY) then exit;
537 result := true;
538 end;
541 // something to consider here is that 0 * inf =nan which occurs when the ray starts exactly on the edge of a box
542 // https://tavianator.com/fast-branchless-raybounding-box-intersections-part-2-nans/
544 function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
545 var
546 dinv, t1, t2, tmp: Single;
547 tmin, tmax: Single;
548 begin
549 // ok with coplanars
550 tmin := -1.0e100;
551 tmax := 1.0e100;
552 // do X
553 if (ray.dirX <> 0.0) then
554 begin
555 dinv := 1.0/ray.dirX;
556 t1 := (minX-ray.origX)*dinv;
557 t2 := (maxX-ray.origX)*dinv;
558 if (t1 < t2) then tmin := t1 else tmin := t2;
559 if (t1 > t2) then tmax := t1 else tmax := t2;
560 end;
561 // do Y
562 if (ray.dirY <> 0.0) then
563 begin
564 dinv := 1.0/ray.dirY;
565 t1 := (minY-ray.origY)*dinv;
566 t2 := (maxY-ray.origY)*dinv;
567 // tmin
568 if (t1 < t2) then tmp := t1 else tmp := t2; // min(t1, t2)
569 if (tmax < tmp) then tmp := tmax; // min(tmax, tmp)
570 if (tmin > tmp) then tmin := tmp; // max(tmin, tmp)
571 // tmax
572 if (t1 > t2) then tmp := t1 else tmp := t2; // max(t1, t2)
573 if (tmin > tmp) then tmp := tmin; // max(tmin, tmp)
574 if (tmax < tmp) then tmax := tmp; // min(tmax, tmp)
575 end;
576 if (tmin > 0) then tmp := tmin else tmp := 0;
577 if (tmax > tmp) then
578 begin
579 if (tmino <> nil) then tmino^ := tmin;
580 if (tmaxo <> nil) then tmaxo^ := tmax;
581 result := true;
582 end
583 else
584 begin
585 result := false;
586 end;
587 end;
591 function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
592 var
593 tmin, tmax, t1, t2, invd: Single;
594 i: Integer;
595 begin
596 tmin := -1.0e100;
597 tmax := 1.0e100;
598 for i := 0 to 1 do
599 begin
600 if (ray.dir[i] <> 0.0) then
601 begin
602 //t1 := (self.min[i]-ray.orig[i])/ray.dir[i];
603 //t2 := (self.max[i]-ray.orig[i])/ray.dir[i];
604 invd := 1.0/ray.dir[i];
605 t1 := (self.min[i]-ray.orig[i])*invd;
606 t2 := (self.max[i]-ray.orig[i])*invd;
607 tmin := maxSingle(tmin, minSingle(t1, t2));
608 tmax := minSingle(tmax, maxSingle(t1, t2));
609 end
610 else if (ray.orig[i] <= self.min[i]) or (ray.orig[i] >= self.max[i]) then
611 begin
612 result := false;
613 exit;
614 end;
615 end;
617 result := (tmax > tmin) and (tmax > 0.0);
618 if result then
619 begin
620 if (tmino <> nil) then tmino^ := tmin;
621 if (tmaxo <> nil) then tmaxo^ := tmin;
622 end;
623 end;
626 function AABB2D.intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload;
627 var
628 tmin: Single;
629 ray: Ray2D;
630 begin
631 result := true;
632 if (tmino <> nil) then tmino^ := 0.0;
633 // it may be faster to first check if start or end point is inside AABB (this is sometimes enough for dyntree)
634 if (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY) then exit; // a
635 if (bx >= minX) and (by >= minY) and (bx <= maxX) and (by <= maxY) then exit; // b
636 // nope, do it hard way
637 ray := Ray2D.Create(ax, ay, bx, by);
638 if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := tmin; result := false; exit; end;
639 if (tmino <> nil) then tmino^ := tmin;
640 if (tmin < 0) then exit; // inside, just in case
641 bx -= ax;
642 by -= ay;
643 result := (tmin*tmin <= bx*bx+by*by);
644 end;
647 function AABB2D.intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload;
648 var
649 tmin: Single;
650 begin
651 result := true;
652 if (ray.origX >= minX) and (ray.origY >= minY) and (ray.origX <= maxX) and (ray.origY <= maxY) then
653 begin
654 if (tmino <> nil) then tmino^ := 0.0;
655 exit;
656 end;
657 if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := -1.0; result := false; exit; end;
658 if (tmin < 0) then tmin := 0; // inside
659 if (tmino <> nil) then tmino^ := tmin;
660 result := (tmin <= maxtime);
661 end;
664 // ////////////////////////////////////////////////////////////////////////// //
665 constructor TDynAABBTreeBase.TSegmentQueryResult.Create (fuckyoufpc: Boolean); begin time := -1; flesh := Default(ITP); end;
666 procedure TDynAABBTreeBase.TSegmentQueryResult.reset (); inline; begin time := -1; flesh := Default(ITP); end;
667 function TDynAABBTreeBase.TSegmentQueryResult.valid (): Boolean; inline; begin result := (time >= 0) and (flesh <> Default(ITP)); end;
670 // ////////////////////////////////////////////////////////////////////////// //
671 function TDynAABBTreeBase.TTreeNode.leaf (): Boolean; inline; begin result := (height = 0); end;
672 function TDynAABBTreeBase.TTreeNode.isfree (): Boolean; inline; begin result := (height = -1); end;
674 procedure TDynAABBTreeBase.TTreeNode.clear (); inline;
675 begin
676 parentId := 0;
677 children[0] := 0;
678 children[1] := 0;
679 flesh := Default(ITP);
680 tag := 0;
681 height := 0;
682 aabb.minX := 0;
683 aabb.minY := 0;
684 aabb.maxX := 0;
685 aabb.maxY := 0;
686 end;
688 procedure TDynAABBTreeBase.TTreeNode.dumpToLog ();
689 begin
690 e_WriteLog(Format('NODE: parentId=%d; children=[%d,%d]; height=%d; tag=%d; fleshX=%d; fleshY=%d; aabb=(%d,%d)-(%d,%d)',
691 [parentId, children[0], children[1], Integer(height), tag, fleshX, fleshY, aabb.minX, aabb.minY, aabb.maxX, aabb.maxY]),
692 MSG_NOTIFY);
693 end;
696 // ////////////////////////////////////////////////////////////////////////// //
697 // allocate and return a node to use in the tree
698 function TDynAABBTreeBase.allocateNode (): Integer;
699 var
700 i, newsz, freeNodeId: Integer;
701 node: PTreeNode;
702 begin
703 // if there is no more allocated node to use
704 if (mFreeNodeId = TTreeNode.NullTreeNode) then
705 begin
706 {$IFDEF aabbtree_many_asserts}assert(mNodeCount = mAllocCount);{$ENDIF}
707 // allocate more nodes in the tree
708 if (mAllocCount <= 16384) then newsz := mAllocCount*2 else newsz := mAllocCount+16384;
709 SetLength(mNodes, newsz);
710 mAllocCount := newsz;
711 // initialize the allocated nodes
712 for i := mNodeCount to mAllocCount-1 do
713 begin
714 mNodes[i].nextNodeId := i+1;
715 mNodes[i].height := -1;
716 end;
717 mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode;
718 mFreeNodeId := mNodeCount;
719 end;
720 // get the next free node
721 freeNodeId := mFreeNodeId;
722 {$IFDEF aabbtree_many_asserts}assert(freeNodeId < mAllocCount);{$ENDIF}
723 node := @mNodes[freeNodeId];
724 mFreeNodeId := node.nextNodeId;
725 node.clear();
726 node.parentId := TTreeNode.NullTreeNode;
727 node.height := 0;
728 Inc(mNodeCount);
729 result := freeNodeId;
731 //e_WriteLog(Format('tree: allocated node #%d', [result]), MSG_NOTIFY);
732 end;
735 // release a node
736 procedure TDynAABBTreeBase.releaseNode (nodeId: Integer);
737 begin
738 {$IFDEF aabbtree_many_asserts}assert(mNodeCount > 0);{$ENDIF}
739 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
740 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].height >= 0);{$ENDIF}
741 mNodes[nodeId].nextNodeId := mFreeNodeId;
742 mNodes[nodeId].height := -1;
743 mNodes[nodeId].flesh := Default(ITP);
744 mFreeNodeId := nodeId;
745 Dec(mNodeCount);
747 //e_WriteLog(Format('tree: released node #%d', [nodeId]), MSG_NOTIFY);
748 end;
751 // insert a leaf node in the tree
752 // the process of inserting a new leaf node in the dynamic tree is described in the book "Introduction to Game Physics with Box2D" by Ian Parberry
753 procedure TDynAABBTreeBase.insertLeafNode (nodeId: Integer);
754 var
755 newNodeAABB, mergedAABBs, currentAndLeftAABB, currentAndRightAABB: AABB2D;
756 currentNodeId: Integer;
757 leftChild, rightChild, siblingNode: Integer;
758 oldParentNode, newParentNode: Integer;
759 volumeAABB, mergedVolume: TreeNumber;
760 costS, costI, costLeft, costRight: TreeNumber;
761 begin
762 // if the tree is empty
763 if (mRootNodeId = TTreeNode.NullTreeNode) then
764 begin
765 mRootNodeId := nodeId;
766 mNodes[mRootNodeId].parentId := TTreeNode.NullTreeNode;
767 exit;
768 end;
770 {$IFDEF aabbtree_many_asserts}assert(mRootNodeId <> TTreeNode.NullTreeNode);{$ENDIF}
772 // find the best sibling node for the new node
773 newNodeAABB := AABB2D.Create(mNodes[nodeId].aabb);
774 currentNodeId := mRootNodeId;
775 while not mNodes[currentNodeId].leaf do
776 begin
777 leftChild := mNodes[currentNodeId].children[TTreeNode.Left];
778 rightChild := mNodes[currentNodeId].children[TTreeNode.Right];
780 // compute the merged AABB
781 volumeAABB := mNodes[currentNodeId].aabb.volume;
782 mergedAABBs := AABB2D.Create(mNodes[currentNodeId].aabb, newNodeAABB);
783 mergedVolume := mergedAABBs.volume;
785 // compute the cost of making the current node the sibling of the new node
786 costS := 2*mergedVolume;
788 // compute the minimum cost of pushing the new node further down the tree (inheritance cost)
789 costI := 2*(mergedVolume-volumeAABB);
791 // compute the cost of descending into the left child
792 currentAndLeftAABB := AABB2D.Create(newNodeAABB, mNodes[leftChild].aabb);
793 costLeft := currentAndLeftAABB.volume+costI;
794 if not mNodes[leftChild].leaf then costLeft -= mNodes[leftChild].aabb.volume;
796 // compute the cost of descending into the right child
797 currentAndRightAABB := AABB2D.Create(newNodeAABB, mNodes[rightChild].aabb);
798 costRight := currentAndRightAABB.volume+costI;
799 if not mNodes[rightChild].leaf then costRight -= mNodes[rightChild].aabb.volume;
801 // if the cost of making the current node a sibling of the new node is smaller than the cost of going down into the left or right child
802 if (costS < costLeft) and (costS < costRight) then break;
804 // it is cheaper to go down into a child of the current node, choose the best child
805 //currentNodeId = (costLeft < costRight ? leftChild : rightChild);
806 if (costLeft < costRight) then currentNodeId := leftChild else currentNodeId := rightChild;
807 end;
809 siblingNode := currentNodeId;
811 // create a new parent for the new node and the sibling node
812 oldParentNode := mNodes[siblingNode].parentId;
813 newParentNode := allocateNode();
814 mNodes[newParentNode].parentId := oldParentNode;
815 mNodes[newParentNode].aabb.setMergeTwo(mNodes[siblingNode].aabb, newNodeAABB);
816 mNodes[newParentNode].height := mNodes[siblingNode].height+1;
817 {$IFDEF aabbtree_many_asserts}assert(mNodes[newParentNode].height > 0);{$ENDIF}
819 // if the sibling node was not the root node
820 if (oldParentNode <> TTreeNode.NullTreeNode) then
821 begin
822 {$IFDEF aabbtree_many_asserts}assert(not mNodes[oldParentNode].leaf);{$ENDIF}
823 if (mNodes[oldParentNode].children[TTreeNode.Left] = siblingNode) then
824 begin
825 mNodes[oldParentNode].children[TTreeNode.Left] := newParentNode;
826 end
827 else
828 begin
829 mNodes[oldParentNode].children[TTreeNode.Right] := newParentNode;
830 end;
831 mNodes[newParentNode].children[TTreeNode.Left] := siblingNode;
832 mNodes[newParentNode].children[TTreeNode.Right] := nodeId;
833 mNodes[siblingNode].parentId := newParentNode;
834 mNodes[nodeId].parentId := newParentNode;
835 end
836 else
837 begin
838 // if the sibling node was the root node
839 mNodes[newParentNode].children[TTreeNode.Left] := siblingNode;
840 mNodes[newParentNode].children[TTreeNode.Right] := nodeId;
841 mNodes[siblingNode].parentId := newParentNode;
842 mNodes[nodeId].parentId := newParentNode;
843 mRootNodeId := newParentNode;
844 end;
846 // move up in the tree to change the AABBs that have changed
847 currentNodeId := mNodes[nodeId].parentId;
848 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
849 while (currentNodeId <> TTreeNode.NullTreeNode) do
850 begin
851 // balance the sub-tree of the current node if it is not balanced
852 currentNodeId := balanceSubTreeAtNode(currentNodeId);
853 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
855 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
856 leftChild := mNodes[currentNodeId].children[TTreeNode.Left];
857 rightChild := mNodes[currentNodeId].children[TTreeNode.Right];
858 {$IFDEF aabbtree_many_asserts}assert(leftChild <> TTreeNode.NullTreeNode);{$ENDIF}
859 {$IFDEF aabbtree_many_asserts}assert(rightChild <> TTreeNode.NullTreeNode);{$ENDIF}
861 // recompute the height of the node in the tree
862 mNodes[currentNodeId].height := dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height)+1;
863 {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF}
865 // recompute the AABB of the node
866 mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChild].aabb, mNodes[rightChild].aabb);
868 currentNodeId := mNodes[currentNodeId].parentId;
869 end;
871 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
872 end;
875 // remove a leaf node from the tree
876 procedure TDynAABBTreeBase.removeLeafNode (nodeId: Integer);
877 var
878 currentNodeId, parentNodeId, grandParentNodeId, siblingNodeId: Integer;
879 leftChildId, rightChildId: Integer;
880 begin
881 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
882 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
884 // if we are removing the root node (root node is a leaf in this case)
885 if (mRootNodeId = nodeId) then begin mRootNodeId := TTreeNode.NullTreeNode; exit; end;
887 parentNodeId := mNodes[nodeId].parentId;
888 grandParentNodeId := mNodes[parentNodeId].parentId;
890 if (mNodes[parentNodeId].children[TTreeNode.Left] = nodeId) then
891 begin
892 siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Right];
893 end
894 else
895 begin
896 siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Left];
897 end;
899 // if the parent of the node to remove is not the root node
900 if (grandParentNodeId <> TTreeNode.NullTreeNode) then
901 begin
902 // destroy the parent node
903 if (mNodes[grandParentNodeId].children[TTreeNode.Left] = parentNodeId) then
904 begin
905 mNodes[grandParentNodeId].children[TTreeNode.Left] := siblingNodeId;
906 end
907 else
908 begin
909 {$IFDEF aabbtree_many_asserts}assert(mNodes[grandParentNodeId].children[TTreeNode.Right] = parentNodeId);{$ENDIF}
910 mNodes[grandParentNodeId].children[TTreeNode.Right] := siblingNodeId;
911 end;
912 mNodes[siblingNodeId].parentId := grandParentNodeId;
913 releaseNode(parentNodeId);
915 // now, we need to recompute the AABBs of the node on the path back to the root and make sure that the tree is still balanced
916 currentNodeId := grandParentNodeId;
917 while (currentNodeId <> TTreeNode.NullTreeNode) do
918 begin
919 // balance the current sub-tree if necessary
920 currentNodeId := balanceSubTreeAtNode(currentNodeId);
922 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
924 // get the two children of the current node
925 leftChildId := mNodes[currentNodeId].children[TTreeNode.Left];
926 rightChildId := mNodes[currentNodeId].children[TTreeNode.Right];
928 // recompute the AABB and the height of the current node
929 mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChildId].aabb, mNodes[rightChildId].aabb);
930 mNodes[currentNodeId].height := dtMaxI(mNodes[leftChildId].height, mNodes[rightChildId].height)+1;
931 {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF}
933 currentNodeId := mNodes[currentNodeId].parentId;
934 end;
935 end
936 else
937 begin
938 // if the parent of the node to remove is the root node, the sibling node becomes the new root node
939 mRootNodeId := siblingNodeId;
940 mNodes[siblingNodeId].parentId := TTreeNode.NullTreeNode;
941 releaseNode(parentNodeId);
942 end;
943 end;
946 // balance the sub-tree of a given node using left or right rotations
947 // the rotation schemes are described in the book "Introduction to Game Physics with Box2D" by Ian Parberry
948 // this method returns the new root node id
949 function TDynAABBTreeBase.balanceSubTreeAtNode (nodeId: Integer): Integer;
950 var
951 nodeA, nodeB, nodeC, nodeF, nodeG: PTreeNode;
952 nodeBId, nodeCId, nodeFId, nodeGId: Integer;
953 balanceFactor: Integer;
954 begin
955 {$IFDEF aabbtree_many_asserts}assert(nodeId <> TTreeNode.NullTreeNode);{$ENDIF}
957 nodeA := @mNodes[nodeId];
959 // if the node is a leaf or the height of A's sub-tree is less than 2
960 if (nodeA.leaf) or (nodeA.height < 2) then begin result := nodeId; exit; end; // do not perform any rotation
962 // get the two children nodes
963 nodeBId := nodeA.children[TTreeNode.Left];
964 nodeCId := nodeA.children[TTreeNode.Right];
965 {$IFDEF aabbtree_many_asserts}assert((nodeBId >= 0) and (nodeBId < mAllocCount));{$ENDIF}
966 {$IFDEF aabbtree_many_asserts}assert((nodeCId >= 0) and (nodeCId < mAllocCount));{$ENDIF}
967 nodeB := @mNodes[nodeBId];
968 nodeC := @mNodes[nodeCId];
970 // compute the factor of the left and right sub-trees
971 balanceFactor := nodeC.height-nodeB.height;
973 // if the right node C is 2 higher than left node B
974 if (balanceFactor > 1) then
975 begin
976 {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF}
978 nodeFId := nodeC.children[TTreeNode.Left];
979 nodeGId := nodeC.children[TTreeNode.Right];
980 {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF}
981 {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF}
982 nodeF := @mNodes[nodeFId];
983 nodeG := @mNodes[nodeGId];
985 nodeC.children[TTreeNode.Left] := nodeId;
986 nodeC.parentId := nodeA.parentId;
987 nodeA.parentId := nodeCId;
989 if (nodeC.parentId <> TTreeNode.NullTreeNode) then
990 begin
991 if (mNodes[nodeC.parentId].children[TTreeNode.Left] = nodeId) then
992 begin
993 mNodes[nodeC.parentId].children[TTreeNode.Left] := nodeCId;
994 end
995 else
996 begin
997 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeC.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF}
998 mNodes[nodeC.parentId].children[TTreeNode.Right] := nodeCId;
999 end;
1000 end
1001 else
1002 begin
1003 mRootNodeId := nodeCId;
1004 end;
1006 {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF}
1007 {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF}
1009 // if the right node C was higher than left node B because of the F node
1010 if (nodeF.height > nodeG.height) then
1011 begin
1012 nodeC.children[TTreeNode.Right] := nodeFId;
1013 nodeA.children[TTreeNode.Right] := nodeGId;
1014 nodeG.parentId := nodeId;
1016 // recompute the AABB of node A and C
1017 nodeA.aabb.setMergeTwo(nodeB.aabb, nodeG.aabb);
1018 nodeC.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb);
1020 // recompute the height of node A and C
1021 nodeA.height := dtMaxI(nodeB.height, nodeG.height)+1;
1022 nodeC.height := dtMaxI(nodeA.height, nodeF.height)+1;
1023 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1024 {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF}
1025 end
1026 else
1027 begin
1028 // if the right node C was higher than left node B because of node G
1029 nodeC.children[TTreeNode.Right] := nodeGId;
1030 nodeA.children[TTreeNode.Right] := nodeFId;
1031 nodeF.parentId := nodeId;
1033 // recompute the AABB of node A and C
1034 nodeA.aabb.setMergeTwo(nodeB.aabb, nodeF.aabb);
1035 nodeC.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb);
1037 // recompute the height of node A and C
1038 nodeA.height := dtMaxI(nodeB.height, nodeF.height)+1;
1039 nodeC.height := dtMaxI(nodeA.height, nodeG.height)+1;
1040 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1041 {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF}
1042 end;
1044 // return the new root of the sub-tree
1045 result := nodeCId;
1046 exit;
1047 end;
1049 // if the left node B is 2 higher than right node C
1050 if (balanceFactor < -1) then
1051 begin
1052 {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF}
1054 nodeFId := nodeB.children[TTreeNode.Left];
1055 nodeGId := nodeB.children[TTreeNode.Right];
1056 {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF}
1057 {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF}
1058 nodeF := @mNodes[nodeFId];
1059 nodeG := @mNodes[nodeGId];
1061 nodeB.children[TTreeNode.Left] := nodeId;
1062 nodeB.parentId := nodeA.parentId;
1063 nodeA.parentId := nodeBId;
1065 if (nodeB.parentId <> TTreeNode.NullTreeNode) then
1066 begin
1067 if (mNodes[nodeB.parentId].children[TTreeNode.Left] = nodeId) then
1068 begin
1069 mNodes[nodeB.parentId].children[TTreeNode.Left] := nodeBId;
1070 end
1071 else
1072 begin
1073 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeB.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF}
1074 mNodes[nodeB.parentId].children[TTreeNode.Right] := nodeBId;
1075 end;
1076 end
1077 else
1078 begin
1079 mRootNodeId := nodeBId;
1080 end;
1082 {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF}
1083 {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF}
1085 // if the left node B was higher than right node C because of the F node
1086 if (nodeF.height > nodeG.height) then
1087 begin
1088 nodeB.children[TTreeNode.Right] := nodeFId;
1089 nodeA.children[TTreeNode.Left] := nodeGId;
1090 nodeG.parentId := nodeId;
1092 // recompute the AABB of node A and B
1093 nodeA.aabb.setMergeTwo(nodeC.aabb, nodeG.aabb);
1094 nodeB.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb);
1096 // recompute the height of node A and B
1097 nodeA.height := dtMaxI(nodeC.height, nodeG.height)+1;
1098 nodeB.height := dtMaxI(nodeA.height, nodeF.height)+1;
1099 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1100 {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF}
1101 end
1102 else
1103 begin
1104 // if the left node B was higher than right node C because of node G
1105 nodeB.children[TTreeNode.Right] := nodeGId;
1106 nodeA.children[TTreeNode.Left] := nodeFId;
1107 nodeF.parentId := nodeId;
1109 // recompute the AABB of node A and B
1110 nodeA.aabb.setMergeTwo(nodeC.aabb, nodeF.aabb);
1111 nodeB.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb);
1113 // recompute the height of node A and B
1114 nodeA.height := dtMaxI(nodeC.height, nodeF.height)+1;
1115 nodeB.height := dtMaxI(nodeA.height, nodeG.height)+1;
1116 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1117 {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF}
1118 end;
1120 // return the new root of the sub-tree
1121 result := nodeBId;
1122 exit;
1123 end;
1125 // if the sub-tree is balanced, return the current root node
1126 result := nodeId;
1127 end;
1130 // compute the height of a given node in the tree
1131 function TDynAABBTreeBase.computeHeight (nodeId: Integer): Integer;
1132 var
1133 node: PTreeNode;
1134 leftHeight, rightHeight: Integer;
1135 begin
1136 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
1137 node := @mNodes[nodeId];
1139 // if the node is a leaf, its height is zero
1140 if (node.leaf) then begin result := 0; exit; end;
1142 // compute the height of the left and right sub-tree
1143 leftHeight := computeHeight(node.children[TTreeNode.Left]);
1144 rightHeight := computeHeight(node.children[TTreeNode.Right]);
1146 // return the height of the node
1147 result := 1+dtMaxI(leftHeight, rightHeight);
1148 end;
1151 // internally add an object into the tree
1152 function TDynAABBTreeBase.insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
1153 var
1154 nodeId: Integer;
1155 node: PTreeNode;
1156 begin
1157 // get the next available node (or allocate new ones if necessary)
1158 nodeId := allocateNode();
1160 node := @mNodes[nodeId];
1162 // create the fat aabb to use in the tree
1163 node.aabb := AABB2D.Create(aabb);
1164 if (not staticObject) then
1165 begin
1166 node.aabb.minX -= mExtraGap;
1167 node.aabb.minY -= mExtraGap;
1168 node.aabb.maxX += mExtraGap;
1169 node.aabb.maxY += mExtraGap;
1170 end;
1172 // set the height of the node in the tree
1173 node.height := 0;
1175 // insert the new leaf node in the tree
1176 insertLeafNode(nodeId);
1178 {$IFDEF aabbtree_many_asserts}node := @mNodes[nodeId];{$ENDIF}
1179 {$IFDEF aabbtree_many_asserts}assert(node.leaf);{$ENDIF}
1181 // return the id of the node
1182 result := nodeId;
1183 end;
1186 // initialize the tree
1187 procedure TDynAABBTreeBase.setup ();
1188 var
1189 i: Integer;
1190 begin
1191 mRootNodeId := TTreeNode.NullTreeNode;
1192 mNodeCount := 0;
1193 mAllocCount := 8192;
1194 vstused := 0;
1196 SetLength(mNodes, mAllocCount);
1197 //memset(mNodes, 0, mAllocCount*TTreeNode.sizeof);
1198 for i := 0 to mAllocCount-1 do mNodes[i].clear();
1200 // initialize the allocated nodes
1201 for i := 0 to mAllocCount-1 do
1202 begin
1203 mNodes[i].nextNodeId := i+1;
1204 mNodes[i].height := -1;
1205 end;
1206 mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode;
1207 mFreeNodeId := 0;
1208 end;
1211 // also, checks if the tree structure is valid (for debugging purpose)
1212 function TDynAABBTreeBase.forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean;
1213 var
1214 pNode: PTreeNode;
1215 leftChild, rightChild, height: Integer;
1216 aabb: AABB2D;
1217 begin
1218 result := false;
1219 if (nodeId = TTreeNode.NullTreeNode) then exit;
1220 // if it is the root
1221 if (nodeId = mRootNodeId) then assert(mNodes[nodeId].parentId = TTreeNode.NullTreeNode);
1222 // get the children nodes
1223 pNode := @mNodes[nodeId];
1224 assert(pNode.height >= 0);
1225 if (not pNode.aabb.valid) then
1226 begin
1227 {$IFDEF aabbtree_use_floats}
1228 e_WriteLog(Format('AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d; height=%d; leaf=%d', [pNode.aabb.minX, pNode.aabb.minY, pNode.aabb.maxX, pNode.aabb.maxY, pNode.aabb.volume, Integer(pNode.aabb.valid), pNode.height, Integer(pNode.leaf)]), MSG_NOTIFY);
1229 {$ELSE}
1230 e_WriteLog(Format('AABB:(%d,%d)-(%d,%d); volume=%d; valid=%d; height=%d; leaf=%d', [pNode.aabb.minX, pNode.aabb.minY, pNode.aabb.maxX, pNode.aabb.maxY, pNode.aabb.volume, Integer(pNode.aabb.valid), pNode.height, Integer(pNode.leaf)]), MSG_NOTIFY);
1231 {$ENDIF}
1232 if pNode.leaf then
1233 begin
1234 getFleshAABB(aabb, pNode.flesh, pNode.tag);
1235 {$IFDEF aabbtree_use_floats}
1236 e_WriteLog(Format(' LEAF AABB:(%f,%f)-(%f,%f); valid=%d; volume=%f', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, Integer(aabb.valid), aabb.volume]), MSG_NOTIFY);
1237 {$ELSE}
1238 e_WriteLog(Format(' LEAF AABB:(%d,%d)-(%d,%d); valid=%d; volume=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, Integer(aabb.valid), aabb.volume]), MSG_NOTIFY);
1239 {$ENDIF}
1240 end;
1241 end;
1242 assert(pNode.aabb.valid);
1243 assert(pNode.aabb.volume > 0);
1244 // if the current node is a leaf
1245 if (pNode.leaf) then
1246 begin
1247 assert(pNode.height = 0);
1248 if assigned(dg) then result := dg(pNode.flesh, pNode.aabb);
1249 end
1250 else
1251 begin
1252 leftChild := pNode.children[TTreeNode.Left];
1253 rightChild := pNode.children[TTreeNode.Right];
1254 // check that the children node Ids are valid
1255 assert((0 <= leftChild) and (leftChild < mAllocCount));
1256 assert((0 <= rightChild) and (rightChild < mAllocCount));
1257 // check that the children nodes have the correct parent node
1258 assert(mNodes[leftChild].parentId = nodeId);
1259 assert(mNodes[rightChild].parentId = nodeId);
1260 // check the height of node
1261 height := 1+dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height);
1262 assert(mNodes[nodeId].height = height);
1263 // check the AABB of the node
1264 aabb := AABB2D.Create(mNodes[leftChild].aabb, mNodes[rightChild].aabb);
1265 assert(aabb.minX = mNodes[nodeId].aabb.minX);
1266 assert(aabb.minY = mNodes[nodeId].aabb.minY);
1267 assert(aabb.maxX = mNodes[nodeId].aabb.maxX);
1268 assert(aabb.maxY = mNodes[nodeId].aabb.maxY);
1269 // recursively check the children nodes
1270 result := forEachNode(leftChild, dg);
1271 if not result then result := forEachNode(rightChild, dg);
1272 end;
1273 end;
1276 // also, checks if the tree structure is valid (for debugging purpose)
1277 function TDynAABBTreeBase.forEachLeaf (dg: TForEachLeafCB): Boolean;
1278 begin
1279 // recursively check each node
1280 result := forEachNode(mRootNodeId, dg);
1281 end;
1284 // return `true` from visitor to stop immediately
1285 // checker should check if this node should be considered to further checking
1286 // returns tree node if visitor says stop or -1
1287 function TDynAABBTreeBase.visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
1288 const
1289 StackGran = 1024;
1290 var
1291 oldvstused: Integer;
1292 vsp: Integer;
1293 vstk: array of Integer;
1294 nodeId: Integer;
1295 node: PTreeNode;
1296 doNode: Boolean = false;
1297 begin
1298 if not assigned(checker) then begin result := -1; exit; end;
1299 //if not assigned(visitor) and not assigned(visdg) then raise Exception.Create('dyntree: empty visitors aren''t supported');
1300 oldvstused := vstused;
1301 if (vstused+StackGran > Length(vstack)) then SetLength(vstack, vstused+StackGran);
1302 vsp := vstused;
1303 vstk := vstack;
1305 {$IFDEF aabbtree_query_count}
1306 mNodesVisited := 0;
1307 mNodesDeepVisited := 0;
1308 {$ENDIF}
1310 // start from root node
1311 // we can't have nested functions in generics, sorry
1312 {$IF FALSE}
1313 spush(mRootNodeId);
1314 {$ELSE}
1315 if (vsp >= Length(vstk)) then SetLength(vstk, vsp+StackGran);
1316 vstk[vsp] := mRootNodeId;
1317 Inc(vsp);
1318 {$ENDIF}
1320 // while there are still nodes to visit
1321 while (vsp > oldvstused) do
1322 begin
1323 // get the next node id to visit
1324 // we can't have nested functions in generics, sorry
1325 {$IF FALSE}
1326 nodeId := spop();
1327 {$ELSE}
1328 Dec(vsp);
1329 nodeId := vstk[vsp];
1330 {$ENDIF}
1331 // skip it if it is a nil node
1332 if (nodeId = TTreeNode.NullTreeNode) then continue;
1333 {$IFDEF aabbtree_query_count}Inc(mNodesVisited);{$ENDIF}
1334 // get the corresponding node
1335 node := @mNodes[nodeId];
1336 // should we investigate this node?
1337 case mode of
1338 ModeNoChecks: doNode := checker(node);
1339 ModeAABB:
1340 begin
1341 //doNode := caabb.overlaps(node.aabb);
1342 // this gives small speedup (or not...)
1343 // exit with no intersection if found separated along any axis
1344 if (caabb.maxX < node.aabb.minX) or (caabb.minX > node.aabb.maxX) then doNode := false
1345 else if (caabb.maxY < node.aabb.minY) or (caabb.minY > node.aabb.maxY) then doNode := false
1346 else doNode := true;
1347 end;
1348 ModePoint:
1349 begin
1350 //doNode := node.aabb.contains(caabb.minX, caabb.minY);
1351 // this gives small speedup
1352 doNode := (caabb.minX >= node.aabb.minX) and (caabb.minY >= node.aabb.minY) and (caabb.minX <= node.aabb.maxX) and (caabb.minY <= node.aabb.maxY);
1353 end;
1354 end;
1355 if doNode then
1356 begin
1357 // if the node is a leaf
1358 if (node.leaf) then
1359 begin
1360 // call visitor on it
1361 {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF}
1362 if (tagmask = -1) or ((node.tag and tagmask) <> 0) then
1363 begin
1364 doNode := false;
1365 // update object vars from cache, so recursive calls to `visit()` will work
1366 vstack := vstk;
1367 vstused := vsp;
1368 // call callbacks
1369 if assigned(visitor) then doNode := visitor(node.flesh, node.tag);
1370 if assigned(visdg) and visdg(node.flesh, node.tag) then doNode := true;
1371 // do some sanity checks
1372 if (vstused <> vsp) then raise Exception.Create('internal error in dyntree visitor');
1373 // should we exit?
1374 if doNode then
1375 begin
1376 result := nodeId;
1377 vstack := vstk;
1378 vstused := oldvstused;
1379 exit;
1380 end;
1381 end;
1382 end
1383 else
1384 begin
1385 // if the node is not a leaf, we need to visit its children
1386 // we can't have nested functions in generics, sorry
1387 {$IF FALSE}
1388 spush(node.children[TTreeNode.Left]);
1389 spush(node.children[TTreeNode.Right]);
1390 {$ELSE}
1391 if (vsp+2 > Length(vstk)) then SetLength(vstk, vsp+StackGran);
1392 vstk[vsp] := node.children[TTreeNode.Left];
1393 Inc(vsp);
1394 vstk[vsp] := node.children[TTreeNode.Right];
1395 Inc(vsp);
1396 {$ENDIF}
1397 end;
1398 end;
1399 end;
1401 result := -1; // oops
1402 vstack := vstk;
1403 vstused := oldvstused;
1404 end;
1407 // add `extraAABBGap` to bounding boxes so slight object movement won't cause tree rebuilds
1408 // extra AABB Gap used to allow the collision shape to move a little bit without triggering a large modification of the tree which can be costly
1409 constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0);
1410 begin
1411 mExtraGap := extraAABBGap;
1412 mNodes := nil;
1413 SetLength(vstack, 2048);
1414 vstused := 0;
1415 setup();
1416 end;
1419 destructor TDynAABBTreeBase.Destroy ();
1420 begin
1421 mNodes := nil;
1422 vstack := nil;
1423 inherited;
1424 end;
1427 // clear all the nodes and reset the tree
1428 procedure TDynAABBTreeBase.reset ();
1429 begin
1430 mNodes := nil;
1431 setup();
1432 end;
1435 function TDynAABBTreeBase.computeTreeHeight (): Integer; begin result := computeHeight(mRootNodeId); end;
1438 // return the root AABB of the tree
1439 procedure TDynAABBTreeBase.getRootAABB (out aabb: AABB2D);
1440 begin
1441 {$IFDEF aabbtree_many_asserts}assert((mRootNodeId >= 0) and (mRootNodeId < mAllocCount));{$ENDIF}
1442 aabb := mNodes[mRootNodeId].aabb;
1443 end;
1446 // does the given id represents a valid object?
1447 // WARNING: ids of removed objects can be reused on later insertions!
1448 function TDynAABBTreeBase.isValidId (id: Integer): Boolean;
1449 begin
1450 result := (id >= 0) and (id < mAllocCount) and (mNodes[id].leaf);
1451 end;
1454 // get object by nodeid; can return nil for invalid ids
1455 function TDynAABBTreeBase.getNodeObjectId (nodeid: Integer): TTreeFlesh;
1456 begin
1457 if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then result := mNodes[nodeid].flesh else result := Default(ITP);
1458 end;
1460 // get fat object AABB by nodeid; returns random shit for invalid ids
1461 procedure TDynAABBTreeBase.getNodeFatAABB (out aabb: AABB2D; nodeid: Integer);
1462 begin
1463 if (nodeid >= 0) and (nodeid < mAllocCount) and (not mNodes[nodeid].isfree) then aabb := AABB2D.Create(mNodes[nodeid].aabb) else aabb := AABB2D.Create(0, 0, 0, 0);
1464 end;
1466 function TDynAABBTreeBase.getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
1467 begin
1468 if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then
1469 begin
1470 result := true;
1471 {$IFDEF aabbtree_use_floats}
1472 x := round(mNodes[nodeid].fleshX);
1473 y := round(mNodes[nodeid].fleshY);
1474 {$ELSE}
1475 x := mNodes[nodeid].fleshX;
1476 y := mNodes[nodeid].fleshY;
1477 {$ENDIF}
1478 end
1479 else
1480 begin
1481 result := false;
1482 x := 0;
1483 y := 0;
1484 //if (nodeid >= 0) and (nodeid < mAllocCount) then mNodes[nodeid].dumpToLog();
1485 end;
1486 end;
1489 // insert an object into the tree
1490 // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error
1491 // AABB for static object will not be "fat" (simple optimization)
1492 // WARNING! inserting the same object several times *WILL* break everything!
1493 function TDynAABBTreeBase.insertObject (flesh: TTreeFlesh; tag: Integer; staticObject: Boolean=false): Integer;
1494 var
1495 aabb: AABB2D;
1496 nodeId, fx, fy: Integer;
1497 begin
1498 if not getFleshAABB(aabb, flesh, tag) then
1499 begin
1500 {$IFDEF aabbtree_use_floats}
1501 e_WriteLog(Format('trying to insert FUCKED FLESH:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING);
1502 {$ELSE}
1503 e_WriteLog(Format('trying to insert FUCKED FLESH:(%d,%d)-(%d,%d); volume=%d; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING);
1504 {$ENDIF}
1505 //raise Exception.Create('trying to insert invalid flesh in dyntree');
1506 result := -1;
1507 exit;
1508 end;
1509 if not aabb.valid then
1510 begin
1511 {$IFDEF aabbtree_use_floats}
1512 e_WriteLog(Format('trying to insert FUCKED AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING);
1513 {$ELSE}
1514 e_WriteLog(Format('trying to insert FUCKED AABB:(%d,%d)-(%d,%d); volume=%d; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_WARNING);
1515 {$ENDIF}
1516 raise Exception.Create('trying to insert invalid aabb in dyntree');
1517 result := -1;
1518 exit;
1519 end;
1520 //e_WriteLog(Format('inserting AABB:(%f,%f)-(%f,%f); volume=%f; valid=%d', [aabb.minX, aabb.minY, aabb.maxX, aabb.maxY, aabb.volume, Integer(aabb.valid)]), MSG_NOTIFY);
1521 fx := aabb.minX;
1522 fy := aabb.minY;
1523 nodeId := insertObjectInternal(aabb, staticObject);
1524 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
1525 mNodes[nodeId].flesh := flesh;
1526 mNodes[nodeId].tag := tag;
1527 mNodes[nodeId].fleshX := fx;
1528 mNodes[nodeId].fleshY := fy;
1529 result := nodeId;
1530 end;
1533 // remove an object from the tree
1534 // WARNING: ids of removed objects can be reused on later insertions!
1535 procedure TDynAABBTreeBase.removeObject (nodeId: Integer);
1536 begin
1537 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase');
1538 // remove the node from the tree
1539 removeLeafNode(nodeId);
1540 releaseNode(nodeId);
1541 end;
1544 function TDynAABBTreeBase.updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload;
1545 var
1546 newAABB: AABB2D;
1547 dispX, dispY: TreeNumber;
1548 begin
1549 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject');
1551 if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject');
1552 if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject');
1554 dispX := newAABB.minX-mNodes[nodeId].fleshX;
1555 dispY := newAABB.minY-mNodes[nodeId].fleshY;
1557 if (dispX < -16) then dispX := -16 else if (dispX > 16) then dispX := 16;
1558 if (dispY < -16) then dispY := -16 else if (dispY > 16) then dispY := 16;
1560 result := updateObject(nodeId, dispX, dispY, forceReinsert);
1561 end;
1563 function TDynAABBTreeBase.updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload;
1564 var
1565 newAABB: AABB2D;
1566 fx, fy: Integer;
1567 node: PTreeNode;
1568 begin
1569 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject');
1571 if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject');
1572 if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject');
1574 fx := newAABB.minX;
1575 fy := newAABB.minY;
1577 // if the new AABB is still inside the fat AABB of the node
1578 if (not forceReinsert) and (mNodes[nodeId].aabb.contains(newAABB)) then
1579 begin
1580 node := @mNodes[nodeId];
1581 node.fleshX := fx;
1582 node.fleshY := fy;
1583 result := false;
1584 exit;
1585 end;
1587 // if the new AABB is outside the fat AABB, we remove the corresponding node
1588 removeLeafNode(nodeId);
1590 node := @mNodes[nodeId];
1592 // compute the fat AABB by inflating the AABB with a constant gap
1593 node.aabb.copyFrom(newAABB);
1594 node.fleshX := fx;
1595 node.fleshY := fy;
1597 if (not forceReinsert) and ((dispX <> 0) or (dispY <> 0)) then
1598 begin
1599 node.aabb.minX -= mExtraGap;
1600 node.aabb.minY += mExtraGap;
1601 node.aabb.maxX += mExtraGap;
1602 node.aabb.maxY += mExtraGap;
1603 end;
1605 // inflate the fat AABB in direction of the linear motion of the AABB
1606 if (dispX < 0) then
1607 begin
1608 node.aabb.minX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1609 end
1610 else
1611 begin
1612 node.aabb.maxX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1613 end;
1615 if (dispY < 0) then
1616 begin
1617 node.aabb.minY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1618 end
1619 else
1620 begin
1621 node.aabb.maxY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1622 end;
1624 {$IFDEF aabbtree_many_asserts}assert(node.aabb.contains(newAABB));{$ENDIF}
1626 // reinsert the node into the tree
1627 insertLeafNode(nodeId);
1629 result := true;
1630 end;
1633 function TDynAABBTreeBase.checkerAABB (node: PTreeNode): Boolean;
1634 begin
1635 result := chkAABB.overlaps(node.aabb);
1636 end;
1639 // report all shapes overlapping with the AABB given in parameter
1640 function TDynAABBTreeBase.aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
1641 var
1642 nid: Integer;
1643 oldaabb: AABB2D;
1644 begin
1645 result := Default(ITP);
1646 if not assigned(cb) then exit;
1647 if (aw < 1) or (ah < 1) then exit;
1648 //chkAABB := AABB2D.Create(ax, ay, ax+aw, ay+ah);
1649 oldaabb := chkAABB;
1650 chkAABB.minX := ax;
1651 chkAABB.minY := ay;
1652 chkAABB.maxX := ax+aw;
1653 chkAABB.maxY := ay+ah;
1654 nid := visit(chkAABB, ModeAABB, checkerAABB, cb, nil, tagmask);
1655 chkAABB := oldaabb;
1656 if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP);
1657 end;
1660 function TDynAABBTreeBase.checkerPoint (node: PTreeNode): Boolean;
1661 begin
1662 result := node.aabb.contains(chkAABB.minX, chkAABB.minY);
1663 end;
1666 // report body that contains the given point, or nil
1667 function TDynAABBTreeBase.pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
1668 var
1669 nid: Integer;
1670 oldaabb: AABB2D;
1671 begin
1672 oldaabb := chkAABB;
1673 chkAABB := AABB2D.Create(ax, ay, ax+1, ay+1);
1674 nid := visit(chkAABB, ModePoint, checkerPoint, cb, nil, tagmask);
1675 {$IFDEF aabbtree_many_asserts}assert((nid < 0) or ((nid >= 0) and (nid < mAllocCount) and (mNodes[nid].leaf)));{$ENDIF}
1676 chkAABB := oldaabb;
1677 if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP);
1678 end;
1681 function TDynAABBTreeBase.checkerRay (node: PTreeNode): Boolean;
1682 //var tmin: Single = 0;
1683 begin
1684 {$IF FALSE}
1685 result := node.aabb.intersects(curax, curay, curbx, curby, @tmin);
1686 e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d', [
1687 minSingle(curax, curbx),
1688 minSingle(curay, curby),
1689 maxSingle(curax, curbx),
1690 maxSingle(curay, curby),
1691 node.aabb.minX, node.aabb.minY,
1692 node.aabb.maxX, node.aabb.maxY,
1693 tmin,
1694 Integer(result),
1695 ]), MSG_NOTIFY);
1696 {$ELSE}
1697 result := false;
1698 if (node.aabb.maxX < minSingle(curax, curbx)) or (node.aabb.maxY < minSingle(curay, curby)) then exit;
1699 if (node.aabb.minX > maxSingle(curax, curbx)) or (node.aabb.minY > maxSingle(curay, curby)) then exit;
1700 result := node.aabb.intersects(traceRay, qSRes.time{, @tmin});
1702 e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d frac=%f', [
1703 curax, curay, curbx, curby,
1704 node.aabb.minX, node.aabb.minY,
1705 node.aabb.maxX, node.aabb.maxY,
1706 tmin,
1707 Integer(result),
1708 qSRes.time
1709 ]), MSG_NOTIFY);
1711 {$ENDIF}
1712 end;
1715 function TDynAABBTreeBase.visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean;
1716 var
1717 hitFraction: Single;
1718 ray: Ray2D;
1719 begin
1720 ray.origX := curax;
1721 ray.origY := curay;
1722 ray.dirX := dirx;
1723 ray.dirY := diry;
1724 hitFraction := sqcb(flesh, ray);
1725 // if the user returned a hitFraction of zero, it means that the raycasting should stop here
1726 if (hitFraction = 0.0) then
1727 begin
1728 qSRes.time := 0;
1729 qSRes.flesh := flesh;
1730 result := true;
1731 exit;
1732 end;
1733 // if the user returned a positive fraction
1734 if (hitFraction > 0.0) then
1735 begin
1736 // we update the maxFraction value and the ray AABB using the new maximum fraction
1737 if (hitFraction < qSRes.time) then
1738 begin
1739 qSRes.time := hitFraction;
1740 qSRes.flesh := flesh;
1741 // fix curb here
1742 //curb := cura+dir*hitFraction;
1743 curbx := curax+dirx*hitFraction;
1744 curby := curay+diry*hitFraction;
1745 end;
1746 end;
1747 result := false; // continue
1748 end;
1751 // segment querying method
1752 function TDynAABBTreeBase.segmentQuery (out qr: TSegmentQueryResult; const ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
1753 var
1754 oldcurax, oldcuray: Single;
1755 oldcurbx, oldcurby: Single;
1756 olddirx, olddiry: Single;
1757 invlen: Single;
1758 osres: PSegmentQueryResult;
1759 osqcb: TSegQueryCallback;
1760 oldray: Ray2D;
1761 begin
1762 qr := TSegmentQueryResult.Create(false);
1764 if (ax = bx) and (ay = by) then begin result := false; exit; end;
1766 oldcurax := curax;
1767 oldcuray := curay;
1768 oldcurbx := curbx;
1769 oldcurby := curby;
1770 olddirx := dirx;
1771 olddiry := diry;
1772 oldray := traceRay;
1774 qr.time := 1.0e100; // infinity
1775 //qr.time := sqrt((bx-ax)*(bx-ax)+(by-ay)*(by-ay))+1.0;
1776 curax := ax;
1777 curay := ay;
1778 curbx := bx;
1779 curby := by;
1781 dirx := curbx-curax;
1782 diry := curby-curay;
1783 // normalize
1784 invlen := 1.0/sqrt(dirx*dirx+diry*diry);
1785 dirx *= invlen;
1786 diry *= invlen;
1788 traceRay.origX := curax;
1789 traceRay.origY := curay;
1790 traceRay.dirX := dirx;
1791 traceRay.dirY := diry;
1793 //chkAABB := AABB2D.Create(0, 0, 1, 1);
1794 osres := qSRes;
1795 qSRes := @qr;
1796 osqcb := sqcb;
1797 sqcb := cb;
1798 visit(chkAABB, ModeNoChecks, checkerRay, nil, visitorRay, tagmask);
1799 qSRes := osres;
1800 sqcb := osqcb;
1802 curax := oldcurax;
1803 curay := oldcuray;
1804 curbx := oldcurbx;
1805 curby := oldcurby;
1806 dirx := olddirx;
1807 diry := olddiry;
1808 traceRay := oldray;
1810 if qr.valid and (qr.time <= (bx-ax)*(bx-ax)+(by-ay)*(by-ay)) then
1811 begin
1812 result := true;
1813 end
1814 else
1815 begin
1816 result := false;
1817 qr.flesh := nil;
1818 end;
1819 end;
1822 end.