DEADSOFTWARE

6f2168d33814355f6f79332c4170bc2af187161d
[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 public
41 constructor Create (ax, ay: Single; aangle: Single); overload;
42 constructor Create (ax0, ay0, ax1, ay1: Single); overload;
43 constructor Create (constref aray: Ray2D); overload;
45 procedure copyFrom (constref aray: Ray2D); inline;
47 procedure normalizeDir (); inline;
49 procedure setXYAngle (ax, ay: Single; aangle: Single); inline;
50 procedure setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline;
51 end;
53 // ////////////////////////////////////////////////////////////////////////// //
54 type
55 AABB2D = record
56 public
57 minX, minY, maxX, maxY: TreeNumber;
59 private
60 function getvalid (): Boolean; inline;
61 function getcenterX (): TreeNumber; inline;
62 function getcenterY (): TreeNumber; inline;
63 function getextentX (): TreeNumber; inline;
64 function getextentY (): TreeNumber; inline;
66 public
67 constructor Create (x0, y0, x1, y1: TreeNumber); overload;
68 constructor Create (constref aabb: AABB2D); overload;
69 constructor Create (constref aabb0, aabb1: AABB2D); overload;
71 constructor CreateWH (ax, ay, w, h: TreeNumber);
73 procedure copyFrom (constref aabb: AABB2D); inline;
74 procedure setDims (x0, y0, x1, y1: TreeNumber); inline;
76 procedure setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
78 function volume (): TreeNumber; inline;
80 procedure merge (constref aabb: AABB2D); inline;
82 // return true if the current AABB contains the AABB given in parameter
83 function contains (constref aabb: AABB2D): Boolean; inline; overload;
84 function contains (ax, ay: TreeNumber): Boolean; inline; overload;
86 // return true if the current AABB is overlapping with the AABB in parameter
87 // two AABBs overlap if they overlap in the two axes at the same time
88 function overlaps (constref aabb: AABB2D): Boolean; inline; overload;
90 // ray direction must be normalized
91 function intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
92 function intersects (ax, ay, bx, by: Single): Boolean; inline; overload;
94 property valid: Boolean read getvalid;
95 property centerX: TreeNumber read getcenterX;
96 property centerY: TreeNumber read getcenterY;
97 property extentX: TreeNumber read getextentX;
98 property extentY: TreeNumber read getextentY;
99 end;
102 // ////////////////////////////////////////////////////////////////////////// //
103 (* Dynamic AABB tree (bounding volume hierarchy)
104 * based on the code from ReactPhysics3D physics library, http://www.reactphysics3d.com
105 * Copyright (c) 2010-2016 Daniel Chappuis
107 * This software is provided 'as-is', without any express or implied warranty.
108 * In no event will the authors be held liable for any damages arising from the
109 * use of this software.
111 * Permission is granted to anyone to use this software for any purpose,
112 * including commercial applications, and to alter it and redistribute it
113 * freely, subject to the following restrictions:
115 * 1. The origin of this software must not be misrepresented; you must not claim
116 * that you wrote the original software. If you use this software in a
117 * product, an acknowledgment in the product documentation would be
118 * appreciated but is not required.
120 * 2. Altered source versions must be plainly marked as such, and must not be
121 * misrepresented as being the original software.
123 * 3. This notice may not be removed or altered from any source distribution.
124 *)
125 // ////////////////////////////////////////////////////////////////////////// //
126 (*
127 * This class implements a dynamic AABB tree that is used for broad-phase
128 * collision detection. This data structure is inspired by Nathanael Presson's
129 * dynamic tree implementation in BulletPhysics. The following implementation is
130 * based on the one from Erin Catto in Box2D as described in the book
131 * "Introduction to Game Physics with Box2D" by Ian Parberry.
132 *)
133 // ////////////////////////////////////////////////////////////////////////// //
134 // Dynamic AABB Tree: can be used to speed up broad phase in various engines
135 type
136 generic TDynAABBTreeBase<ITP> = class(TObject)
137 public
138 type TTreeFlesh = ITP;
140 private
141 type
142 PTreeNode = ^TTreeNode;
143 TTreeNode = record
144 public
145 const NullTreeNode = -1;
146 const Left = 0;
147 const Right = 1;
148 public
149 // a node is either in the tree (has a parent) or in the free nodes list (has a next node)
150 parentId: Integer;
151 //nextNodeId: Integer;
152 // a node is either a leaf (has data) or is an internal node (has children)
153 children: array [0..1] of Integer; // left and right child of the node (children[0] = left child)
154 // height of the node in the tree (-1 for free nodes)
155 height: SmallInt;
156 // fat axis aligned bounding box (AABB) corresponding to the node
157 aabb: AABB2D;
158 //TODO: `flesh` can be united with `children`
159 flesh: TTreeFlesh;
160 fleshX, fleshY: TreeNumber;
161 tag: Integer; // just a user-defined tag
162 public
163 // return true if the node is a leaf of the tree
164 procedure clear (); inline;
165 function leaf (): Boolean; inline;
166 function isfree (): Boolean; inline;
167 property nextNodeId: Integer read parentId write parentId;
168 //property flesh: Integer read children[0] write children[0];
170 procedure dumpToLog ();
171 end;
173 TVisitCheckerCB = function (node: PTreeNode): Boolean of object;
174 //TVisitVisitorCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested;
176 const ModeNoChecks = 0;
177 const ModeAABB = 1;
178 const ModePoint = 2;
180 public
181 // return `true` to stop
182 type TForEachLeafCB = function (abody: TTreeFlesh; constref aabb: AABB2D): Boolean is nested; // WARNING! don't modify AABB here!
184 public
185 // in the broad-phase collision detection (dynamic AABB tree), the AABBs are
186 // also inflated in direction of the linear motion of the body by mutliplying the
187 // followin constant with the linear velocity and the elapsed time between two frames
188 {$IFDEF aabbtree_use_floats}
189 const LinearMotionGapMultiplier = 1.7;
190 {$ELSE}
191 const LinearMotionGapMultiplier = 17; // *10
192 {$ENDIF}
194 public
195 // called when a overlapping node has been found during the call to forEachAABBOverlap()
196 // return `true` to stop
197 type TQueryOverlapCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested;
198 type TSegQueryCallback = function (abody: TTreeFlesh; ax, ay, bx, by: Single): Single is nested; // return dist from (ax,ay) to abody
200 PSegmentQueryResult = ^TSegmentQueryResult;
201 TSegmentQueryResult = record
202 dist: Single; // <0: nothing was hit
203 flesh: TTreeFlesh;
205 constructor Create (fuckyoufpc: Boolean);
206 procedure reset (); inline;
207 function valid (): Boolean; inline;
208 end;
210 private
211 mNodes: array of TTreeNode; // nodes of the tree
212 mRootNodeId: Integer; // id of the root node of the tree
213 mFreeNodeId: Integer; // id of the first node of the list of free (allocated) nodes in the tree that we can use
214 mAllocCount: Integer; // number of allocated nodes in the tree
215 mNodeCount: Integer; // number of nodes in the tree
217 // extra AABB Gap used to allow the collision shape to move a little bit
218 // without triggering a large modification of the tree which can be costly
219 mExtraGap: TreeNumber;
221 chkAABB: AABB2D; // for checkers
222 qSRes: PSegmentQueryResult; // for queries
223 // for segment query
224 maxFraction: Single;
225 curax, curay: Single;
226 curbx, curby: Single;
227 dirx, diry: Single;
228 sqcb: TSegQueryCallback;
229 vstack: array of Integer; // for `visit()`
230 vstused: Integer; // to support recursive queries
232 function checkerAABB (node: PTreeNode): Boolean;
233 function checkerPoint (node: PTreeNode): Boolean;
234 function checkerRay (node: PTreeNode): Boolean;
235 function visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean;
237 type TQueryOverlapDg = function (abody: TTreeFlesh; atag: Integer): Boolean of object;
239 private
240 function allocateNode (): Integer;
241 procedure releaseNode (nodeId: Integer);
242 procedure insertLeafNode (nodeId: Integer);
243 procedure removeLeafNode (nodeId: Integer);
244 function balanceSubTreeAtNode (nodeId: Integer): Integer;
245 function computeHeight (nodeId: Integer): Integer;
246 function insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
247 procedure setup ();
248 function visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
250 function forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean;
252 public
253 {$IFDEF aabbtree_query_count}
254 mNodesVisited, mNodesDeepVisited: Integer;
255 {$ENDIF}
257 public
258 constructor Create (extraAABBGap: TreeNumber=0);
259 destructor Destroy (); override;
261 // clear all the nodes and reset the tree
262 procedure reset ();
264 function forEachLeaf (dg: TForEachLeafCB): Boolean; // WARNING! don't modify AABB/tree here!
265 procedure getRootAABB (out aabb: AABB2D);
267 function isValidId (id: Integer): Boolean; inline;
268 function getNodeObjectId (nodeid: Integer): TTreeFlesh; inline;
269 procedure getNodeFatAABB (out aabb: AABB2D; nodeid: Integer); inline;
271 // returns `false` if nodeid is not leaf
272 function getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
274 // return `false` for invalid flesh
275 function getFleshAABB (out aabb: AABB2D; flesh: TTreeFlesh; tag: Integer): Boolean; virtual; abstract;
277 // insert an object into the tree
278 // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error
279 // AABB for static object will not be "fat" (simple optimization)
280 // WARNING! inserting the same object several times *WILL* break everything!
281 function insertObject (flesh: TTreeFlesh; tag: Integer=-1; staticObject: Boolean=false): Integer;
283 // remove an object from the tree
284 // WARNING: ids of removed objects can be reused on later insertions!
285 procedure removeObject (nodeId: Integer);
287 (** update the dynamic tree after an object has moved.
289 * if the new AABB of the object that has moved is still inside its fat AABB, then nothing is done.
290 * otherwise, the corresponding node is removed and reinserted into the tree.
291 * the method returns true if the object has been reinserted into the tree.
292 * the `dispX` and `dispY` parameters are the linear velocity of the AABB multiplied by the elapsed time between two frames.
293 * if the `forceReinsert` parameter is `true`, we force a removal and reinsertion of the node
294 * (this can be useful if the shape AABB has become much smaller than the previous one for instance).
296 * note that you should call this method if body's AABB was modified, even if the body wasn't moved.
298 * if `forceReinsert` = `true` and both `dispX` and `dispY` are zeroes, convert object to "static" (don't extrude AABB).
300 * return `true` if the tree was modified.
301 *)
302 function updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload;
303 function updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload;
305 function aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
306 function pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
307 function segmentQuery (out qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
309 function computeTreeHeight (): Integer; // compute the height of the tree
311 property extraGap: TreeNumber read mExtraGap write mExtraGap;
312 property nodeCount: Integer read mNodeCount;
313 property nodeAlloced: Integer read mAllocCount;
314 {$IFDEF aabbtree_query_count}
315 property nodesVisited: Integer read mNodesVisited;
316 property nodesDeepVisited: Integer read mNodesDeepVisited;
317 {$ELSE}
318 const nodesVisited = 0;
319 const nodesDeepVisited = 0;
320 {$ENDIF}
321 end;
324 function dtMinI (a, b: Integer): Integer; inline;
325 function dtMaxI (a, b: Integer): Integer; inline;
327 function dtMinF (a, b: TreeNumber): TreeNumber; inline;
328 function dtMaxF (a, b: TreeNumber): TreeNumber; inline;
331 implementation
333 uses
334 SysUtils;
337 // ////////////////////////////////////////////////////////////////////////// //
338 function dtMinI (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
339 function dtMaxI (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
341 function dtMinF (a, b: TreeNumber): TreeNumber; inline; begin if (a < b) then result := a else result := b; end;
342 function dtMaxF (a, b: TreeNumber): TreeNumber; inline; begin if (a > b) then result := a else result := b; end;
345 // ////////////////////////////////////////////////////////////////////////// //
346 constructor Ray2D.Create (ax, ay: Single; aangle: Single); begin setXYAngle(ax, ay, aangle); end;
347 constructor Ray2D.Create (ax0, ay0, ax1, ay1: Single); begin setX0Y0X1Y1(ax0, ay0, ax1, ay1); end;
348 constructor Ray2D.Create (constref aray: Ray2D); overload; begin copyFrom(aray); end;
351 procedure Ray2D.copyFrom (constref aray: Ray2D); inline;
352 begin
353 origX := aray.origX;
354 origY := aray.origY;
355 dirX := aray.dirX;
356 dirY := aray.dirY;
357 end;
359 procedure Ray2D.normalizeDir (); inline;
360 var
361 invlen: Single;
362 begin
363 invlen := 1.0/sqrt(dirX*dirX+dirY*dirY);
364 dirX *= invlen;
365 dirY *= invlen;
366 end;
368 procedure Ray2D.setXYAngle (ax, ay: Single; aangle: Single); inline;
369 begin
370 origX := ax;
371 origY := ay;
372 dirX := cos(aangle);
373 dirY := sin(aangle);
374 end;
376 procedure Ray2D.setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline;
377 begin
378 origX := ax0;
379 origY := ay0;
380 dirX := ax1-ax0;
381 dirY := ay1-ay0;
382 normalizeDir();
383 end;
386 // ////////////////////////////////////////////////////////////////////////// //
387 constructor AABB2D.Create (x0, y0, x1, y1: TreeNumber); overload;
388 begin
389 setDims(x0, y0, x1, y1);
390 end;
392 constructor AABB2D.Create (constref aabb: AABB2D); overload;
393 begin
394 copyFrom(aabb);
395 end;
397 constructor AABB2D.Create (constref aabb0, aabb1: AABB2D); overload;
398 begin
399 setMergeTwo(aabb0, aabb1);
400 end;
402 constructor AABB2D.CreateWH (ax, ay, w, h: TreeNumber);
403 begin
404 minX := ax;
405 minY := ay;
406 maxX := ax+w-1;
407 maxY := ay+h-1;
408 end;
410 function AABB2D.getvalid (): Boolean; inline; begin result := (minX <= maxX) and (minY <= maxY); end;
412 {$IFDEF aabbtree_use_floats}
413 function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX)/2.0; end;
414 function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY)/2.0; end;
415 {$ELSE}
416 function AABB2D.getcenterX (): TreeNumber; inline; begin result := (minX+maxX) div 2; end;
417 function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY) div 2; end;
418 {$ENDIF}
419 function AABB2D.getextentX (): TreeNumber; inline; begin result := maxX-minX+1; end;
420 function AABB2D.getextentY (): TreeNumber; inline; begin result := maxY-minY+1; end;
422 procedure AABB2D.copyFrom (constref aabb: AABB2D); inline;
423 begin
424 minX := aabb.minX;
425 minY := aabb.minY;
426 maxX := aabb.maxX;
427 maxY := aabb.maxY;
428 {$IF DEFINED(D2F_DEBUG)}
429 if not valid then raise Exception.Create('copyFrom: result is fucked');
430 {$ENDIF}
431 end;
434 procedure AABB2D.setDims (x0, y0, x1, y1: TreeNumber); inline;
435 begin
436 minX := dtMinF(x0, x1);
437 minY := dtMinF(y0, y1);
438 maxX := dtMaxF(x0, x1);
439 maxY := dtMaxF(y0, y1);
440 {$IF DEFINED(D2F_DEBUG)}
441 if not valid then raise Exception.Create('setDims: result is fucked');
442 {$ENDIF}
443 end;
446 procedure AABB2D.setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
447 begin
448 {$IF DEFINED(D2F_DEBUG)}
449 if not aabb0.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked');
450 if not aabb1.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked');
451 {$ENDIF}
452 minX := dtMinF(aabb0.minX, aabb1.minX);
453 minY := dtMinF(aabb0.minY, aabb1.minY);
454 maxX := dtMaxF(aabb0.maxX, aabb1.maxX);
455 maxY := dtMaxF(aabb0.maxY, aabb1.maxY);
456 {$IF DEFINED(D2F_DEBUG)}
457 if not valid then raise Exception.Create('setMergeTwo: result is fucked');
458 {$ENDIF}
459 end;
462 function AABB2D.volume (): TreeNumber; inline;
463 begin
464 result := (maxX-minX+1)*(maxY-minY+1);
465 end;
468 procedure AABB2D.merge (constref aabb: AABB2D); inline;
469 begin
470 {$IF DEFINED(D2F_DEBUG)}
471 if not aabb.valid then raise Exception.Create('merge: aabb is fucked');
472 {$ENDIF}
473 minX := dtMinF(minX, aabb.minX);
474 minY := dtMinF(minY, aabb.minY);
475 maxX := dtMaxF(maxX, aabb.maxX);
476 maxY := dtMaxF(maxY, aabb.maxY);
477 {$IF DEFINED(D2F_DEBUG)}
478 if not valid then raise Exception.Create('setMergeTwo: result is fucked');
479 {$ENDIF}
480 end;
483 function AABB2D.contains (constref aabb: AABB2D): Boolean; inline; overload;
484 begin
485 result :=
486 (aabb.minX >= minX) and (aabb.minY >= minY) and
487 (aabb.maxX <= maxX) and (aabb.maxY <= maxY);
488 end;
491 function AABB2D.contains (ax, ay: TreeNumber): Boolean; inline; overload;
492 begin
493 result := (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY);
494 end;
497 function AABB2D.overlaps (constref aabb: AABB2D): Boolean; inline; overload;
498 begin
499 result := false;
500 // exit with no intersection if found separated along any axis
501 if (maxX < aabb.minX) or (minX > aabb.maxX) then exit;
502 if (maxY < aabb.minY) or (minY > aabb.maxY) then exit;
503 result := true;
504 end;
507 // something to consider here is that 0 * inf =nan which occurs when the ray starts exactly on the edge of a box
508 // https://tavianator.com/fast-branchless-raybounding-box-intersections-part-2-nans/
509 function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
510 var
511 dinv, t1, t2, tmp: Single;
512 tmin, tmax: Single;
513 begin
514 // ok with coplanars
515 tmin := -1.0e100;
516 tmax := 1.0e100;
517 // do X
518 if (ray.dirX <> 0.0) then
519 begin
520 dinv := 1.0/ray.dirX;
521 t1 := (minX-ray.origX)*dinv;
522 t2 := (maxX-ray.origX)*dinv;
523 if (t1 < t2) then tmin := t1 else tmin := t2;
524 if (t1 > t2) then tmax := t1 else tmax := t2;
525 end;
526 // do Y
527 if (ray.dirY <> 0.0) then
528 begin
529 dinv := 1.0/ray.dirY;
530 t1 := (minY-ray.origY)*dinv;
531 t2 := (maxY-ray.origY)*dinv;
532 // tmin
533 if (t1 < t2) then tmp := t1 else tmp := t2; // min(t1, t2)
534 if (tmax < tmp) then tmp := tmax; // min(tmax, tmp)
535 if (tmin > tmp) then tmin := tmp; // max(tmin, tmp)
536 // tmax
537 if (t1 > t2) then tmp := t1 else tmp := t2; // max(t1, t2)
538 if (tmin > tmp) then tmp := tmin; // max(tmin, tmp)
539 if (tmax < tmp) then tmax := tmp; // min(tmax, tmp)
540 end;
541 if (tmin > 0) then tmp := tmin else tmp := 0;
542 if (tmax > tmp) then
543 begin
544 if (tmino <> nil) then tmino^ := tmin;
545 if (tmaxo <> nil) then tmaxo^ := tmax;
546 result := true;
547 end
548 else
549 begin
550 result := false;
551 end;
552 end;
554 function AABB2D.intersects (ax, ay, bx, by: Single): Boolean; inline; overload;
555 var
556 tmin: Single;
557 ray: Ray2D;
558 begin
559 result := true;
560 // it may be faster to first check if start or end point is inside AABB (this is sometimes enough for dyntree)
561 if (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY) then exit; // a
562 if (bx >= minX) and (by >= minY) and (bx <= maxX) and (by <= maxY) then exit; // b
563 // nope, do it hard way
564 ray := Ray2D.Create(ax, ay, bx, by);
565 if not intersects(ray, @tmin) then begin result := false; exit; end;
566 if (tmin < 0) then exit; // inside, just in case
567 bx := bx-ax;
568 by := by-ay;
569 result := (tmin*tmin <= bx*bx+by*by);
570 end;
573 // ////////////////////////////////////////////////////////////////////////// //
574 constructor TDynAABBTreeBase.TSegmentQueryResult.Create (fuckyoufpc: Boolean); begin dist := -1; flesh := Default(ITP); end;
575 procedure TDynAABBTreeBase.TSegmentQueryResult.reset (); inline; begin dist := -1; flesh := Default(ITP); end;
576 function TDynAABBTreeBase.TSegmentQueryResult.valid (): Boolean; inline; begin result := (dist >= 0) and (flesh <> Default(ITP)); end;
579 // ////////////////////////////////////////////////////////////////////////// //
580 function TDynAABBTreeBase.TTreeNode.leaf (): Boolean; inline; begin result := (height = 0); end;
581 function TDynAABBTreeBase.TTreeNode.isfree (): Boolean; inline; begin result := (height = -1); end;
583 procedure TDynAABBTreeBase.TTreeNode.clear (); inline;
584 begin
585 parentId := 0;
586 children[0] := 0;
587 children[1] := 0;
588 flesh := Default(ITP);
589 tag := 0;
590 height := 0;
591 aabb.minX := 0;
592 aabb.minY := 0;
593 aabb.maxX := 0;
594 aabb.maxY := 0;
595 end;
597 procedure TDynAABBTreeBase.TTreeNode.dumpToLog ();
598 begin
599 e_WriteLog(Format('NODE: parentId=%d; children=[%d,%d]; height=%d; tag=%d; fleshX=%d; fleshY=%d; aabb=(%d,%d)-(%d,%d)',
600 [parentId, children[0], children[1], Integer(height), tag, fleshX, fleshY, aabb.minX, aabb.minY, aabb.maxX, aabb.maxY]),
601 MSG_NOTIFY);
602 end;
605 // ////////////////////////////////////////////////////////////////////////// //
606 // allocate and return a node to use in the tree
607 function TDynAABBTreeBase.allocateNode (): Integer;
608 var
609 i, newsz, freeNodeId: Integer;
610 node: PTreeNode;
611 begin
612 // if there is no more allocated node to use
613 if (mFreeNodeId = TTreeNode.NullTreeNode) then
614 begin
615 {$IFDEF aabbtree_many_asserts}assert(mNodeCount = mAllocCount);{$ENDIF}
616 // allocate more nodes in the tree
617 if (mAllocCount <= 16384) then newsz := mAllocCount*2 else newsz := mAllocCount+16384;
618 SetLength(mNodes, newsz);
619 mAllocCount := newsz;
620 // initialize the allocated nodes
621 for i := mNodeCount to mAllocCount-1 do
622 begin
623 mNodes[i].nextNodeId := i+1;
624 mNodes[i].height := -1;
625 end;
626 mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode;
627 mFreeNodeId := mNodeCount;
628 end;
629 // get the next free node
630 freeNodeId := mFreeNodeId;
631 {$IFDEF aabbtree_many_asserts}assert(freeNodeId < mAllocCount);{$ENDIF}
632 node := @mNodes[freeNodeId];
633 mFreeNodeId := node.nextNodeId;
634 node.clear();
635 node.parentId := TTreeNode.NullTreeNode;
636 node.height := 0;
637 Inc(mNodeCount);
638 result := freeNodeId;
640 //e_WriteLog(Format('tree: allocated node #%d', [result]), MSG_NOTIFY);
641 end;
644 // release a node
645 procedure TDynAABBTreeBase.releaseNode (nodeId: Integer);
646 begin
647 {$IFDEF aabbtree_many_asserts}assert(mNodeCount > 0);{$ENDIF}
648 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
649 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].height >= 0);{$ENDIF}
650 mNodes[nodeId].nextNodeId := mFreeNodeId;
651 mNodes[nodeId].height := -1;
652 mNodes[nodeId].flesh := Default(ITP);
653 mFreeNodeId := nodeId;
654 Dec(mNodeCount);
656 //e_WriteLog(Format('tree: released node #%d', [nodeId]), MSG_NOTIFY);
657 end;
660 // insert a leaf node in the tree
661 // 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
662 procedure TDynAABBTreeBase.insertLeafNode (nodeId: Integer);
663 var
664 newNodeAABB, mergedAABBs, currentAndLeftAABB, currentAndRightAABB: AABB2D;
665 currentNodeId: Integer;
666 leftChild, rightChild, siblingNode: Integer;
667 oldParentNode, newParentNode: Integer;
668 volumeAABB, mergedVolume: TreeNumber;
669 costS, costI, costLeft, costRight: TreeNumber;
670 begin
671 // if the tree is empty
672 if (mRootNodeId = TTreeNode.NullTreeNode) then
673 begin
674 mRootNodeId := nodeId;
675 mNodes[mRootNodeId].parentId := TTreeNode.NullTreeNode;
676 exit;
677 end;
679 {$IFDEF aabbtree_many_asserts}assert(mRootNodeId <> TTreeNode.NullTreeNode);{$ENDIF}
681 // find the best sibling node for the new node
682 newNodeAABB := AABB2D.Create(mNodes[nodeId].aabb);
683 currentNodeId := mRootNodeId;
684 while not mNodes[currentNodeId].leaf do
685 begin
686 leftChild := mNodes[currentNodeId].children[TTreeNode.Left];
687 rightChild := mNodes[currentNodeId].children[TTreeNode.Right];
689 // compute the merged AABB
690 volumeAABB := mNodes[currentNodeId].aabb.volume;
691 mergedAABBs := AABB2D.Create(mNodes[currentNodeId].aabb, newNodeAABB);
692 mergedVolume := mergedAABBs.volume;
694 // compute the cost of making the current node the sibling of the new node
695 costS := 2*mergedVolume;
697 // compute the minimum cost of pushing the new node further down the tree (inheritance cost)
698 costI := 2*(mergedVolume-volumeAABB);
700 // compute the cost of descending into the left child
701 currentAndLeftAABB := AABB2D.Create(newNodeAABB, mNodes[leftChild].aabb);
702 costLeft := currentAndLeftAABB.volume+costI;
703 if not mNodes[leftChild].leaf then costLeft -= mNodes[leftChild].aabb.volume;
705 // compute the cost of descending into the right child
706 currentAndRightAABB := AABB2D.Create(newNodeAABB, mNodes[rightChild].aabb);
707 costRight := currentAndRightAABB.volume+costI;
708 if not mNodes[rightChild].leaf then costRight -= mNodes[rightChild].aabb.volume;
710 // 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
711 if (costS < costLeft) and (costS < costRight) then break;
713 // it is cheaper to go down into a child of the current node, choose the best child
714 //currentNodeId = (costLeft < costRight ? leftChild : rightChild);
715 if (costLeft < costRight) then currentNodeId := leftChild else currentNodeId := rightChild;
716 end;
718 siblingNode := currentNodeId;
720 // create a new parent for the new node and the sibling node
721 oldParentNode := mNodes[siblingNode].parentId;
722 newParentNode := allocateNode();
723 mNodes[newParentNode].parentId := oldParentNode;
724 mNodes[newParentNode].aabb.setMergeTwo(mNodes[siblingNode].aabb, newNodeAABB);
725 mNodes[newParentNode].height := mNodes[siblingNode].height+1;
726 {$IFDEF aabbtree_many_asserts}assert(mNodes[newParentNode].height > 0);{$ENDIF}
728 // if the sibling node was not the root node
729 if (oldParentNode <> TTreeNode.NullTreeNode) then
730 begin
731 {$IFDEF aabbtree_many_asserts}assert(not mNodes[oldParentNode].leaf);{$ENDIF}
732 if (mNodes[oldParentNode].children[TTreeNode.Left] = siblingNode) then
733 begin
734 mNodes[oldParentNode].children[TTreeNode.Left] := newParentNode;
735 end
736 else
737 begin
738 mNodes[oldParentNode].children[TTreeNode.Right] := newParentNode;
739 end;
740 mNodes[newParentNode].children[TTreeNode.Left] := siblingNode;
741 mNodes[newParentNode].children[TTreeNode.Right] := nodeId;
742 mNodes[siblingNode].parentId := newParentNode;
743 mNodes[nodeId].parentId := newParentNode;
744 end
745 else
746 begin
747 // if the sibling node was the root node
748 mNodes[newParentNode].children[TTreeNode.Left] := siblingNode;
749 mNodes[newParentNode].children[TTreeNode.Right] := nodeId;
750 mNodes[siblingNode].parentId := newParentNode;
751 mNodes[nodeId].parentId := newParentNode;
752 mRootNodeId := newParentNode;
753 end;
755 // move up in the tree to change the AABBs that have changed
756 currentNodeId := mNodes[nodeId].parentId;
757 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
758 while (currentNodeId <> TTreeNode.NullTreeNode) do
759 begin
760 // balance the sub-tree of the current node if it is not balanced
761 currentNodeId := balanceSubTreeAtNode(currentNodeId);
762 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
764 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
765 leftChild := mNodes[currentNodeId].children[TTreeNode.Left];
766 rightChild := mNodes[currentNodeId].children[TTreeNode.Right];
767 {$IFDEF aabbtree_many_asserts}assert(leftChild <> TTreeNode.NullTreeNode);{$ENDIF}
768 {$IFDEF aabbtree_many_asserts}assert(rightChild <> TTreeNode.NullTreeNode);{$ENDIF}
770 // recompute the height of the node in the tree
771 mNodes[currentNodeId].height := dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height)+1;
772 {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF}
774 // recompute the AABB of the node
775 mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChild].aabb, mNodes[rightChild].aabb);
777 currentNodeId := mNodes[currentNodeId].parentId;
778 end;
780 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
781 end;
784 // remove a leaf node from the tree
785 procedure TDynAABBTreeBase.removeLeafNode (nodeId: Integer);
786 var
787 currentNodeId, parentNodeId, grandParentNodeId, siblingNodeId: Integer;
788 leftChildId, rightChildId: Integer;
789 begin
790 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
791 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
793 // if we are removing the root node (root node is a leaf in this case)
794 if (mRootNodeId = nodeId) then begin mRootNodeId := TTreeNode.NullTreeNode; exit; end;
796 parentNodeId := mNodes[nodeId].parentId;
797 grandParentNodeId := mNodes[parentNodeId].parentId;
799 if (mNodes[parentNodeId].children[TTreeNode.Left] = nodeId) then
800 begin
801 siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Right];
802 end
803 else
804 begin
805 siblingNodeId := mNodes[parentNodeId].children[TTreeNode.Left];
806 end;
808 // if the parent of the node to remove is not the root node
809 if (grandParentNodeId <> TTreeNode.NullTreeNode) then
810 begin
811 // destroy the parent node
812 if (mNodes[grandParentNodeId].children[TTreeNode.Left] = parentNodeId) then
813 begin
814 mNodes[grandParentNodeId].children[TTreeNode.Left] := siblingNodeId;
815 end
816 else
817 begin
818 {$IFDEF aabbtree_many_asserts}assert(mNodes[grandParentNodeId].children[TTreeNode.Right] = parentNodeId);{$ENDIF}
819 mNodes[grandParentNodeId].children[TTreeNode.Right] := siblingNodeId;
820 end;
821 mNodes[siblingNodeId].parentId := grandParentNodeId;
822 releaseNode(parentNodeId);
824 // 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
825 currentNodeId := grandParentNodeId;
826 while (currentNodeId <> TTreeNode.NullTreeNode) do
827 begin
828 // balance the current sub-tree if necessary
829 currentNodeId := balanceSubTreeAtNode(currentNodeId);
831 {$IFDEF aabbtree_many_asserts}assert(not mNodes[currentNodeId].leaf);{$ENDIF}
833 // get the two children of the current node
834 leftChildId := mNodes[currentNodeId].children[TTreeNode.Left];
835 rightChildId := mNodes[currentNodeId].children[TTreeNode.Right];
837 // recompute the AABB and the height of the current node
838 mNodes[currentNodeId].aabb.setMergeTwo(mNodes[leftChildId].aabb, mNodes[rightChildId].aabb);
839 mNodes[currentNodeId].height := dtMaxI(mNodes[leftChildId].height, mNodes[rightChildId].height)+1;
840 {$IFDEF aabbtree_many_asserts}assert(mNodes[currentNodeId].height > 0);{$ENDIF}
842 currentNodeId := mNodes[currentNodeId].parentId;
843 end;
844 end
845 else
846 begin
847 // if the parent of the node to remove is the root node, the sibling node becomes the new root node
848 mRootNodeId := siblingNodeId;
849 mNodes[siblingNodeId].parentId := TTreeNode.NullTreeNode;
850 releaseNode(parentNodeId);
851 end;
852 end;
855 // balance the sub-tree of a given node using left or right rotations
856 // the rotation schemes are described in the book "Introduction to Game Physics with Box2D" by Ian Parberry
857 // this method returns the new root node id
858 function TDynAABBTreeBase.balanceSubTreeAtNode (nodeId: Integer): Integer;
859 var
860 nodeA, nodeB, nodeC, nodeF, nodeG: PTreeNode;
861 nodeBId, nodeCId, nodeFId, nodeGId: Integer;
862 balanceFactor: Integer;
863 begin
864 {$IFDEF aabbtree_many_asserts}assert(nodeId <> TTreeNode.NullTreeNode);{$ENDIF}
866 nodeA := @mNodes[nodeId];
868 // if the node is a leaf or the height of A's sub-tree is less than 2
869 if (nodeA.leaf) or (nodeA.height < 2) then begin result := nodeId; exit; end; // do not perform any rotation
871 // get the two children nodes
872 nodeBId := nodeA.children[TTreeNode.Left];
873 nodeCId := nodeA.children[TTreeNode.Right];
874 {$IFDEF aabbtree_many_asserts}assert((nodeBId >= 0) and (nodeBId < mAllocCount));{$ENDIF}
875 {$IFDEF aabbtree_many_asserts}assert((nodeCId >= 0) and (nodeCId < mAllocCount));{$ENDIF}
876 nodeB := @mNodes[nodeBId];
877 nodeC := @mNodes[nodeCId];
879 // compute the factor of the left and right sub-trees
880 balanceFactor := nodeC.height-nodeB.height;
882 // if the right node C is 2 higher than left node B
883 if (balanceFactor > 1) then
884 begin
885 {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF}
887 nodeFId := nodeC.children[TTreeNode.Left];
888 nodeGId := nodeC.children[TTreeNode.Right];
889 {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF}
890 {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF}
891 nodeF := @mNodes[nodeFId];
892 nodeG := @mNodes[nodeGId];
894 nodeC.children[TTreeNode.Left] := nodeId;
895 nodeC.parentId := nodeA.parentId;
896 nodeA.parentId := nodeCId;
898 if (nodeC.parentId <> TTreeNode.NullTreeNode) then
899 begin
900 if (mNodes[nodeC.parentId].children[TTreeNode.Left] = nodeId) then
901 begin
902 mNodes[nodeC.parentId].children[TTreeNode.Left] := nodeCId;
903 end
904 else
905 begin
906 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeC.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF}
907 mNodes[nodeC.parentId].children[TTreeNode.Right] := nodeCId;
908 end;
909 end
910 else
911 begin
912 mRootNodeId := nodeCId;
913 end;
915 {$IFDEF aabbtree_many_asserts}assert(not nodeC.leaf);{$ENDIF}
916 {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF}
918 // if the right node C was higher than left node B because of the F node
919 if (nodeF.height > nodeG.height) then
920 begin
921 nodeC.children[TTreeNode.Right] := nodeFId;
922 nodeA.children[TTreeNode.Right] := nodeGId;
923 nodeG.parentId := nodeId;
925 // recompute the AABB of node A and C
926 nodeA.aabb.setMergeTwo(nodeB.aabb, nodeG.aabb);
927 nodeC.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb);
929 // recompute the height of node A and C
930 nodeA.height := dtMaxI(nodeB.height, nodeG.height)+1;
931 nodeC.height := dtMaxI(nodeA.height, nodeF.height)+1;
932 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
933 {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF}
934 end
935 else
936 begin
937 // if the right node C was higher than left node B because of node G
938 nodeC.children[TTreeNode.Right] := nodeGId;
939 nodeA.children[TTreeNode.Right] := nodeFId;
940 nodeF.parentId := nodeId;
942 // recompute the AABB of node A and C
943 nodeA.aabb.setMergeTwo(nodeB.aabb, nodeF.aabb);
944 nodeC.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb);
946 // recompute the height of node A and C
947 nodeA.height := dtMaxI(nodeB.height, nodeF.height)+1;
948 nodeC.height := dtMaxI(nodeA.height, nodeG.height)+1;
949 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
950 {$IFDEF aabbtree_many_asserts}assert(nodeC.height > 0);{$ENDIF}
951 end;
953 // return the new root of the sub-tree
954 result := nodeCId;
955 exit;
956 end;
958 // if the left node B is 2 higher than right node C
959 if (balanceFactor < -1) then
960 begin
961 {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF}
963 nodeFId := nodeB.children[TTreeNode.Left];
964 nodeGId := nodeB.children[TTreeNode.Right];
965 {$IFDEF aabbtree_many_asserts}assert((nodeFId >= 0) and (nodeFId < mAllocCount));{$ENDIF}
966 {$IFDEF aabbtree_many_asserts}assert((nodeGId >= 0) and (nodeGId < mAllocCount));{$ENDIF}
967 nodeF := @mNodes[nodeFId];
968 nodeG := @mNodes[nodeGId];
970 nodeB.children[TTreeNode.Left] := nodeId;
971 nodeB.parentId := nodeA.parentId;
972 nodeA.parentId := nodeBId;
974 if (nodeB.parentId <> TTreeNode.NullTreeNode) then
975 begin
976 if (mNodes[nodeB.parentId].children[TTreeNode.Left] = nodeId) then
977 begin
978 mNodes[nodeB.parentId].children[TTreeNode.Left] := nodeBId;
979 end
980 else
981 begin
982 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeB.parentId].children[TTreeNode.Right] = nodeId);{$ENDIF}
983 mNodes[nodeB.parentId].children[TTreeNode.Right] := nodeBId;
984 end;
985 end
986 else
987 begin
988 mRootNodeId := nodeBId;
989 end;
991 {$IFDEF aabbtree_many_asserts}assert(not nodeB.leaf);{$ENDIF}
992 {$IFDEF aabbtree_many_asserts}assert(not nodeA.leaf);{$ENDIF}
994 // if the left node B was higher than right node C because of the F node
995 if (nodeF.height > nodeG.height) then
996 begin
997 nodeB.children[TTreeNode.Right] := nodeFId;
998 nodeA.children[TTreeNode.Left] := nodeGId;
999 nodeG.parentId := nodeId;
1001 // recompute the AABB of node A and B
1002 nodeA.aabb.setMergeTwo(nodeC.aabb, nodeG.aabb);
1003 nodeB.aabb.setMergeTwo(nodeA.aabb, nodeF.aabb);
1005 // recompute the height of node A and B
1006 nodeA.height := dtMaxI(nodeC.height, nodeG.height)+1;
1007 nodeB.height := dtMaxI(nodeA.height, nodeF.height)+1;
1008 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1009 {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF}
1010 end
1011 else
1012 begin
1013 // if the left node B was higher than right node C because of node G
1014 nodeB.children[TTreeNode.Right] := nodeGId;
1015 nodeA.children[TTreeNode.Left] := nodeFId;
1016 nodeF.parentId := nodeId;
1018 // recompute the AABB of node A and B
1019 nodeA.aabb.setMergeTwo(nodeC.aabb, nodeF.aabb);
1020 nodeB.aabb.setMergeTwo(nodeA.aabb, nodeG.aabb);
1022 // recompute the height of node A and B
1023 nodeA.height := dtMaxI(nodeC.height, nodeF.height)+1;
1024 nodeB.height := dtMaxI(nodeA.height, nodeG.height)+1;
1025 {$IFDEF aabbtree_many_asserts}assert(nodeA.height > 0);{$ENDIF}
1026 {$IFDEF aabbtree_many_asserts}assert(nodeB.height > 0);{$ENDIF}
1027 end;
1029 // return the new root of the sub-tree
1030 result := nodeBId;
1031 exit;
1032 end;
1034 // if the sub-tree is balanced, return the current root node
1035 result := nodeId;
1036 end;
1039 // compute the height of a given node in the tree
1040 function TDynAABBTreeBase.computeHeight (nodeId: Integer): Integer;
1041 var
1042 node: PTreeNode;
1043 leftHeight, rightHeight: Integer;
1044 begin
1045 {$IFDEF aabbtree_many_asserts}assert((nodeId >= 0) and (nodeId < mAllocCount));{$ENDIF}
1046 node := @mNodes[nodeId];
1048 // if the node is a leaf, its height is zero
1049 if (node.leaf) then begin result := 0; exit; end;
1051 // compute the height of the left and right sub-tree
1052 leftHeight := computeHeight(node.children[TTreeNode.Left]);
1053 rightHeight := computeHeight(node.children[TTreeNode.Right]);
1055 // return the height of the node
1056 result := 1+dtMaxI(leftHeight, rightHeight);
1057 end;
1060 // internally add an object into the tree
1061 function TDynAABBTreeBase.insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
1062 var
1063 nodeId: Integer;
1064 node: PTreeNode;
1065 begin
1066 // get the next available node (or allocate new ones if necessary)
1067 nodeId := allocateNode();
1069 node := @mNodes[nodeId];
1071 // create the fat aabb to use in the tree
1072 node.aabb := AABB2D.Create(aabb);
1073 if (not staticObject) then
1074 begin
1075 node.aabb.minX -= mExtraGap;
1076 node.aabb.minY -= mExtraGap;
1077 node.aabb.maxX += mExtraGap;
1078 node.aabb.maxY += mExtraGap;
1079 end;
1081 // set the height of the node in the tree
1082 node.height := 0;
1084 // insert the new leaf node in the tree
1085 insertLeafNode(nodeId);
1087 {$IFDEF aabbtree_many_asserts}node := @mNodes[nodeId];{$ENDIF}
1088 {$IFDEF aabbtree_many_asserts}assert(node.leaf);{$ENDIF}
1090 // return the id of the node
1091 result := nodeId;
1092 end;
1095 // initialize the tree
1096 procedure TDynAABBTreeBase.setup ();
1097 var
1098 i: Integer;
1099 begin
1100 mRootNodeId := TTreeNode.NullTreeNode;
1101 mNodeCount := 0;
1102 mAllocCount := 8192;
1103 vstused := 0;
1105 SetLength(mNodes, mAllocCount);
1106 //memset(mNodes, 0, mAllocCount*TTreeNode.sizeof);
1107 for i := 0 to mAllocCount-1 do mNodes[i].clear();
1109 // initialize the allocated nodes
1110 for i := 0 to mAllocCount-1 do
1111 begin
1112 mNodes[i].nextNodeId := i+1;
1113 mNodes[i].height := -1;
1114 end;
1115 mNodes[mAllocCount-1].nextNodeId := TTreeNode.NullTreeNode;
1116 mFreeNodeId := 0;
1117 end;
1120 // also, checks if the tree structure is valid (for debugging purpose)
1121 function TDynAABBTreeBase.forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean;
1122 var
1123 pNode: PTreeNode;
1124 leftChild, rightChild, height: Integer;
1125 aabb: AABB2D;
1126 begin
1127 result := false;
1128 if (nodeId = TTreeNode.NullTreeNode) then exit;
1129 // if it is the root
1130 if (nodeId = mRootNodeId) then assert(mNodes[nodeId].parentId = TTreeNode.NullTreeNode);
1131 // get the children nodes
1132 pNode := @mNodes[nodeId];
1133 assert(pNode.height >= 0);
1134 if (not pNode.aabb.valid) then
1135 begin
1136 {$IFDEF aabbtree_use_floats}
1137 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);
1138 {$ELSE}
1139 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);
1140 {$ENDIF}
1141 if pNode.leaf then
1142 begin
1143 getFleshAABB(aabb, pNode.flesh, pNode.tag);
1144 {$IFDEF aabbtree_use_floats}
1145 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);
1146 {$ELSE}
1147 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);
1148 {$ENDIF}
1149 end;
1150 end;
1151 assert(pNode.aabb.valid);
1152 assert(pNode.aabb.volume > 0);
1153 // if the current node is a leaf
1154 if (pNode.leaf) then
1155 begin
1156 assert(pNode.height = 0);
1157 if assigned(dg) then result := dg(pNode.flesh, pNode.aabb);
1158 end
1159 else
1160 begin
1161 leftChild := pNode.children[TTreeNode.Left];
1162 rightChild := pNode.children[TTreeNode.Right];
1163 // check that the children node Ids are valid
1164 assert((0 <= leftChild) and (leftChild < mAllocCount));
1165 assert((0 <= rightChild) and (rightChild < mAllocCount));
1166 // check that the children nodes have the correct parent node
1167 assert(mNodes[leftChild].parentId = nodeId);
1168 assert(mNodes[rightChild].parentId = nodeId);
1169 // check the height of node
1170 height := 1+dtMaxI(mNodes[leftChild].height, mNodes[rightChild].height);
1171 assert(mNodes[nodeId].height = height);
1172 // check the AABB of the node
1173 aabb := AABB2D.Create(mNodes[leftChild].aabb, mNodes[rightChild].aabb);
1174 assert(aabb.minX = mNodes[nodeId].aabb.minX);
1175 assert(aabb.minY = mNodes[nodeId].aabb.minY);
1176 assert(aabb.maxX = mNodes[nodeId].aabb.maxX);
1177 assert(aabb.maxY = mNodes[nodeId].aabb.maxY);
1178 // recursively check the children nodes
1179 result := forEachNode(leftChild, dg);
1180 if not result then result := forEachNode(rightChild, dg);
1181 end;
1182 end;
1185 // also, checks if the tree structure is valid (for debugging purpose)
1186 function TDynAABBTreeBase.forEachLeaf (dg: TForEachLeafCB): Boolean;
1187 begin
1188 // recursively check each node
1189 result := forEachNode(mRootNodeId, dg);
1190 end;
1193 // return `true` from visitor to stop immediately
1194 // checker should check if this node should be considered to further checking
1195 // returns tree node if visitor says stop or -1
1196 function TDynAABBTreeBase.visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
1197 const
1198 StackGran = 1024;
1199 var
1200 oldvstused: Integer;
1201 vsp: Integer;
1202 vstk: array of Integer;
1203 nodeId: Integer;
1204 node: PTreeNode;
1205 doNode: Boolean = false;
1206 begin
1207 if not assigned(checker) then begin result := -1; exit; end;
1208 //if not assigned(visitor) and not assigned(visdg) then raise Exception.Create('dyntree: empty visitors aren''t supported');
1209 oldvstused := vstused;
1210 if (vstused+StackGran > Length(vstack)) then SetLength(vstack, vstused+StackGran);
1211 vsp := vstused;
1212 vstk := vstack;
1214 {$IFDEF aabbtree_query_count}
1215 mNodesVisited := 0;
1216 mNodesDeepVisited := 0;
1217 {$ENDIF}
1219 // start from root node
1220 // we can't have nested functions in generics, sorry
1221 {$IF FALSE}
1222 spush(mRootNodeId);
1223 {$ELSE}
1224 if (vsp >= Length(vstk)) then SetLength(vstk, vsp+StackGran);
1225 vstk[vsp] := mRootNodeId;
1226 Inc(vsp);
1227 {$ENDIF}
1229 // while there are still nodes to visit
1230 while (vsp > oldvstused) do
1231 begin
1232 // get the next node id to visit
1233 // we can't have nested functions in generics, sorry
1234 {$IF FALSE}
1235 nodeId := spop();
1236 {$ELSE}
1237 Dec(vsp);
1238 nodeId := vstk[vsp];
1239 {$ENDIF}
1240 // skip it if it is a nil node
1241 if (nodeId = TTreeNode.NullTreeNode) then continue;
1242 {$IFDEF aabbtree_query_count}Inc(mNodesVisited);{$ENDIF}
1243 // get the corresponding node
1244 node := @mNodes[nodeId];
1245 // should we investigate this node?
1246 case mode of
1247 ModeNoChecks: doNode := checker(node);
1248 ModeAABB:
1249 begin
1250 //doNode := caabb.overlaps(node.aabb);
1251 // this gives small speedup (or not...)
1252 // exit with no intersection if found separated along any axis
1253 if (caabb.maxX < node.aabb.minX) or (caabb.minX > node.aabb.maxX) then doNode := false
1254 else if (caabb.maxY < node.aabb.minY) or (caabb.minY > node.aabb.maxY) then doNode := false
1255 else doNode := true;
1256 end;
1257 ModePoint:
1258 begin
1259 //doNode := node.aabb.contains(caabb.minX, caabb.minY);
1260 // this gives small speedup
1261 doNode := (caabb.minX >= node.aabb.minX) and (caabb.minY >= node.aabb.minY) and (caabb.minX <= node.aabb.maxX) and (caabb.minY <= node.aabb.maxY);
1262 end;
1263 end;
1264 if doNode then
1265 begin
1266 // if the node is a leaf
1267 if (node.leaf) then
1268 begin
1269 // call visitor on it
1270 {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF}
1271 if (tagmask = -1) or ((node.tag and tagmask) <> 0) then
1272 begin
1273 doNode := false;
1274 // update object vars from cache, so recursive calls to `visit()` will work
1275 vstack := vstk;
1276 vstused := vsp;
1277 // call callbacks
1278 if assigned(visitor) then doNode := visitor(node.flesh, node.tag);
1279 if assigned(visdg) and visdg(node.flesh, node.tag) then doNode := true;
1280 // do some sanity checks
1281 if (vstused <> vsp) then raise Exception.Create('internal error in dyntree visitor');
1282 // should we exit?
1283 if doNode then
1284 begin
1285 result := nodeId;
1286 vstack := vstk;
1287 vstused := oldvstused;
1288 exit;
1289 end;
1290 end;
1291 end
1292 else
1293 begin
1294 // if the node is not a leaf, we need to visit its children
1295 // we can't have nested functions in generics, sorry
1296 {$IF FALSE}
1297 spush(node.children[TTreeNode.Left]);
1298 spush(node.children[TTreeNode.Right]);
1299 {$ELSE}
1300 if (vsp+2 > Length(vstk)) then SetLength(vstk, vsp+StackGran);
1301 vstk[vsp] := node.children[TTreeNode.Left];
1302 Inc(vsp);
1303 vstk[vsp] := node.children[TTreeNode.Right];
1304 Inc(vsp);
1305 {$ENDIF}
1306 end;
1307 end;
1308 end;
1310 result := -1; // oops
1311 vstack := vstk;
1312 vstused := oldvstused;
1313 end;
1316 // add `extraAABBGap` to bounding boxes so slight object movement won't cause tree rebuilds
1317 // 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
1318 constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0);
1319 begin
1320 mExtraGap := extraAABBGap;
1321 mNodes := nil;
1322 SetLength(vstack, 2048);
1323 vstused := 0;
1324 setup();
1325 end;
1328 destructor TDynAABBTreeBase.Destroy ();
1329 begin
1330 mNodes := nil;
1331 vstack := nil;
1332 inherited;
1333 end;
1336 // clear all the nodes and reset the tree
1337 procedure TDynAABBTreeBase.reset ();
1338 begin
1339 mNodes := nil;
1340 setup();
1341 end;
1344 function TDynAABBTreeBase.computeTreeHeight (): Integer; begin result := computeHeight(mRootNodeId); end;
1347 // return the root AABB of the tree
1348 procedure TDynAABBTreeBase.getRootAABB (out aabb: AABB2D);
1349 begin
1350 {$IFDEF aabbtree_many_asserts}assert((mRootNodeId >= 0) and (mRootNodeId < mAllocCount));{$ENDIF}
1351 aabb := mNodes[mRootNodeId].aabb;
1352 end;
1355 // does the given id represents a valid object?
1356 // WARNING: ids of removed objects can be reused on later insertions!
1357 function TDynAABBTreeBase.isValidId (id: Integer): Boolean;
1358 begin
1359 result := (id >= 0) and (id < mAllocCount) and (mNodes[id].leaf);
1360 end;
1363 // get object by nodeid; can return nil for invalid ids
1364 function TDynAABBTreeBase.getNodeObjectId (nodeid: Integer): TTreeFlesh;
1365 begin
1366 if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then result := mNodes[nodeid].flesh else result := Default(ITP);
1367 end;
1369 // get fat object AABB by nodeid; returns random shit for invalid ids
1370 procedure TDynAABBTreeBase.getNodeFatAABB (out aabb: AABB2D; nodeid: Integer);
1371 begin
1372 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);
1373 end;
1375 function TDynAABBTreeBase.getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
1376 begin
1377 if (nodeid >= 0) and (nodeid < mAllocCount) and (mNodes[nodeid].leaf) then
1378 begin
1379 result := true;
1380 {$IFDEF aabbtree_use_floats}
1381 x := round(mNodes[nodeid].fleshX);
1382 y := round(mNodes[nodeid].fleshY);
1383 {$ELSE}
1384 x := mNodes[nodeid].fleshX;
1385 y := mNodes[nodeid].fleshY;
1386 {$ENDIF}
1387 end
1388 else
1389 begin
1390 result := false;
1391 x := 0;
1392 y := 0;
1393 //if (nodeid >= 0) and (nodeid < mAllocCount) then mNodes[nodeid].dumpToLog();
1394 end;
1395 end;
1398 // insert an object into the tree
1399 // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error
1400 // AABB for static object will not be "fat" (simple optimization)
1401 // WARNING! inserting the same object several times *WILL* break everything!
1402 function TDynAABBTreeBase.insertObject (flesh: TTreeFlesh; tag: Integer; staticObject: Boolean=false): Integer;
1403 var
1404 aabb: AABB2D;
1405 nodeId, fx, fy: Integer;
1406 begin
1407 if not getFleshAABB(aabb, flesh, tag) then
1408 begin
1409 {$IFDEF aabbtree_use_floats}
1410 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);
1411 {$ELSE}
1412 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);
1413 {$ENDIF}
1414 //raise Exception.Create('trying to insert invalid flesh in dyntree');
1415 result := -1;
1416 exit;
1417 end;
1418 if not aabb.valid then
1419 begin
1420 {$IFDEF aabbtree_use_floats}
1421 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);
1422 {$ELSE}
1423 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);
1424 {$ENDIF}
1425 raise Exception.Create('trying to insert invalid aabb in dyntree');
1426 result := -1;
1427 exit;
1428 end;
1429 //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);
1430 fx := aabb.minX;
1431 fy := aabb.minY;
1432 nodeId := insertObjectInternal(aabb, staticObject);
1433 {$IFDEF aabbtree_many_asserts}assert(mNodes[nodeId].leaf);{$ENDIF}
1434 mNodes[nodeId].flesh := flesh;
1435 mNodes[nodeId].tag := tag;
1436 mNodes[nodeId].fleshX := fx;
1437 mNodes[nodeId].fleshY := fy;
1438 result := nodeId;
1439 end;
1442 // remove an object from the tree
1443 // WARNING: ids of removed objects can be reused on later insertions!
1444 procedure TDynAABBTreeBase.removeObject (nodeId: Integer);
1445 begin
1446 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase');
1447 // remove the node from the tree
1448 removeLeafNode(nodeId);
1449 releaseNode(nodeId);
1450 end;
1453 function TDynAABBTreeBase.updateObject (nodeId: Integer; forceReinsert: Boolean=false): Boolean; overload;
1454 var
1455 newAABB: AABB2D;
1456 dispX, dispY: TreeNumber;
1457 begin
1458 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject');
1460 if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject');
1461 if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject');
1463 dispX := newAABB.minX-mNodes[nodeId].fleshX;
1464 dispY := newAABB.minY-mNodes[nodeId].fleshY;
1466 if (dispX < -16) then dispX := -16 else if (dispX > 16) then dispX := 16;
1467 if (dispY < -16) then dispY := -16 else if (dispY > 16) then dispY := 16;
1469 result := updateObject(nodeId, dispX, dispY, forceReinsert);
1470 end;
1472 function TDynAABBTreeBase.updateObject (nodeId: Integer; dispX, dispY: TreeNumber; forceReinsert: Boolean=false): Boolean; overload;
1473 var
1474 newAABB: AABB2D;
1475 fx, fy: Integer;
1476 node: PTreeNode;
1477 begin
1478 if (nodeId < 0) or (nodeId >= mAllocCount) or (not mNodes[nodeId].leaf) then raise Exception.Create('invalid node id in TDynAABBTreeBase.updateObject');
1480 if not getFleshAABB(newAABB, mNodes[nodeId].flesh, mNodes[nodeId].tag) then raise Exception.Create('invalid flesh dimensions in TDynAABBTreeBase.updateObject');
1481 if not newAABB.valid then raise Exception.Create('invalid flesh aabb in TDynAABBTreeBase.updateObject');
1483 fx := newAABB.minX;
1484 fy := newAABB.minY;
1486 // if the new AABB is still inside the fat AABB of the node
1487 if (not forceReinsert) and (mNodes[nodeId].aabb.contains(newAABB)) then
1488 begin
1489 node := @mNodes[nodeId];
1490 node.fleshX := fx;
1491 node.fleshY := fy;
1492 result := false;
1493 exit;
1494 end;
1496 // if the new AABB is outside the fat AABB, we remove the corresponding node
1497 removeLeafNode(nodeId);
1499 node := @mNodes[nodeId];
1501 // compute the fat AABB by inflating the AABB with a constant gap
1502 node.aabb.copyFrom(newAABB);
1503 node.fleshX := fx;
1504 node.fleshY := fy;
1506 if (not forceReinsert) and ((dispX <> 0) or (dispY <> 0)) then
1507 begin
1508 node.aabb.minX -= mExtraGap;
1509 node.aabb.minY += mExtraGap;
1510 node.aabb.maxX += mExtraGap;
1511 node.aabb.maxY += mExtraGap;
1512 end;
1514 // inflate the fat AABB in direction of the linear motion of the AABB
1515 if (dispX < 0) then
1516 begin
1517 node.aabb.minX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1518 end
1519 else
1520 begin
1521 node.aabb.maxX += LinearMotionGapMultiplier*dispX {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1522 end;
1524 if (dispY < 0) then
1525 begin
1526 node.aabb.minY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1527 end
1528 else
1529 begin
1530 node.aabb.maxY += LinearMotionGapMultiplier*dispY {$IFDEF aabbtree_use_floats}{$ELSE}div 10{$ENDIF};
1531 end;
1533 {$IFDEF aabbtree_many_asserts}assert(node.aabb.contains(newAABB));{$ENDIF}
1535 // reinsert the node into the tree
1536 insertLeafNode(nodeId);
1538 result := true;
1539 end;
1542 function TDynAABBTreeBase.checkerAABB (node: PTreeNode): Boolean;
1543 begin
1544 result := chkAABB.overlaps(node.aabb);
1545 end;
1548 // report all shapes overlapping with the AABB given in parameter
1549 function TDynAABBTreeBase.aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
1550 var
1551 nid: Integer;
1552 oldaabb: AABB2D;
1553 begin
1554 result := Default(ITP);
1555 if not assigned(cb) then exit;
1556 if (aw < 1) or (ah < 1) then exit;
1557 //chkAABB := AABB2D.Create(ax, ay, ax+aw, ay+ah);
1558 oldaabb := chkAABB;
1559 chkAABB.minX := ax;
1560 chkAABB.minY := ay;
1561 chkAABB.maxX := ax+aw;
1562 chkAABB.maxY := ay+ah;
1563 nid := visit(chkAABB, ModeAABB, checkerAABB, cb, nil, tagmask);
1564 chkAABB := oldaabb;
1565 if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP);
1566 end;
1569 function TDynAABBTreeBase.checkerPoint (node: PTreeNode): Boolean;
1570 begin
1571 result := node.aabb.contains(chkAABB.minX, chkAABB.minY);
1572 end;
1575 // report body that contains the given point, or nil
1576 function TDynAABBTreeBase.pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
1577 var
1578 nid: Integer;
1579 oldaabb: AABB2D;
1580 begin
1581 oldaabb := chkAABB;
1582 chkAABB := AABB2D.Create(ax, ay, ax+1, ay+1);
1583 nid := visit(chkAABB, ModePoint, checkerPoint, cb, nil, tagmask);
1584 {$IFDEF aabbtree_many_asserts}assert((nid < 0) or ((nid >= 0) and (nid < mAllocCount) and (mNodes[nid].leaf)));{$ENDIF}
1585 chkAABB := oldaabb;
1586 if (nid >= 0) then result := mNodes[nid].flesh else result := Default(ITP);
1587 end;
1590 function TDynAABBTreeBase.checkerRay (node: PTreeNode): Boolean;
1591 begin
1592 result := node.aabb.intersects(curax, curay, curbx, curby);
1593 end;
1595 function TDynAABBTreeBase.visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean;
1596 var
1597 hitFraction: Single;
1598 begin
1599 hitFraction := sqcb(flesh, curax, curay, curbx, curby);
1600 // if the user returned a hitFraction of zero, it means that the raycasting should stop here
1601 if (hitFraction = 0.0) then
1602 begin
1603 qSRes.dist := 0;
1604 qSRes.flesh := flesh;
1605 result := true;
1606 exit;
1607 end;
1608 // if the user returned a positive fraction
1609 if (hitFraction > 0.0) then
1610 begin
1611 // we update the maxFraction value and the ray AABB using the new maximum fraction
1612 if (hitFraction < maxFraction) then
1613 begin
1614 maxFraction := hitFraction;
1615 qSRes.dist := hitFraction;
1616 qSRes.flesh := flesh;
1617 // fix curb here
1618 //curb := cura+dir*hitFraction;
1619 curbx := curax+dirx*hitFraction;
1620 curby := curay+diry*hitFraction;
1621 end;
1622 end;
1623 result := false; // continue
1624 end;
1627 // segment querying method
1628 function TDynAABBTreeBase.segmentQuery (out qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
1629 var
1630 oldmaxFraction: Single;
1631 oldcurax, oldcuray: Single;
1632 oldcurbx, oldcurby: Single;
1633 olddirx, olddiry: Single;
1634 invlen: Single;
1635 osres: PSegmentQueryResult;
1636 osqcb: TSegQueryCallback;
1637 begin
1638 qr := TSegmentQueryResult.Create(false);
1640 if (ax >= bx) or (ay >= by) then begin result := false; exit; end;
1642 oldmaxFraction := maxFraction;
1643 oldcurax := curax;
1644 oldcuray := curay;
1645 oldcurbx := curbx;
1646 oldcurby := curby;
1647 olddirx := dirx;
1648 olddiry := diry;
1650 maxFraction := 1.0e100; // infinity
1651 curax := ax;
1652 curay := ay;
1653 curbx := bx;
1654 curby := by;
1656 dirx := curbx-curax;
1657 diry := curby-curay;
1658 // normalize
1659 invlen := 1.0/sqrt(dirx*dirx+diry*diry);
1660 dirx *= invlen;
1661 diry *= invlen;
1663 //chkAABB := AABB2D.Create(0, 0, 1, 1);
1664 osres := qSRes;
1665 qSRes := @qr;
1666 osqcb := sqcb;
1667 sqcb := cb;
1668 visit(chkAABB, ModeNoChecks, checkerRay, nil, visitorRay, tagmask);
1669 qSRes := osres;
1670 sqcb := osqcb;
1672 curax := oldcurax;
1673 curay := oldcuray;
1674 curbx := oldcurbx;
1675 curby := oldcurby;
1676 dirx := olddirx;
1677 diry := olddiry;
1678 maxFraction := oldmaxFraction;
1680 result := qr.valid;
1681 end;
1684 end.