index 298fa34f4775b23f2875ceb0789d261721bc37c4..6f2168d33814355f6f79332c4170bc2af187161d 100644 (file)
--- a/src/game/z_aabbtree.pas
+++ b/src/game/z_aabbtree.pas
dist: Single; // <0: nothing was hit
flesh: TTreeFlesh;
+ constructor Create (fuckyoufpc: Boolean);
procedure reset (); inline;
function valid (): Boolean; inline;
end;
curbx, curby: Single;
dirx, diry: Single;
sqcb: TSegQueryCallback;
+ vstack: array of Integer; // for `visit()`
+ vstused: Integer; // to support recursive queries
function checkerAABB (node: PTreeNode): Boolean;
function checkerPoint (node: PTreeNode): Boolean;
// ////////////////////////////////////////////////////////////////////////// //
+constructor TDynAABBTreeBase.TSegmentQueryResult.Create (fuckyoufpc: Boolean); begin dist := -1; flesh := Default(ITP); 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;
mRootNodeId := TTreeNode.NullTreeNode;
mNodeCount := 0;
mAllocCount := 8192;
+ vstused := 0;
SetLength(mNodes, mAllocCount);
//memset(mNodes, 0, mAllocCount*TTreeNode.sizeof);
// checker should check if this node should be considered to further checking
// returns tree node if visitor says stop or -1
function TDynAABBTreeBase.visit (constref caabb: AABB2D; mode: Integer; checker: TVisitCheckerCB; visitor: TQueryOverlapCB; visdg: TQueryOverlapDg; tagmask: Integer): Integer;
+const
+ StackGran = 1024;
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;
- *)
-
-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
+ // 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}
+
+ // 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;
// get fat object AABB by nodeid; returns random shit for invalid ids
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;
osres: PSegmentQueryResult;
osqcb: TSegQueryCallback;
begin
- qr.reset();
+ qr := TSegmentQueryResult.Create(false);
if (ax >= bx) or (ay >= by) then begin result := false; exit; end;