index 996230d258244b9fed0818eca65ab2ecb3a3074a..86e05680340dfa2af06d8c4fee175a4f48e80083 100644 (file)
--- a/src/game/z_aabbtree.pas
+++ b/src/game/z_aabbtree.pas
origX, origY: Single;
dirX, dirY: Single;
+ function getOrigN (idx: Integer): Single; inline;
+ function getDirN (idx: Integer): Single; inline;
+
public
constructor Create (ax, ay: Single; aangle: Single); overload;
constructor Create (ax0, ay0, ax1, ay1: Single); overload;
- constructor Create (var aray: Ray2D); overload;
+ constructor Create (constref aray: Ray2D); overload;
- procedure copyFrom (var aray: Ray2D); inline;
+ procedure copyFrom (constref aray: Ray2D); inline;
procedure normalizeDir (); inline;
procedure setXYAngle (ax, ay: Single; aangle: Single); inline;
procedure setX0Y0X1Y1 (ax0, ay0, ax1, ay1: Single); inline;
+
+ procedure atTime (time: Single; out rx, ry: Integer); inline;
+
+ property orig[idx: Integer]: Single read getOrigN;
+ property dir[idx: Integer]: Single read getDirN;
end;
// ////////////////////////////////////////////////////////////////////////// //
function getcenterY (): TreeNumber; inline;
function getextentX (): TreeNumber; inline;
function getextentY (): TreeNumber; inline;
+ function getMinN (idx: Integer): TreeNumber; inline;
+ function getMaxN (idx: Integer): TreeNumber; inline;
public
constructor Create (x0, y0, x1, y1: TreeNumber); overload;
- constructor Create (var aabb: AABB2D); overload;
- constructor Create (var aabb0, aabb1: AABB2D); overload;
+ constructor Create (constref aabb: AABB2D); overload;
+ constructor Create (constref aabb0, aabb1: AABB2D); overload;
constructor CreateWH (ax, ay, w, h: TreeNumber);
- procedure copyFrom (var aabb: AABB2D); inline;
+ procedure copyFrom (constref aabb: AABB2D); inline;
procedure setDims (x0, y0, x1, y1: TreeNumber); inline;
- procedure setMergeTwo (var aabb0, aabb1: AABB2D); inline;
+ procedure setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
function volume (): TreeNumber; inline;
- procedure merge (var aabb: AABB2D); inline;
+ procedure merge (constref aabb: AABB2D); inline;
// return true if the current AABB contains the AABB given in parameter
- function contains (var aabb: AABB2D): Boolean; inline; overload;
+ function contains (constref aabb: AABB2D): Boolean; inline; overload;
function contains (ax, ay: TreeNumber): Boolean; inline; overload;
// return true if the current AABB is overlapping with the AABB in parameter
// two AABBs overlap if they overlap in the two axes at the same time
- function overlaps (var aabb: AABB2D): Boolean; inline; overload;
+ function overlaps (constref aabb: AABB2D): Boolean; inline; overload;
// ray direction must be normalized
- function intersects (var ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
- function intersects (ax, ay, bx, by: Single): Boolean; inline; overload;
+ function intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
+ function intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload;
+ function intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload;
property valid: Boolean read getvalid;
property centerX: TreeNumber read getcenterX;
property centerY: TreeNumber read getcenterY;
property extentX: TreeNumber read getextentX;
property extentY: TreeNumber read getextentY;
+
+ property min[idx: Integer]: TreeNumber read getMinN;
+ property max[idx: Integer]: TreeNumber read getMaxN;
end;
public
// return `true` to stop
- type TForEachLeafCB = function (abody: TTreeFlesh; var aabb: AABB2D): Boolean is nested; // WARNING! don't modify AABB here!
+ type TForEachLeafCB = function (abody: TTreeFlesh; constref aabb: AABB2D): Boolean is nested; // WARNING! don't modify AABB here!
public
// in the broad-phase collision detection (dynamic AABB tree), the AABBs are
// called when a overlapping node has been found during the call to forEachAABBOverlap()
// return `true` to stop
type TQueryOverlapCB = function (abody: TTreeFlesh; atag: Integer): Boolean is nested;
- type TSegQueryCallback = function (abody: TTreeFlesh; ax, ay, bx, by: Single): Single is nested; // return dist from (ax,ay) to abody
+ type TSegQueryCallback = function (abody: TTreeFlesh; var ray: Ray2D): Single is nested; // return hit time
PSegmentQueryResult = ^TSegmentQueryResult;
TSegmentQueryResult = record
- dist: Single; // <0: nothing was hit
+ time: Single; // <0: nothing was hit
flesh: TTreeFlesh;
+ constructor Create (fuckyoufpc: Boolean);
procedure reset (); inline;
function valid (): Boolean; inline;
end;
curax, curay: Single;
curbx, curby: Single;
dirx, diry: Single;
+ traceRay: Ray2D;
sqcb: TSegQueryCallback;
+ vstack: array of Integer; // for `visit()`
+ vstused: Integer; // to support recursive queries
function checkerAABB (node: PTreeNode): Boolean;
function checkerPoint (node: PTreeNode): Boolean;
procedure removeLeafNode (nodeId: Integer);
function balanceSubTreeAtNode (nodeId: Integer): Integer;
function computeHeight (nodeId: Integer): Integer;
- function insertObjectInternal (var aabb: AABB2D; staticObject: Boolean): Integer;
+ function insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
procedure setup ();
- function visit (var caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
+ function visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
function forEachNode (nodeId: Integer; dg: TForEachLeafCB): Boolean;
procedure reset ();
function forEachLeaf (dg: TForEachLeafCB): Boolean; // WARNING! don't modify AABB/tree here!
- procedure getRootAABB (var aabb: AABB2D);
+ procedure getRootAABB (out aabb: AABB2D);
function isValidId (id: Integer): Boolean; inline;
function getNodeObjectId (nodeid: Integer): TTreeFlesh; inline;
- procedure getNodeFatAABB (var aabb: AABB2D; nodeid: Integer); inline;
+ procedure getNodeFatAABB (out aabb: AABB2D; nodeid: Integer); inline;
// returns `false` if nodeid is not leaf
function getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
function aabbQuery (ax, ay, aw, ah: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
function pointQuery (ax, ay: TreeNumber; cb: TQueryOverlapCB; tagmask: Integer=-1): TTreeFlesh;
- function segmentQuery (var qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
+ function segmentQuery (out qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
function computeTreeHeight (): Integer; // compute the height of the tree
function dtMinF (a, b: TreeNumber): TreeNumber; inline;
function dtMaxF (a, b: TreeNumber): TreeNumber; inline;
+function minSingle (a, b: Single): Single; inline;
+function maxSingle (a, b: Single): Single; inline;
+
implementation
@@ -338,14 +359,21 @@ function dtMaxI (a, b: Integer): Integer; inline; begin if (a > b) then result :
function dtMinF (a, b: TreeNumber): TreeNumber; inline; begin if (a < b) then result := a else result := b; end;
function dtMaxF (a, b: TreeNumber): TreeNumber; inline; begin if (a > b) then result := a else result := b; end;
+function minSingle (a, b: Single): Single; inline; begin if (a < b) then result := a else result := b; end;
+function maxSingle (a, b: Single): Single; inline; begin if (a > b) then result := a else result := b; end;
+
// ////////////////////////////////////////////////////////////////////////// //
constructor Ray2D.Create (ax, ay: Single; aangle: Single); begin setXYAngle(ax, ay, aangle); end;
constructor Ray2D.Create (ax0, ay0, ax1, ay1: Single); begin setX0Y0X1Y1(ax0, ay0, ax1, ay1); end;
-constructor Ray2D.Create (var aray: Ray2D); overload; begin copyFrom(aray); end;
+constructor Ray2D.Create (constref aray: Ray2D); overload; begin copyFrom(aray); end;
-procedure Ray2D.copyFrom (var aray: Ray2D); inline;
+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;
+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;
+
+
+procedure Ray2D.copyFrom (constref aray: Ray2D); inline;
begin
origX := aray.origX;
origY := aray.origY;
end;
+procedure Ray2D.atTime (time: Single; out rx, ry: Integer); inline;
+begin
+ rx := round(origX+dirX*time);
+ ry := round(origY+dirY*time);
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
constructor AABB2D.Create (x0, y0, x1, y1: TreeNumber); overload;
begin
setDims(x0, y0, x1, y1);
end;
-constructor AABB2D.Create (var aabb: AABB2D); overload;
+constructor AABB2D.Create (constref aabb: AABB2D); overload;
begin
copyFrom(aabb);
end;
-constructor AABB2D.Create (var aabb0, aabb1: AABB2D); overload;
+constructor AABB2D.Create (constref aabb0, aabb1: AABB2D); overload;
begin
setMergeTwo(aabb0, aabb1);
end;
@@ -416,7 +451,10 @@ function AABB2D.getcenterY (): TreeNumber; inline; begin result := (minY+maxY) d
function AABB2D.getextentX (): TreeNumber; inline; begin result := maxX-minX+1; end;
function AABB2D.getextentY (): TreeNumber; inline; begin result := maxY-minY+1; end;
-procedure AABB2D.copyFrom (var aabb: AABB2D); inline;
+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;
+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;
+
+procedure AABB2D.copyFrom (constref aabb: AABB2D); inline;
begin
minX := aabb.minX;
minY := aabb.minY;
end;
-procedure AABB2D.setMergeTwo (var aabb0, aabb1: AABB2D); inline;
+procedure AABB2D.setMergeTwo (constref aabb0, aabb1: AABB2D); inline;
begin
{$IF DEFINED(D2F_DEBUG)}
if not aabb0.valid then raise Exception.Create('setMergeTwo: aabb0 is fucked');
end;
-procedure AABB2D.merge (var aabb: AABB2D); inline;
+procedure AABB2D.merge (constref aabb: AABB2D); inline;
begin
{$IF DEFINED(D2F_DEBUG)}
if not aabb.valid then raise Exception.Create('merge: aabb is fucked');
end;
-function AABB2D.contains (var aabb: AABB2D): Boolean; inline; overload;
+function AABB2D.contains (constref aabb: AABB2D): Boolean; inline; overload;
begin
result :=
(aabb.minX >= minX) and (aabb.minY >= minY) and
end;
-function AABB2D.overlaps (var aabb: AABB2D): Boolean; inline; overload;
+function AABB2D.overlaps (constref aabb: AABB2D): Boolean; inline; overload;
begin
result := false;
// exit with no intersection if found separated along any axis
// something to consider here is that 0 * inf =nan which occurs when the ray starts exactly on the edge of a box
// https://tavianator.com/fast-branchless-raybounding-box-intersections-part-2-nans/
-function AABB2D.intersects (var ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
+{
+function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
var
dinv, t1, t2, tmp: Single;
tmin, tmax: Single;
result := false;
end;
end;
+}
+
+
+function AABB2D.intersects (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload;
+var
+ tmin, tmax, t1, t2, invd: Single;
+ i: Integer;
+begin
+ tmin := -1.0e100;
+ tmax := 1.0e100;
+ for i := 0 to 1 do
+ begin
+ if (ray.dir[i] <> 0.0) then
+ begin
+ //t1 := (self.min[i]-ray.orig[i])/ray.dir[i];
+ //t2 := (self.max[i]-ray.orig[i])/ray.dir[i];
+ invd := 1.0/ray.dir[i];
+ t1 := (self.min[i]-ray.orig[i])*invd;
+ t2 := (self.max[i]-ray.orig[i])*invd;
+ tmin := maxSingle(tmin, minSingle(t1, t2));
+ tmax := minSingle(tmax, maxSingle(t1, t2));
+ end
+ else if (ray.orig[i] <= self.min[i]) or (ray.orig[i] >= self.max[i]) then
+ begin
+ result := false;
+ exit;
+ end;
+ end;
+
+ result := (tmax > tmin) and (tmax > 0.0);
+ if result then
+ begin
+ if (tmino <> nil) then tmino^ := tmin;
+ if (tmaxo <> nil) then tmaxo^ := tmin;
+ end;
+end;
+
-function AABB2D.intersects (ax, ay, bx, by: Single): Boolean; inline; overload;
+function AABB2D.intersects (ax, ay, bx, by: Single; tmino: PSingle=nil): Boolean; inline; overload;
var
tmin: Single;
ray: Ray2D;
begin
result := true;
+ if (tmino <> nil) then tmino^ := 0.0;
// it may be faster to first check if start or end point is inside AABB (this is sometimes enough for dyntree)
if (ax >= minX) and (ay >= minY) and (ax <= maxX) and (ay <= maxY) then exit; // a
if (bx >= minX) and (by >= minY) and (bx <= maxX) and (by <= maxY) then exit; // b
// nope, do it hard way
ray := Ray2D.Create(ax, ay, bx, by);
- if not intersects(ray, @tmin) then begin result := false; exit; end;
+ if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := tmin; result := false; exit; end;
+ if (tmino <> nil) then tmino^ := tmin;
if (tmin < 0) then exit; // inside, just in case
- bx := bx-ax;
- by := by-ay;
+ bx -= ax;
+ by -= ay;
result := (tmin*tmin <= bx*bx+by*by);
end;
+function AABB2D.intersects (constref ray: Ray2D; maxtime: Single; tmino: PSingle=nil): Boolean; inline; overload;
+var
+ tmin: Single;
+begin
+ result := true;
+ if (ray.origX >= minX) and (ray.origY >= minY) and (ray.origX <= maxX) and (ray.origY <= maxY) then
+ begin
+ if (tmino <> nil) then tmino^ := 0.0;
+ exit;
+ end;
+ if not intersects(ray, @tmin) then begin if (tmino <> nil) then tmino^ := -1.0; result := false; exit; end;
+ if (tmin < 0) then tmin := 0; // inside
+ if (tmino <> nil) then tmino^ := tmin;
+ result := (tmin <= maxtime);
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
-procedure TDynAABBTreeBase.TSegmentQueryResult.reset (); inline; begin dist := -1; flesh := Default(ITP); end;
-function TDynAABBTreeBase.TSegmentQueryResult.valid (): Boolean; inline; begin result := (dist >= 0) and (flesh <> Default(ITP)); end;
+constructor TDynAABBTreeBase.TSegmentQueryResult.Create (fuckyoufpc: Boolean); begin time := -1; flesh := Default(ITP); end;
+procedure TDynAABBTreeBase.TSegmentQueryResult.reset (); inline; begin time := -1; flesh := Default(ITP); end;
+function TDynAABBTreeBase.TSegmentQueryResult.valid (): Boolean; inline; begin result := (time >= 0) and (flesh <> Default(ITP)); end;
// ////////////////////////////////////////////////////////////////////////// //
// internally add an object into the tree
-function TDynAABBTreeBase.insertObjectInternal (var aabb: AABB2D; staticObject: Boolean): Integer;
+function TDynAABBTreeBase.insertObjectInternal (constref aabb: AABB2D; staticObject: Boolean): Integer;
var
nodeId: Integer;
node: PTreeNode;
mRootNodeId := TTreeNode.NullTreeNode;
mNodeCount := 0;
mAllocCount := 8192;
+ vstused := 0;
SetLength(mNodes, mAllocCount);
//memset(mNodes, 0, mAllocCount*TTreeNode.sizeof);
// return `true` from visitor to stop immediately
// checker should check if this node should be considered to further checking
// returns tree node if visitor says stop or -1
-function TDynAABBTreeBase.visit (var caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
-var
- stack: array [0..2048] of Integer; // stack with the nodes to visit
- bigstack: array of Integer = nil;
- sp: Integer = 0;
-
- (*
- procedure spush (id: Integer); inline;
- var
- xsp: Integer;
- begin
- if (sp < length(stack)) then
- begin
- // use "small stack"
- stack[sp] := id;
- Inc(sp);
- end
- else
- begin
- // use "big stack"
- xsp := sp-length(stack);
- if (xsp < length(bigstack)) then
- begin
- // reuse
- bigstack[xsp] := id;
- end
- else
- begin
- // grow
- SetLength(bigstack, length(bigstack)+1);
- bigstack[high(bigstack)] := id;
- end;
- Inc(sp);
- end;
- end;
-
- function spop (): Integer; inline;
- begin
- //{$IFDEF aabbtree_many_asserts}assert(sp > 0);{$ENDIF}
- if (sp <= length(stack)) then
- begin
- // use "small stack"
- Dec(sp);
- result := stack[sp];
- end
- else
- begin
- // use "big stack"
- Dec(sp);
- result := bigstack[sp-length(stack)];
- end;
- end;
- *)
-
+function TDynAABBTreeBase.visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
+const
+ StackGran = 1024;
var
+ oldvstused: Integer;
+ vsp: Integer;
+ vstk: array of Integer;
nodeId: Integer;
node: PTreeNode;
doNode: Boolean = false;
- xsp: Integer;
begin
if not assigned(checker) then begin result := -1; exit; end;
//if not assigned(visitor) and not assigned(visdg) then raise Exception.Create('dyntree: empty visitors aren''t supported');
- //try
- {$IFDEF aabbtree_query_count}
- mNodesVisited := 0;
- mNodesDeepVisited := 0;
- {$ENDIF}
+ oldvstused := vstused;
+ if (vstused+StackGran > Length(vstack)) then SetLength(vstack, vstused+StackGran);
+ vsp := vstused;
+ vstk := vstack;
+
+ {$IFDEF aabbtree_query_count}
+ mNodesVisited := 0;
+ mNodesDeepVisited := 0;
+ {$ENDIF}
+
+ // start from root node
+ // we can't have nested functions in generics, sorry
+ {$IF FALSE}
+ spush(mRootNodeId);
+ {$ELSE}
+ if (vsp >= Length(vstk)) then SetLength(vstk, vsp+StackGran);
+ vstk[vsp] := mRootNodeId;
+ Inc(vsp);
+ {$ENDIF}
- // start from root node
+ // while there are still nodes to visit
+ while (vsp > oldvstused) do
+ begin
+ // get the next node id to visit
+ // we can't have nested functions in generics, sorry
{$IF FALSE}
- spush(mRootNodeId);
+ nodeId := spop();
{$ELSE}
- if (sp < length(stack)) then begin stack[sp] := mRootNodeId; Inc(sp); end
- else begin xsp := sp-length(stack); if (xsp < length(bigstack)) then bigstack[xsp] := mRootNodeId
- else begin SetLength(bigstack, length(bigstack)+1); bigstack[high(bigstack)] := mRootNodeId; end;
- end;
- Inc(sp);
+ Dec(vsp);
+ nodeId := vstk[vsp];
{$ENDIF}
-
- // while there are still nodes to visit
- while (sp > 0) do
+ // skip it if it is a nil node
+ if (nodeId = TTreeNode.NullTreeNode) then continue;
+ {$IFDEF aabbtree_query_count}Inc(mNodesVisited);{$ENDIF}
+ // get the corresponding node
+ node := @mNodes[nodeId];
+ // should we investigate this node?
+ case mode of
+ ModeNoChecks: doNode := checker(node);
+ ModeAABB:
+ begin
+ //doNode := caabb.overlaps(node.aabb);
+ // this gives small speedup (or not...)
+ // exit with no intersection if found separated along any axis
+ if (caabb.maxX < node.aabb.minX) or (caabb.minX > node.aabb.maxX) then doNode := false
+ else if (caabb.maxY < node.aabb.minY) or (caabb.minY > node.aabb.maxY) then doNode := false
+ else doNode := true;
+ end;
+ ModePoint:
+ begin
+ //doNode := node.aabb.contains(caabb.minX, caabb.minY);
+ // this gives small speedup
+ doNode := (caabb.minX >= node.aabb.minX) and (caabb.minY >= node.aabb.minY) and (caabb.minX <= node.aabb.maxX) and (caabb.minY <= node.aabb.maxY);
+ end;
+ end;
+ if doNode then
begin
- // get the next node id to visit
- {$IF FALSE}
- nodeId := spop();
- {$ELSE}
- if (sp <= length(stack)) then begin Dec(sp); nodeId := stack[sp]; end
- else begin Dec(sp); nodeId := bigstack[sp-length(stack)]; end;
- {$ENDIF}
- // skip it if it is a nil node
- if (nodeId = TTreeNode.NullTreeNode) then continue;
- {$IFDEF aabbtree_query_count}Inc(mNodesVisited);{$ENDIF}
- // get the corresponding node
- node := @mNodes[nodeId];
- // should we investigate this node?
- case mode of
- ModeNoChecks: doNode := checker(node);
- ModeAABB:
- begin
- //doNode := caabb.overlaps(node.aabb);
- // this gives small speedup (or not...)
- // exit with no intersection if found separated along any axis
- if (caabb.maxX < node.aabb.minX) or (caabb.minX > node.aabb.maxX) then doNode := false
- else if (caabb.maxY < node.aabb.minY) or (caabb.minY > node.aabb.maxY) then doNode := false
- else doNode := true;
- end;
- ModePoint:
- begin
- //doNode := node.aabb.contains(caabb.minX, caabb.minY);
- // this gives small speedup
- doNode := (caabb.minX >= node.aabb.minX) and (caabb.minY >= node.aabb.minY) and (caabb.minX <= node.aabb.maxX) and (caabb.minY <= node.aabb.maxY);
- end;
- end;
- if doNode then
+ // if the node is a leaf
+ if (node.leaf) then
begin
- // if the node is a leaf
- if (node.leaf) then
+ // call visitor on it
+ {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF}
+ if (tagmask = -1) or ((node.tag and tagmask) <> 0) then
begin
- // call visitor on it
- {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF}
- if (tagmask = -1) or ((node.tag and tagmask) <> 0) then
+ doNode := false;
+ // update object vars from cache, so recursive calls to `visit()` will work
+ vstack := vstk;
+ vstused := vsp;
+ // call callbacks
+ if assigned(visitor) then doNode := visitor(node.flesh, node.tag);
+ if assigned(visdg) and visdg(node.flesh, node.tag) then doNode := true;
+ // do some sanity checks
+ if (vstused <> vsp) then raise Exception.Create('internal error in dyntree visitor');
+ // should we exit?
+ if doNode then
begin
- if assigned(visitor) then
- begin
- if (visitor(node.flesh, node.tag)) then begin result := nodeId; bigstack := nil; exit; end;
- end;
- if assigned(visdg) then
- begin
- if (visdg(node.flesh, node.tag)) then begin result := nodeId; bigstack := nil; exit; end;
- end;
+ result := nodeId;
+ vstack := vstk;
+ vstused := oldvstused;
+ exit;
end;
- end
- else
- begin
- // if the node is not a leaf, we need to visit its children
- {$IF FALSE}
- spush(node.children[TTreeNode.Left]);
- spush(node.children[TTreeNode.Right]);
- {$ELSE}
- if (sp < length(stack)) then begin stack[sp] := node.children[TTreeNode.Left]; Inc(sp); end
- else begin xsp := sp-length(stack); if (xsp < length(bigstack)) then bigstack[xsp] := node.children[TTreeNode.Left]
- else begin SetLength(bigstack, length(bigstack)+1); bigstack[high(bigstack)] := node.children[TTreeNode.Left]; end;
- end;
- Inc(sp);
-
- if (sp < length(stack)) then begin stack[sp] := node.children[TTreeNode.Right]; Inc(sp); end
- else begin xsp := sp-length(stack); if (xsp < length(bigstack)) then bigstack[xsp] := node.children[TTreeNode.Right]
- else begin SetLength(bigstack, length(bigstack)+1); bigstack[high(bigstack)] := node.children[TTreeNode.Right]; end;
- end;
- Inc(sp);
-
- {$ENDIF}
end;
+ end
+ else
+ begin
+ // if the node is not a leaf, we need to visit its children
+ // we can't have nested functions in generics, sorry
+ {$IF FALSE}
+ spush(node.children[TTreeNode.Left]);
+ spush(node.children[TTreeNode.Right]);
+ {$ELSE}
+ if (vsp+2 > Length(vstk)) then SetLength(vstk, vsp+StackGran);
+ vstk[vsp] := node.children[TTreeNode.Left];
+ Inc(vsp);
+ vstk[vsp] := node.children[TTreeNode.Right];
+ Inc(vsp);
+ {$ENDIF}
end;
end;
+ end;
- result := -1; // oops
- bigstack := nil;
- //finally
- // bigstack := nil;
- //end;
+ result := -1; // oops
+ vstack := vstk;
+ vstused := oldvstused;
end;
constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0);
begin
mExtraGap := extraAABBGap;
+ mNodes := nil;
+ SetLength(vstack, 2048);
+ vstused := 0;
setup();
end;
destructor TDynAABBTreeBase.Destroy ();
begin
mNodes := nil;
+ vstack := nil;
inherited;
end;
@@ -1380,7 +1437,7 @@ function TDynAABBTreeBase.computeTreeHeight (): Integer; begin result := compute
// return the root AABB of the tree
-procedure TDynAABBTreeBase.getRootAABB (var aabb: AABB2D);
+procedure TDynAABBTreeBase.getRootAABB (out aabb: AABB2D);
begin
{$IFDEF aabbtree_many_asserts}assert((mRootNodeId >= 0) and (mRootNodeId < mAllocCount));{$ENDIF}
aabb := mNodes[mRootNodeId].aabb;
end;
// get fat object AABB by nodeid; returns random shit for invalid ids
-procedure TDynAABBTreeBase.getNodeFatAABB (var aabb: AABB2D; nodeid: Integer);
+procedure TDynAABBTreeBase.getNodeFatAABB (out aabb: AABB2D; nodeid: Integer);
begin
- if (nodeid >= 0) and (nodeid < mAllocCount) and (not mNodes[nodeid].isfree) then aabb.copyFrom(mNodes[nodeid].aabb) else aabb.setDims(0, 0, 0, 0);
+ 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);
end;
function TDynAABBTreeBase.getNodeXY (nodeid: Integer; out x, y: Integer): Boolean; inline;
function TDynAABBTreeBase.checkerRay (node: PTreeNode): Boolean;
+var
+ tmin: Single = 0;
begin
- result := node.aabb.intersects(curax, curay, curbx, curby);
+ {$IF FALSE}
+ result := node.aabb.intersects(curax, curay, curbx, curby, @tmin);
+ e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d', [
+ minSingle(curax, curbx),
+ minSingle(curay, curby),
+ maxSingle(curax, curbx),
+ maxSingle(curay, curby),
+ node.aabb.minX, node.aabb.minY,
+ node.aabb.maxX, node.aabb.maxY,
+ tmin,
+ Integer(result),
+ ]), MSG_NOTIFY);
+ {$ELSE}
+ result := node.aabb.intersects(traceRay, maxFraction, @tmin);
+ {
+ e_WriteLog(Format('intersect: (%f,%f)-(%f,%f) (%d,%d)-(%d,%d) tmin=%f res=%d frac=%f', [
+ curax, curay, curbx, curby,
+ node.aabb.minX, node.aabb.minY,
+ node.aabb.maxX, node.aabb.maxY,
+ tmin,
+ Integer(result),
+ maxFraction
+ ]), MSG_NOTIFY);
+ }
+ {$ENDIF}
end;
+
function TDynAABBTreeBase.visitorRay (flesh: TTreeFlesh; tag: Integer): Boolean;
var
hitFraction: Single;
+ ray: Ray2D;
begin
- hitFraction := sqcb(flesh, curax, curay, curbx, curby);
+ ray.origX := curax;
+ ray.origY := curay;
+ ray.dirX := dirx;
+ ray.dirY := diry;
+ hitFraction := sqcb(flesh, ray);
// if the user returned a hitFraction of zero, it means that the raycasting should stop here
if (hitFraction = 0.0) then
begin
- qSRes.dist := 0;
+ qSRes.time := 0;
qSRes.flesh := flesh;
result := true;
exit;
if (hitFraction < maxFraction) then
begin
maxFraction := hitFraction;
- qSRes.dist := hitFraction;
+ qSRes.time := hitFraction;
qSRes.flesh := flesh;
// fix curb here
//curb := cura+dir*hitFraction;
// segment querying method
-function TDynAABBTreeBase.segmentQuery (var qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
+function TDynAABBTreeBase.segmentQuery (out qr: TSegmentQueryResult; ax, ay, bx, by: TreeNumber; cb: TSegQueryCallback; tagmask: Integer=-1): Boolean;
var
oldmaxFraction: Single;
oldcurax, oldcuray: Single;
invlen: Single;
osres: PSegmentQueryResult;
osqcb: TSegQueryCallback;
+ oldray: Ray2D;
begin
- qr.reset();
+ qr := TSegmentQueryResult.Create(false);
- if (ax >= bx) or (ay >= by) then begin result := false; exit; end;
+ if (ax = bx) and (ay = by) then begin result := false; exit; end;
oldmaxFraction := maxFraction;
oldcurax := curax;
oldcurby := curby;
olddirx := dirx;
olddiry := diry;
+ oldray := traceRay;
maxFraction := 1.0e100; // infinity
curax := ax;
dirx *= invlen;
diry *= invlen;
+ traceRay.origX := curax;
+ traceRay.origY := curay;
+ traceRay.dirX := dirx;
+ traceRay.dirY := diry;
+
//chkAABB := AABB2D.Create(0, 0, 1, 1);
osres := qSRes;
qSRes := @qr;
dirx := olddirx;
diry := olddiry;
maxFraction := oldmaxFraction;
+ traceRay := oldray;
result := qr.valid;
end;