d1149adf46c64d47c5790f5731c2ea56e90ea278
1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
16 // universal spatial grid
17 {$INCLUDE ../shared/a_modes.inc}
18 {$DEFINE grid_use_buckets}
25 TBodyProxyId
= Integer;
27 generic TBodyGridBase
<ITP
> = class(TObject
)
29 type TGridQueryCB
= function (obj
: ITP
; tag
: Integer): Boolean is nested
; // return `true` to stop
33 GridDefaultTileSize
= 32;
34 GridCellBucketSize
= 8; // WARNING! can't be less than 2!
38 PBodyProxyRec
= ^TBodyProxyRec
;
39 TBodyProxyRec
= record
41 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
42 mQueryMark
: DWord
; // was this object visited at this query?
45 nextLink
: TBodyProxyId
; // next free or nothing
48 procedure setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
51 PGridCell
= ^TGridCell
;
53 {$IFDEF grid_use_buckets}
54 bodies
: array [0..GridCellBucketSize
-1] of Integer; // -1: end of list
58 next
: Integer; // in this cell; index in mCells
61 TGridInternalCB
= function (grida
: Integer): Boolean of object; // return `true` to stop
65 mMinX
, mMinY
: Integer; // so grids can start at any origin
66 mWidth
, mHeight
: Integer; // in tiles
67 mGrid
: array of Integer; // mWidth*mHeight, index in mCells
68 mCells
: array of TGridCell
; // cell pool
69 mFreeCell
: Integer; // first free cell index or -1
72 mProxies
: array of TBodyProxyRec
;
73 mProxyFree
: TBodyProxyId
; // free
74 mProxyCount
: Integer; // currently used
75 mProxyMaxCount
: Integer;
77 mUData
: TBodyProxyId
; // for inserter/remover
78 mTagMask
: Integer; // for iterator
79 mItCB
: TGridQueryCB
; // for iterator
82 function allocCell
: Integer;
83 procedure freeCell (idx
: Integer); // `next` is simply overwritten
85 function allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
86 procedure freeProxy (body
: TBodyProxyId
);
88 procedure insert (body
: TBodyProxyId
);
89 procedure remove (body
: TBodyProxyId
);
91 function forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
): Boolean;
93 function inserter (grida
: Integer): Boolean;
94 function remover (grida
: Integer): Boolean;
95 function iterator (grida
: Integer): Boolean;
98 constructor Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer; aTileSize
: Integer=GridDefaultTileSize
);
99 destructor Destroy (); override;
101 function insertBody (aObj
: ITP
; ax
, ay
, aWidth
, aHeight
: Integer; aTag
: Integer=0): TBodyProxyId
;
102 procedure removeBody (aObj
: TBodyProxyId
); // WARNING! this WILL destroy proxy!
104 procedure moveBody (body
: TBodyProxyId
; dx
, dy
: Integer);
105 procedure resizeBody (body
: TBodyProxyId
; sx
, sy
: Integer);
106 procedure moveResizeBody (body
: TBodyProxyId
; dx
, dy
, sx
, sy
: Integer);
108 function forEachInAABB (x
, y
, w
, h
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): Boolean;
110 procedure dumpStats ();
120 // ////////////////////////////////////////////////////////////////////////// //
121 procedure TBodyGridBase
.TBodyProxyRec
.setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
134 // ////////////////////////////////////////////////////////////////////////// //
135 constructor TBodyGridBase
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer; aTileSize
: Integer=GridDefaultTileSize
);
139 if aTileSize
< 1 then aTileSize
:= 1;
140 if aTileSize
> 8192 then aTileSize
:= 8192; // arbitrary limit
141 if aPixWidth
< aTileSize
then aPixWidth
:= aTileSize
;
142 if aPixHeight
< aTileSize
then aPixHeight
:= aTileSize
;
143 mTileSize
:= aTileSize
;
146 mWidth
:= (aPixWidth
+aTileSize
-1) div aTileSize
;
147 mHeight
:= (aPixHeight
+aTileSize
-1) div aTileSize
;
148 SetLength(mGrid
, mWidth
*mHeight
);
149 SetLength(mCells
, mWidth
*mHeight
);
150 SetLength(mProxies
, 8192);
153 for idx
:= 0 to High(mCells
) do
155 {$IFDEF grid_use_buckets}
156 mCells
[idx
].bodies
[0] := -1;
158 mCells
[idx
].body
:= -1;
160 mCells
[idx
].next
:= idx
+1;
162 mCells
[High(mCells
)].next
:= -1; // last cell
164 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
166 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
167 mProxies
[High(mProxies
)].nextLink
:= -1;
176 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
]), MSG_NOTIFY
);
180 destructor TBodyGridBase
.Destroy ();
189 procedure TBodyGridBase
.dumpStats ();
191 idx
, mcb
, cidx
, cnt
: Integer;
194 for idx
:= 0 to High(mGrid
) do
201 cidx
:= mCells
[cidx
].next
;
203 if (mcb
< cnt
) then mcb
:= cnt
;
205 e_WriteLog(Format('grid size: %dx%d (tile size: %d); pix: %dx%d; used cells: %d; max bodies in cell: %d; max proxies allocated: %d; proxies used: %d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
, mUsedCells
, mcb
, mProxyMaxCount
, mProxyCount
]), MSG_NOTIFY
);
209 function TBodyGridBase
.allocCell
: Integer;
213 if (mFreeCell
< 0) then
215 // no free cells, want more
216 mFreeCell
:= Length(mCells
);
217 SetLength(mCells
, mFreeCell
+32768); // arbitrary number
218 for idx
:= mFreeCell
to High(mCells
) do
220 {$IFDEF grid_use_buckets}
221 mCells
[idx
].bodies
[0] := -1;
223 mCells
[idx
].body
:= -1;
225 mCells
[idx
].next
:= idx
+1;
227 mCells
[High(mCells
)].next
:= -1; // last cell
230 mFreeCell
:= mCells
[result
].next
;
231 mCells
[result
].next
:= -1;
233 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
237 procedure TBodyGridBase
.freeCell (idx
: Integer);
239 if (idx
>= 0) and (idx
< High(mCells
)) then
241 //if mCells[idx].body = -1 then exit; // the thing that should not be
242 //mCells[idx].body := -1;
243 mCells
[idx
].next
:= mFreeCell
;
250 function TBodyGridBase
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
255 if (mProxyFree
= -1) then
257 // no free proxies, resize list
258 olen
:= Length(mProxies
);
259 SetLength(mProxies
, olen
+8192); // arbitrary number
260 for idx
:= olen
to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
261 mProxies
[High(mProxies
)].nextLink
:= -1;
265 result
:= mProxyFree
;
266 px
:= @mProxies
[result
];
267 mProxyFree
:= px
.nextLink
;
268 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
273 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
276 procedure TBodyGridBase
.freeProxy (body
: TBodyProxyId
);
278 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
279 if (mProxyCount
= 0) then raise Exception
.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
281 mProxies
[body
].mObj
:= nil;
282 mProxies
[body
].nextLink
:= mProxyFree
;
288 function TBodyGridBase
.forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
): Boolean;
293 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
298 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
299 if (x
>= mWidth
*mTileSize
) or (y
>= mHeight
*mTileSize
) then exit
;
300 for gy
:= y
div mTileSize
to (y
+h
-1) div mTileSize
do
302 if (gy
< 0) then continue
;
303 if (gy
>= mHeight
) then break
;
304 for gx
:= x
div mTileSize
to (x
+w
-1) div mTileSize
do
306 if (gx
< 0) then continue
;
307 if (gx
>= mWidth
) then break
;
308 if (cb(gy
*mWidth
+gx
)) then begin result
:= true; exit
; end;
314 function TBodyGridBase
.inserter (grida
: Integer): Boolean;
318 {$IFDEF grid_use_buckets}
323 result
:= false; // never stop
324 // add body to the given grid cell
326 {$IFDEF grid_use_buckets}
331 for f
:= 0 to High(TGridCell
.bodies
) do
333 if (pi
.bodies
[f
] = -1) then
336 pi
.bodies
[f
] := mUData
;
337 if (f
+1 < Length(TGridCell
.bodies
)) then pi
.bodies
[f
+1] := -1;
342 // either no room, or no cell at all
344 mCells
[cidx
].bodies
[0] := mUData
;
345 mCells
[cidx
].bodies
[1] := -1;
346 mCells
[cidx
].next
:= pc
^;
350 //e_WriteLog(Format(' 01: allocated cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
351 mCells
[cidx
].body
:= mUData
;
352 mCells
[cidx
].next
:= pc
^;
358 procedure TBodyGridBase
.insert (body
: TBodyProxyId
);
363 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
364 px
:= @mProxies
[body
];
367 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, inserter
);
372 function TBodyGridBase
.remover (grida
: Integer): Boolean;
374 pidx
, idx
, tmp
, f
: Integer;
377 result
:= false; // never stop
378 // find and remove cell
383 tmp
:= mCells
[idx
].next
;
384 {$IFDEF grid_use_buckets}
387 while (f
< High(TGridCell
.bodies
)) do
389 if (pc
.bodies
[f
] = mUData
) then
392 if (f
= 0) and (pc
.bodies
[1] = -1) then
394 // this cell contains no elements, remove it
395 tmp
:= mCells
[idx
].next
;
396 if (pidx
= -1) then mGrid
[grida
] := tmp
else mCells
[pidx
].next
:= tmp
;
401 // remove element from bucket
403 while (f
< High(TGridCell
.bodies
)) do
405 pc
.bodies
[f
-1] := pc
.bodies
[f
];
406 if (pc
.bodies
[f
] = -1) then break
;
409 pc
.bodies
[High(TGridCell
.bodies
)] := -1; // just in case
411 exit
; // assume that we cannot have one object added to bucket twice
416 if (mCells
[idx
].body
= mUData
) then
418 if (pidx
= -1) then mGrid
[grida
] := tmp
else mCells
[pidx
].next
:= tmp
;
420 exit
; // assume that we cannot have one object added to bucket twice
429 // absolutely not tested
430 procedure TBodyGridBase
.remove (body
: TBodyProxyId
);
435 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
436 px
:= @mProxies
[body
];
439 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
);
444 function TBodyGridBase
.insertBody (aObj
: ITP
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=0): TBodyProxyId
;
446 result
:= allocProxy(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
451 procedure TBodyGridBase
.removeBody (aObj
: TBodyProxyId
);
453 if (aObj
< 0) or (aObj
> High(mProxies
)) then exit
; // just in case
459 procedure TBodyGridBase
.moveResizeBody (body
: TBodyProxyId
; dx
, dy
, sx
, sy
: Integer);
463 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
464 if ((dx
= 0) and (dy
= 0) and (sx
= 0) and (sy
= 0)) then exit
;
466 px
:= @mProxies
[body
];
474 procedure TBodyGridBase
.moveBody (body
: TBodyProxyId
; dx
, dy
: Integer);
476 moveResizeBody(body
, dx
, dy
, 0, 0);
479 procedure TBodyGridBase
.resizeBody (body
: TBodyProxyId
; sx
, sy
: Integer);
481 moveResizeBody(body
, 0, 0, sx
, sy
);
485 function TBodyGridBase
.iterator (grida
: Integer): Boolean;
489 {$IFDEF grid_use_buckets}
498 {$IFDEF grid_use_buckets}
500 for f
:= 0 to High(TGridCell
.bodies
) do
502 if (pi
.bodies
[f
] = -1) then break
;
503 px
:= @mProxies
[pi
.bodies
[f
]];
504 if (px
.mQueryMark
<> mLastQuery
) and ((px
.mTag
and mTagMask
) <> 0) then
506 //e_WriteLog(Format(' query #%d body hit: (%d,%d)-(%dx%d) tag:%d', [mLastQuery, mCells[idx].body.mX, mCells[idx].body.mY, mCells[idx].body.mWidth, mCells[idx].body.mHeight, mCells[idx].body.mTag]), MSG_NOTIFY);
507 px
.mQueryMark
:= mLastQuery
;
508 if (mItCB(px
.mObj
, px
.mTag
)) then begin result
:= true; exit
; end;
513 if (mCells
[idx
].body
<> -1) then
515 px
:= @mProxies
[mCells
[idx
].body
];
516 if (px
.mQueryMark
<> mLastQuery
) and ((px
.mTag
and mTagMask
) <> 0) then
518 //e_WriteLog(Format(' query #%d body hit: (%d,%d)-(%dx%d) tag:%d', [mLastQuery, mCells[idx].body.mX, mCells[idx].body.mY, mCells[idx].body.mWidth, mCells[idx].body.mHeight, mCells[idx].body.mTag]), MSG_NOTIFY);
519 px
.mQueryMark
:= mLastQuery
;
520 if (mItCB(px
.mObj
, px
.mTag
)) then begin result
:= true; exit
; end;
523 idx
:= mCells
[idx
].next
;
528 function TBodyGridBase
.forEachInAABB (x
, y
, w
, h
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): Boolean;
535 if not assigned(cb
) then exit
;
537 // increase query counter
539 if (mLastQuery
= 0) then
541 // just in case of overflow
543 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
545 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
547 otagmask
:= mTagMask
;
551 result
:= forGridRect(x
, y
, w
, h
, iterator
);
552 mTagMask
:= otagmask
;