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}
23 GridDefaultTileSize
= 32;
26 GridQueryCB
= function (obj
: TObject
; tag
: Integer): Boolean is nested
; // return `true` to stop
33 PBodyProxyRec
= ^TBodyProxyRec
;
34 TBodyProxyRec
= record
36 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
37 mQueryMark
: DWord
; // was this object visited at this query?
41 nextLink
: TBodyProxy
; // next free or nothing
44 procedure setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: TObject
; aTag
: Integer);
47 //constructor Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
48 //destructor Destroy (); override;
50 property x
: Integer read mX
;
51 property y
: Integer read mY
;
52 property width
: Integer read mWidth
;
53 property height
: Integer read mHeight
;
54 property obj
: TObject read mObj
;
55 property tag
: Integer read mTag
;
56 //property grid: TBodyGrid read mGrid;
59 PGridCell
= ^TGridCell
;
62 next
: Integer; // in this cell; index in mCells
65 GridInternalCB
= function (grida
: Integer): Boolean is nested
; // return `true` to stop
67 TBodyGrid
= class(TObject
)
70 mMinX
, mMinY
: Integer; // so grids can start at any origin
71 mWidth
, mHeight
: Integer; // in tiles
72 mGrid
: array of Integer; // mWidth*mHeight, index in mCells
73 mCells
: array of TGridCell
; // cell pool
74 mFreeCell
: Integer; // first free cell index or -1
77 mProxies
: array of TBodyProxyRec
;
78 mProxyFree
: TBodyProxy
; // free
79 mProxyCount
: Integer; // currently used
80 mProxyMaxCount
: Integer;
83 function allocCell
: Integer;
84 procedure freeCell (idx
: Integer); // `next` is simply overwritten
86 function allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: TObject
; aTag
: Integer): TBodyProxy
;
87 procedure freeProxy (body
: TBodyProxy
);
89 procedure insert (body
: TBodyProxy
);
90 procedure remove (body
: TBodyProxy
);
92 function forGridRect (x
, y
, w
, h
: Integer; cb
: GridInternalCB
): Boolean;
95 constructor Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer; aTileSize
: Integer=GridDefaultTileSize
);
96 destructor Destroy (); override;
98 function insertBody (aObj
: TObject
; ax
, ay
, aWidth
, aHeight
: Integer; aTag
: Integer=0): TBodyProxy
;
99 procedure removeBody (aObj
: TBodyProxy
); // WARNING! this WILL destroy proxy!
101 procedure moveBody (body
: TBodyProxy
; dx
, dy
: Integer);
102 procedure resizeBody (body
: TBodyProxy
; sx
, sy
: Integer);
103 procedure moveResizeBody (body
: TBodyProxy
; dx
, dy
, sx
, sy
: Integer);
105 function forEachInAABB (x
, y
, w
, h
: Integer; cb
: GridQueryCB
; tagmask
: Integer=-1): Boolean;
107 function getProxyForBody (aObj
: TObject
; x
, y
, w
, h
: Integer): TBodyProxy
;
109 procedure dumpStats ();
119 // ////////////////////////////////////////////////////////////////////////// //
120 procedure TBodyProxyRec
.setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: TObject
; aTag
: Integer);
133 // ////////////////////////////////////////////////////////////////////////// //
134 constructor TBodyGrid
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer; aTileSize
: Integer=GridDefaultTileSize
);
138 if aTileSize
< 1 then aTileSize
:= 1;
139 if aTileSize
> 8192 then aTileSize
:= 8192; // arbitrary limit
140 if aPixWidth
< aTileSize
then aPixWidth
:= aTileSize
;
141 if aPixHeight
< aTileSize
then aPixHeight
:= aTileSize
;
142 mTileSize
:= aTileSize
;
145 mWidth
:= (aPixWidth
+aTileSize
-1) div aTileSize
;
146 mHeight
:= (aPixHeight
+aTileSize
-1) div aTileSize
;
147 SetLength(mGrid
, mWidth
*mHeight
);
148 SetLength(mCells
, mWidth
*mHeight
);
149 SetLength(mProxies
, 8192);
152 for idx
:= 0 to High(mCells
) do
154 mCells
[idx
].body
:= -1;
155 mCells
[idx
].next
:= idx
+1;
157 mCells
[High(mCells
)].next
:= -1; // last cell
159 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
161 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
162 mProxies
[High(mProxies
)].nextLink
:= -1;
168 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
]), MSG_NOTIFY
);
172 destructor TBodyGrid
.Destroy ();
181 procedure TBodyGrid
.dumpStats ();
183 idx
, mcb
, cidx
, cnt
: Integer;
186 for idx
:= 0 to High(mGrid
) do
193 cidx
:= mCells
[cidx
].next
;
195 if (mcb
< cnt
) then mcb
:= cnt
;
197 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
);
201 function TBodyGrid
.allocCell
: Integer;
205 if (mFreeCell
< 0) then
207 // no free cells, want more
208 mFreeCell
:= Length(mCells
);
209 SetLength(mCells
, mFreeCell
+32768); // arbitrary number
210 for idx
:= mFreeCell
to High(mCells
) do
212 mCells
[idx
].body
:= -1;
213 mCells
[idx
].next
:= idx
+1;
215 mCells
[High(mCells
)].next
:= -1; // last cell
218 mFreeCell
:= mCells
[result
].next
;
219 mCells
[result
].next
:= -1;
221 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
225 procedure TBodyGrid
.freeCell (idx
: Integer);
227 if (idx
>= 0) and (idx
< High(mCells
)) then
229 if mCells
[idx
].body
= -1 then exit
; // the thing that should not be
230 mCells
[idx
].body
:= -1;
231 mCells
[idx
].next
:= mFreeCell
;
238 function TBodyGrid
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: TObject
; aTag
: Integer): TBodyProxy
;
243 if (mProxyFree
= -1) then
245 // no free proxies, resize list
246 olen
:= Length(mProxies
);
247 SetLength(mProxies
, olen
+8192); // arbitrary number
248 for idx
:= olen
to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
249 mProxies
[High(mProxies
)].nextLink
:= -1;
253 result
:= mProxyFree
;
254 px
:= @mProxies
[result
];
255 mProxyFree
:= px
.nextLink
;
256 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
261 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
264 procedure TBodyGrid
.freeProxy (body
: TBodyProxy
);
266 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
267 if (mProxyCount
= 0) then raise Exception
.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
269 mProxies
[body
].mObj
:= nil;
270 mProxies
[body
].nextLink
:= mProxyFree
;
276 function TBodyGrid
.forGridRect (x
, y
, w
, h
: Integer; cb
: GridInternalCB
): Boolean;
281 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
286 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
287 if (x
>= mWidth
*mTileSize
) or (y
>= mHeight
*mTileSize
) then exit
;
288 for gy
:= y
div mTileSize
to (y
+h
-1) div mTileSize
do
290 if (gy
< 0) then continue
;
291 if (gy
>= mHeight
) then break
;
292 for gx
:= x
div mTileSize
to (x
+w
-1) div mTileSize
do
294 if (gx
< 0) then continue
;
295 if (gx
>= mWidth
) then break
;
296 if (cb(gy
*mWidth
+gx
)) then begin result
:= true; exit
; end;
302 procedure TBodyGrid
.insert (body
: TBodyProxy
);
304 function inserter (grida
: Integer): Boolean;
308 result
:= false; // never stop
309 // add body to the given grid cell
311 //e_WriteLog(Format(' 01: allocated cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
312 mCells
[cidx
].body
:= body
;
313 mCells
[cidx
].next
:= mGrid
[grida
];
314 mGrid
[grida
] := cidx
;
320 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
321 px
:= @mProxies
[body
];
322 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, inserter
);
326 // absolutely not tested
327 procedure TBodyGrid
.remove (body
: TBodyProxy
);
329 function remover (grida
: Integer): Boolean;
331 pidx
, idx
, tmp
: Integer;
333 result
:= false; // never stop
334 // find and remove cell
339 tmp
:= mCells
[idx
].next
;
340 if (mCells
[idx
].body
= body
) then
342 if (pidx
= -1) then mGrid
[grida
] := tmp
else mCells
[pidx
].next
:= tmp
;
344 break
; // assume that we cannot have one object added to bucket twice
357 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
358 px
:= @mProxies
[body
];
359 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
);
363 function TBodyGrid
.insertBody (aObj
: TObject
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=0): TBodyProxy
;
365 result
:= allocProxy(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
370 procedure TBodyGrid
.removeBody (aObj
: TBodyProxy
);
372 if (aObj
< 0) or (aObj
> High(mProxies
)) then exit
; // just in case
378 procedure TBodyGrid
.moveResizeBody (body
: TBodyProxy
; dx
, dy
, sx
, sy
: Integer);
382 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
383 if ((dx
= 0) and (dy
= 0) and (sx
= 0) and (sy
= 0)) then exit
;
385 px
:= @mProxies
[body
];
393 procedure TBodyGrid
.moveBody (body
: TBodyProxy
; dx
, dy
: Integer);
395 moveResizeBody(body
, dx
, dy
, 0, 0);
398 procedure TBodyGrid
.resizeBody (body
: TBodyProxy
; sx
, sy
: Integer);
400 moveResizeBody(body
, 0, 0, sx
, sy
);
404 function TBodyGrid
.forEachInAABB (x
, y
, w
, h
: Integer; cb
: GridQueryCB
; tagmask
: Integer=-1): Boolean;
405 function iterator (grida
: Integer): Boolean;
414 if (mCells
[idx
].body
<> -1) then
416 px
:= @mProxies
[mCells
[idx
].body
];
417 if (px
.mQueryMark
<> mLastQuery
) and ((px
.mTag
and tagmask
) <> 0) then
419 //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);
420 px
.mQueryMark
:= mLastQuery
;
421 if (cb(px
.mObj
, px
.mTag
)) then begin result
:= true; exit
; end;
424 idx
:= mCells
[idx
].next
;
432 if not assigned(cb
) then exit
;
434 // increase query counter
436 if (mLastQuery
= 0) then
438 // just in case of overflow
440 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
442 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
444 result
:= forGridRect(x
, y
, w
, h
, iterator
);
448 function TBodyGrid
.getProxyForBody (aObj
: TObject
; x
, y
, w
, h
: Integer): TBodyProxy
;
450 res
: TBodyProxy
= -1;
452 function iterator (grida
: Integer): Boolean;
460 if (mCells
[idx
].body
<> -1) and (mProxies
[mCells
[idx
].body
].mObj
= aObj
) then
463 res
:= mCells
[idx
].body
;
466 idx
:= mCells
[idx
].next
;
472 if (aObj
= nil) then exit
;
473 forGridRect(x
, y
, w
, h
, iterator
);