src/game/g_grid.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   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.
   7  *
   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.
  12  *
  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/>.
  15  *)
  16 // universal spatial grid
  17 {$INCLUDE ../shared/a_modes.inc}
  18 unit g_grid;
  19
  20 interface
  21
  22 const
  23   GridDefaultTileSize = 32;
  24
  25 type
  26   GridQueryCB = function (obj: TObject; tag: Integer): Boolean is nested; // return `true` to stop
  27
  28 type
  29   TBodyGrid = class;
  30
  31   TBodyProxy = Integer;
  32
  33   PBodyProxyRec = ^TBodyProxyRec;
  34   TBodyProxyRec = record
  35   private
  36     mX, mY, mWidth, mHeight: Integer; // aabb
  37     mQueryMark: DWord; // was this object visited at this query?
  38     mObj: TObject;
  39     //mGrid: TBodyGrid;
  40     mTag: Integer;
  41     nextLink: TBodyProxy; // next free or nothing
  42
  43   private
  44     procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  45
  46   public
  47     //constructor Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  48     //destructor Destroy (); override;
  49
  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;
  57   end;
  58
  59   PGridCell = ^TGridCell;
  60   TGridCell = record
  61     body: Integer;
  62     next: Integer; // in this cell; index in mCells
  63   end;
  64
  65   GridInternalCB = function (grida: Integer): Boolean is nested; // return `true` to stop
  66
  67   TBodyGrid = class(TObject)
  68   private
  69     mTileSize: Integer;
  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
  75     mLastQuery: DWord;
  76     mUsedCells: Integer;
  77     mProxies: array of TBodyProxyRec;
  78     mProxyFree: TBodyProxy; // free
  79     mProxyCount: Integer; // currently used
  80     mProxyMaxCount: Integer;
  81
  82   private
  83     function allocCell: Integer;
  84     procedure freeCell (idx: Integer); // `next` is simply overwritten
  85
  86     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
  87     procedure freeProxy (body: TBodyProxy);
  88
  89     procedure insert (body: TBodyProxy);
  90     procedure remove (body: TBodyProxy);
  91
  92     function forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
  93
  94   public
  95     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
  96     destructor Destroy (); override;
  97
  98     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
  99     procedure removeBody (aObj: TBodyProxy); // WARNING! this WILL destroy proxy!
 100
 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);
 104
 105     function forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
 106
 107     function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 108
 109     procedure dumpStats ();
 110   end;
 111
 112
 113 implementation
 114
 115 uses
 116   SysUtils, e_log;
 117
 118
 119 // ////////////////////////////////////////////////////////////////////////// //
 120 procedure TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 121 begin
 122   mX := aX;
 123   mY := aY;
 124   mWidth := aWidth;
 125   mHeight := aHeight;
 126   mQueryMark := 0;
 127   mObj := aObj;
 128   mTag := aTag;
 129   nextLink := -1;
 130 end;
 131
 132
 133 // ////////////////////////////////////////////////////////////////////////// //
 134 constructor TBodyGrid.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 135 var
 136   idx: Integer;
 137 begin
 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;
 143   mMinX := aMinPixX;
 144   mMinY := aMinPixY;
 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);
 150   mFreeCell := 0;
 151   // init free list
 152   for idx := 0 to High(mCells) do
 153   begin
 154     mCells[idx].body := -1;
 155     mCells[idx].next := idx+1;
 156   end;
 157   mCells[High(mCells)].next := -1; // last cell
 158   // init grid
 159   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 160   // init proxies
 161   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 162   mProxies[High(mProxies)].nextLink := -1;
 163   mLastQuery := 0;
 164   mUsedCells := 0;
 165   mProxyFree := 0;
 166   mProxyCount := 0;
 167   mProxyMaxCount := 0;
 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);
 169 end;
 170
 171
 172 destructor TBodyGrid.Destroy ();
 173 begin
 174   mCells := nil;
 175   mGrid := nil;
 176   mProxies := nil;
 177   inherited;
 178 end;
 179
 180
 181 procedure TBodyGrid.dumpStats ();
 182 var
 183   idx, mcb, cidx, cnt: Integer;
 184 begin
 185   mcb := 0;
 186   for idx := 0 to High(mGrid) do
 187   begin
 188     cidx := mGrid[idx];
 189     cnt := 0;
 190     while cidx >= 0 do
 191     begin
 192       Inc(cnt);
 193       cidx := mCells[cidx].next;
 194     end;
 195     if (mcb < cnt) then mcb := cnt;
 196   end;
 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);
 198 end;
 199
 200
 201 function TBodyGrid.allocCell: Integer;
 202 var
 203   idx: Integer;
 204 begin
 205   if (mFreeCell < 0) then
 206   begin
 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
 211     begin
 212       mCells[idx].body := -1;
 213       mCells[idx].next := idx+1;
 214     end;
 215     mCells[High(mCells)].next := -1; // last cell
 216   end;
 217   result := mFreeCell;
 218   mFreeCell := mCells[result].next;
 219   mCells[result].next := -1;
 220   Inc(mUsedCells);
 221   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 222 end;
 223
 224
 225 procedure TBodyGrid.freeCell (idx: Integer);
 226 begin
 227   if (idx >= 0) and (idx < High(mCells)) then
 228   begin
 229     if mCells[idx].body = -1 then exit; // the thing that should not be
 230     mCells[idx].body := -1;
 231     mCells[idx].next := mFreeCell;
 232     mFreeCell := idx;
 233     Dec(mUsedCells);
 234   end;
 235 end;
 236
 237
 238 function TBodyGrid.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
 239 var
 240   olen, idx: Integer;
 241   px: PBodyProxyRec;
 242 begin
 243   if (mProxyFree = -1) then
 244   begin
 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;
 250     mProxyFree := olen;
 251   end;
 252   // get one from list
 253   result := mProxyFree;
 254   px := @mProxies[result];
 255   mProxyFree := px.nextLink;
 256   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 257   // add to used list
 258   px.nextLink := -1;
 259   // statistics
 260   Inc(mProxyCount);
 261   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 262 end;
 263
 264 procedure TBodyGrid.freeProxy (body: TBodyProxy);
 265 begin
 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?)');
 268   // add to free list
 269   mProxies[body].mObj := nil;
 270   mProxies[body].nextLink := mProxyFree;
 271   mProxyFree := body;
 272   Dec(mProxyCount);
 273 end;
 274
 275
 276 function TBodyGrid.forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
 277 var
 278   gx, gy: Integer;
 279 begin
 280   result := false;
 281   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 282   // fix coords
 283   Dec(x, mMinX);
 284   Dec(y, mMinY);
 285   // go on
 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
 289   begin
 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
 293     begin
 294       if (gx < 0) then continue;
 295       if (gx >= mWidth) then break;
 296       if (cb(gy*mWidth+gx)) then begin result := true; exit; end;
 297     end;
 298   end;
 299 end;
 300
 301
 302 procedure TBodyGrid.insert (body: TBodyProxy);
 303
 304   function inserter (grida: Integer): Boolean;
 305   var
 306     cidx: Integer;
 307   begin
 308     result := false; // never stop
 309     // add body to the given grid cell
 310     cidx := allocCell();
 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;
 315   end;
 316
 317 var
 318   px: PBodyProxyRec;
 319 begin
 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);
 323 end;
 324
 325
 326 // absolutely not tested
 327 procedure TBodyGrid.remove (body: TBodyProxy);
 328
 329   function remover (grida: Integer): Boolean;
 330   var
 331     pidx, idx, tmp: Integer;
 332   begin
 333     result := false; // never stop
 334     // find and remove cell
 335     pidx := -1;
 336     idx := mGrid[grida];
 337     while idx >= 0 do
 338     begin
 339       tmp := mCells[idx].next;
 340       if (mCells[idx].body = body) then
 341       begin
 342         if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 343         freeCell(idx);
 344         break; // assume that we cannot have one object added to bucket twice
 345       end
 346       else
 347       begin
 348         pidx := idx;
 349       end;
 350       idx := tmp;
 351     end;
 352   end;
 353
 354 var
 355   px: PBodyProxyRec;
 356 begin
 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);
 360 end;
 361
 362
 363 function TBodyGrid.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
 364 begin
 365   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 366   insert(result);
 367 end;
 368
 369
 370 procedure TBodyGrid.removeBody (aObj: TBodyProxy);
 371 begin
 372   if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case
 373   removeBody(aObj);
 374   freeProxy(aObj);
 375 end;
 376
 377
 378 procedure TBodyGrid.moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 379 var
 380   px: PBodyProxyRec;
 381 begin
 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;
 384   remove(body);
 385   px := @mProxies[body];
 386   Inc(px.mX, dx);
 387   Inc(px.mY, dy);
 388   Inc(px.mWidth, sx);
 389   Inc(px.mHeight, sy);
 390   insert(body);
 391 end;
 392
 393 procedure TBodyGrid.moveBody (body: TBodyProxy; dx, dy: Integer);
 394 begin
 395   moveResizeBody(body, dx, dy, 0, 0);
 396 end;
 397
 398 procedure TBodyGrid.resizeBody (body: TBodyProxy; sx, sy: Integer);
 399 begin
 400   moveResizeBody(body, 0, 0, sx, sy);
 401 end;
 402
 403
 404 function TBodyGrid.forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
 405   function iterator (grida: Integer): Boolean;
 406   var
 407     idx: Integer;
 408     px: PBodyProxyRec;
 409   begin
 410     result := false;
 411     idx := mGrid[grida];
 412     while (idx >= 0) do
 413     begin
 414       if (mCells[idx].body <> -1) then
 415       begin
 416         px := @mProxies[mCells[idx].body];
 417         if (px.mQueryMark <> mLastQuery) then
 418         begin
 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;
 422         end;
 423       end;
 424       idx := mCells[idx].next;
 425     end;
 426   end;
 427
 428 var
 429   idx: Integer;
 430 begin
 431   result := false;
 432   if not assigned(cb) then exit;
 433
 434   // increase query counter
 435   Inc(mLastQuery);
 436   if (mLastQuery = 0) then
 437   begin
 438     // just in case of overflow
 439     mLastQuery := 1;
 440     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 441   end;
 442   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 443
 444   result := forGridRect(x, y, w, h, iterator);
 445 end;
 446
 447
 448 function TBodyGrid.getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 449 var
 450   res: TBodyProxy = -1;
 451
 452   function iterator (grida: Integer): Boolean;
 453   var
 454     idx: Integer;
 455   begin
 456     result := false;
 457     idx := mGrid[grida];
 458     while idx >= 0 do
 459     begin
 460       if (mCells[idx].body <> -1) and (mProxies[mCells[idx].body].mObj = aObj) then
 461       begin
 462         result := true;
 463         res := mCells[idx].body;
 464         exit;
 465       end;
 466       idx := mCells[idx].next;
 467     end;
 468   end;
 469
 470 begin
 471   result := -1;
 472   if (aObj = nil) then exit;
 473   forGridRect(x, y, w, h, iterator);
 474   result := res;
 475 end;
 476
 477
 478 end.