X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fz_aabbtree.pas;h=6f2168d33814355f6f79332c4170bc2af187161d;hb=7ebb5abeb2dcae6370526c73400a9d9b21c21bb8;hp=298fa34f4775b23f2875ceb0789d261721bc37c4;hpb=58b15f7d5aee8dc280a2e407c11a1f0448eea7ef;p=d2df-sdl.git diff --git a/src/game/z_aabbtree.pas b/src/game/z_aabbtree.pas index 298fa34..6f2168d 100644 --- a/src/game/z_aabbtree.pas +++ b/src/game/z_aabbtree.pas @@ -202,6 +202,7 @@ type dist: Single; // <0: nothing was hit flesh: TTreeFlesh; + constructor Create (fuckyoufpc: Boolean); procedure reset (); inline; function valid (): Boolean; inline; end; @@ -225,6 +226,8 @@ type 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; @@ -568,6 +571,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // +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; @@ -1096,6 +1100,7 @@ begin mRootNodeId := TTreeNode.NullTreeNode; mNodeCount := 0; mAllocCount := 8192; + vstused := 0; SetLength(mNodes, mAllocCount); //memset(mNodes, 0, mAllocCount*TTreeNode.sizeof); @@ -1189,166 +1194,122 @@ end; // 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; @@ -1357,6 +1318,9 @@ end; constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0); begin mExtraGap := extraAABBGap; + mNodes := nil; + SetLength(vstack, 2048); + vstused := 0; setup(); end; @@ -1364,6 +1328,7 @@ end; destructor TDynAABBTreeBase.Destroy (); begin mNodes := nil; + vstack := nil; inherited; end; @@ -1404,7 +1369,7 @@ 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; @@ -1670,7 +1635,7 @@ var osres: PSegmentQueryResult; osqcb: TSegQueryCallback; begin - qr.reset(); + qr := TSegmentQueryResult.Create(false); if (ax >= bx) or (ay >= by) then begin result := false; exit; end;