X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fz_aabbtree.pas;h=79d9d8a62eeb8d58855e7e9e123c020e87fb093e;hb=a9c0a618b01fb1e51cc953ff8295f888890cc967;hp=3371a1ea82e90e17db293748e4c43b581ba4ce72;hpb=c9a3e1f751cfbf8645a4e75b43204151a5eb962f;p=d2df-sdl.git diff --git a/src/game/z_aabbtree.pas b/src/game/z_aabbtree.pas index 3371a1e..79d9d8a 100644 --- a/src/game/z_aabbtree.pas +++ b/src/game/z_aabbtree.pas @@ -40,9 +40,9 @@ type 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; @@ -65,28 +65,30 @@ type 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; - procedure copyFrom (var aabb: AABB2D); inline; + constructor CreateWH (ax, ay, w, h: TreeNumber); + + 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 (constref ray: Ray2D; tmino: PSingle=nil; tmaxo: PSingle=nil): Boolean; overload; function intersects (ax, ay, bx, by: Single): Boolean; inline; overload; property valid: Boolean read getvalid; @@ -177,7 +179,7 @@ type 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 @@ -200,6 +202,7 @@ type dist: Single; // <0: nothing was hit flesh: TTreeFlesh; + constructor Create (fuckyoufpc: Boolean); procedure reset (); inline; function valid (): Boolean; inline; end; @@ -223,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; @@ -238,9 +243,9 @@ type 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; @@ -257,11 +262,11 @@ type 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; @@ -273,7 +278,7 @@ type // this method creates a new leaf node in the tree and returns the id of the corresponding node or -1 on error // AABB for static object will not be "fat" (simple optimization) // WARNING! inserting the same object several times *WILL* break everything! - function insertObject (flesh: TTreeFlesh; tag: Integer; staticObject: Boolean=false): Integer; + function insertObject (flesh: TTreeFlesh; tag: Integer=-1; staticObject: Boolean=false): Integer; // remove an object from the tree // WARNING: ids of removed objects can be reused on later insertions! @@ -299,7 +304,7 @@ type 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 @@ -340,10 +345,10 @@ function dtMaxF (a, b: TreeNumber): TreeNumber; inline; begin if (a > b) then re // ////////////////////////////////////////////////////////////////////////// // 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; +procedure Ray2D.copyFrom (constref aray: Ray2D); inline; begin origX := aray.origX; origY := aray.origY; @@ -384,16 +389,24 @@ 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; +constructor AABB2D.CreateWH (ax, ay, w, h: TreeNumber); +begin + minX := ax; + minY := ay; + maxX := ax+w-1; + maxY := ay+h-1; +end; + function AABB2D.getvalid (): Boolean; inline; begin result := (minX <= maxX) and (minY <= maxY); end; {$IFDEF aabbtree_use_floats} @@ -406,7 +419,7 @@ 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; +procedure AABB2D.copyFrom (constref aabb: AABB2D); inline; begin minX := aabb.minX; minY := aabb.minY; @@ -430,7 +443,7 @@ begin 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'); @@ -452,7 +465,7 @@ begin 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'); @@ -467,7 +480,7 @@ begin 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 @@ -481,7 +494,7 @@ begin 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 @@ -493,7 +506,7 @@ end; // 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; @@ -558,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; @@ -1044,7 +1058,7 @@ 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; @@ -1086,6 +1100,7 @@ begin mRootNodeId := TTreeNode.NullTreeNode; mNodeCount := 0; mAllocCount := 8192; + vstused := 0; SetLength(mNodes, mAllocCount); //memset(mNodes, 0, mAllocCount*TTreeNode.sizeof); @@ -1178,68 +1193,19 @@ end; // 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; 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'); + oldvstused := vstused; + if (vstused+StackGran > Length(vstack)) then SetLength(vstack, vstused+StackGran); //try {$IFDEF aabbtree_query_count} mNodesVisited := 0; @@ -1247,25 +1213,25 @@ begin {$ENDIF} // start from root node + // we can't have nested functions in generics, sorry {$IF FALSE} spush(mRootNodeId); {$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); + if (vstused >= Length(vstack)) then SetLength(vstack, vstused+StackGran); + vstack[vstused] := mRootNodeId; + Inc(vstused); {$ENDIF} // while there are still nodes to visit - while (sp > 0) do + while (vstused > oldvstused) do begin // get the next node id to visit + // we can't have nested functions in generics, sorry {$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; + Dec(vstused); + nodeId := vstack[vstused]; {$ENDIF} // skip it if it is a nil node if (nodeId = TTreeNode.NullTreeNode) then continue; @@ -1298,44 +1264,38 @@ begin begin // call visitor on it {$IFDEF aabbtree_query_count}Inc(mNodesDeepVisited);{$ENDIF} - if ((node.tag and tagmask) <> 0) then + if (tagmask = -1) or ((node.tag and tagmask) <> 0) then begin if assigned(visitor) then begin - if (visitor(node.flesh, node.tag)) then begin result := nodeId; bigstack := nil; exit; end; + if (visitor(node.flesh, node.tag)) then begin result := nodeId; vstused := oldvstused; exit; end; end; if assigned(visdg) then begin - if (visdg(node.flesh, node.tag)) then begin result := nodeId; bigstack := nil; exit; end; + if (visdg(node.flesh, node.tag)) then begin result := nodeId; vstused := oldvstused; exit; end; end; 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 (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); - + if (vstused+2 > Length(vstack)) then SetLength(vstack, vstused+StackGran); + vstack[vstused] := node.children[TTreeNode.Left]; + Inc(vstused); + vstack[vstused] := node.children[TTreeNode.Right]; + Inc(vstused); {$ENDIF} end; end; end; result := -1; // oops - bigstack := nil; + vstused := oldvstused; //finally // bigstack := nil; //end; @@ -1347,6 +1307,9 @@ end; constructor TDynAABBTreeBase.Create (extraAABBGap: TreeNumber=0); begin mExtraGap := extraAABBGap; + mNodes := nil; + SetLength(vstack, 2048); + vstused := 0; setup(); end; @@ -1354,6 +1317,7 @@ end; destructor TDynAABBTreeBase.Destroy (); begin mNodes := nil; + vstack := nil; inherited; end; @@ -1370,7 +1334,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; @@ -1392,9 +1356,9 @@ begin 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; @@ -1650,7 +1614,7 @@ end; // 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; @@ -1660,7 +1624,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;