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 {$DEFINE grid_use_buckets}
  19 unit g_grid;
  20
  21 interface
  22
  23 const
  24   GridDefaultTileSize = 32;
  25   GridCellBucketSize = 8; // WARNING! can't be less than 2!
  26
  27 type
  28   GridQueryCB = function (obj: TObject; tag: Integer): Boolean is nested; // return `true` to stop
  29
  30 type
  31   TBodyGrid = class;
  32
  33   TBodyProxy = Integer;
  34
  35   PBodyProxyRec = ^TBodyProxyRec;
  36   TBodyProxyRec = record
  37   private
  38     mX, mY, mWidth, mHeight: Integer; // aabb
  39     mQueryMark: DWord; // was this object visited at this query?
  40     mObj: TObject;
  41     //mGrid: TBodyGrid;
  42     mTag: Integer;
  43     nextLink: TBodyProxy; // next free or nothing
  44
  45   private
  46     procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  47
  48   public
  49     //constructor Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  50     //destructor Destroy (); override;
  51
  52     property x: Integer read mX;
  53     property y: Integer read mY;
  54     property width: Integer read mWidth;
  55     property height: Integer read mHeight;
  56     property obj: TObject read mObj;
  57     property tag: Integer read mTag;
  58     //property grid: TBodyGrid read mGrid;
  59   end;
  60
  61   PGridCell = ^TGridCell;
  62   TGridCell = record
  63     {$IFDEF grid_use_buckets}
  64     bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  65     {$ELSE}
  66     body: Integer;
  67     {$ENDIF}
  68     next: Integer; // in this cell; index in mCells
  69   end;
  70
  71   GridInternalCB = function (grida: Integer): Boolean is nested; // return `true` to stop
  72
  73   TBodyGrid = class(TObject)
  74   private
  75     mTileSize: Integer;
  76     mMinX, mMinY: Integer; // so grids can start at any origin
  77     mWidth, mHeight: Integer; // in tiles
  78     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  79     mCells: array of TGridCell; // cell pool
  80     mFreeCell: Integer; // first free cell index or -1
  81     mLastQuery: DWord;
  82     mUsedCells: Integer;
  83     mProxies: array of TBodyProxyRec;
  84     mProxyFree: TBodyProxy; // free
  85     mProxyCount: Integer; // currently used
  86     mProxyMaxCount: Integer;
  87
  88   private
  89     function allocCell: Integer;
  90     procedure freeCell (idx: Integer); // `next` is simply overwritten
  91
  92     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
  93     procedure freeProxy (body: TBodyProxy);
  94
  95     procedure insert (body: TBodyProxy);
  96     procedure remove (body: TBodyProxy);
  97
  98     function forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
  99
 100   public
 101     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 102     destructor Destroy (); override;
 103
 104     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
 105     procedure removeBody (aObj: TBodyProxy); // WARNING! this WILL destroy proxy!
 106
 107     procedure moveBody (body: TBodyProxy; dx, dy: Integer);
 108     procedure resizeBody (body: TBodyProxy; sx, sy: Integer);
 109     procedure moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 110
 111     function forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB; tagmask: Integer=-1): Boolean;
 112
 113     //function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 114
 115     procedure dumpStats ();
 116   end;
 117
 118
 119 implementation
 120
 121 uses
 122   SysUtils, e_log;
 123
 124
 125 // ////////////////////////////////////////////////////////////////////////// //
 126 procedure TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 127 begin
 128   mX := aX;
 129   mY := aY;
 130   mWidth := aWidth;
 131   mHeight := aHeight;
 132   mQueryMark := 0;
 133   mObj := aObj;
 134   mTag := aTag;
 135   nextLink := -1;
 136 end;
 137
 138
 139 // ////////////////////////////////////////////////////////////////////////// //
 140 constructor TBodyGrid.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 141 var
 142   idx: Integer;
 143 begin
 144   if aTileSize < 1 then aTileSize := 1;
 145   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 146   if aPixWidth < aTileSize then aPixWidth := aTileSize;
 147   if aPixHeight < aTileSize then aPixHeight := aTileSize;
 148   mTileSize := aTileSize;
 149   mMinX := aMinPixX;
 150   mMinY := aMinPixY;
 151   mWidth := (aPixWidth+aTileSize-1) div aTileSize;
 152   mHeight := (aPixHeight+aTileSize-1) div aTileSize;
 153   SetLength(mGrid, mWidth*mHeight);
 154   SetLength(mCells, mWidth*mHeight);
 155   SetLength(mProxies, 8192);
 156   mFreeCell := 0;
 157   // init free list
 158   for idx := 0 to High(mCells) do
 159   begin
 160     {$IFDEF grid_use_buckets}
 161     mCells[idx].bodies[0] := -1;
 162     {$ELSE}
 163     mCells[idx].body := -1;
 164     {$ENDIF}
 165     mCells[idx].next := idx+1;
 166   end;
 167   mCells[High(mCells)].next := -1; // last cell
 168   // init grid
 169   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 170   // init proxies
 171   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 172   mProxies[High(mProxies)].nextLink := -1;
 173   mLastQuery := 0;
 174   mUsedCells := 0;
 175   mProxyFree := 0;
 176   mProxyCount := 0;
 177   mProxyMaxCount := 0;
 178   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 179 end;
 180
 181
 182 destructor TBodyGrid.Destroy ();
 183 begin
 184   mCells := nil;
 185   mGrid := nil;
 186   mProxies := nil;
 187   inherited;
 188 end;
 189
 190
 191 procedure TBodyGrid.dumpStats ();
 192 var
 193   idx, mcb, cidx, cnt: Integer;
 194 begin
 195   mcb := 0;
 196   for idx := 0 to High(mGrid) do
 197   begin
 198     cidx := mGrid[idx];
 199     cnt := 0;
 200     while cidx >= 0 do
 201     begin
 202       Inc(cnt);
 203       cidx := mCells[cidx].next;
 204     end;
 205     if (mcb < cnt) then mcb := cnt;
 206   end;
 207   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);
 208 end;
 209
 210
 211 function TBodyGrid.allocCell: Integer;
 212 var
 213   idx: Integer;
 214 begin
 215   if (mFreeCell < 0) then
 216   begin
 217     // no free cells, want more
 218     mFreeCell := Length(mCells);
 219     SetLength(mCells, mFreeCell+32768); // arbitrary number
 220     for idx := mFreeCell to High(mCells) do
 221     begin
 222       {$IFDEF grid_use_buckets}
 223       mCells[idx].bodies[0] := -1;
 224       {$ELSE}
 225       mCells[idx].body := -1;
 226       {$ENDIF}
 227       mCells[idx].next := idx+1;
 228     end;
 229     mCells[High(mCells)].next := -1; // last cell
 230   end;
 231   result := mFreeCell;
 232   mFreeCell := mCells[result].next;
 233   mCells[result].next := -1;
 234   Inc(mUsedCells);
 235   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 236 end;
 237
 238
 239 procedure TBodyGrid.freeCell (idx: Integer);
 240 begin
 241   if (idx >= 0) and (idx < High(mCells)) then
 242   begin
 243     //if mCells[idx].body = -1 then exit; // the thing that should not be
 244     //mCells[idx].body := -1;
 245     mCells[idx].next := mFreeCell;
 246     mFreeCell := idx;
 247     Dec(mUsedCells);
 248   end;
 249 end;
 250
 251
 252 function TBodyGrid.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
 253 var
 254   olen, idx: Integer;
 255   px: PBodyProxyRec;
 256 begin
 257   if (mProxyFree = -1) then
 258   begin
 259     // no free proxies, resize list
 260     olen := Length(mProxies);
 261     SetLength(mProxies, olen+8192); // arbitrary number
 262     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 263     mProxies[High(mProxies)].nextLink := -1;
 264     mProxyFree := olen;
 265   end;
 266   // get one from list
 267   result := mProxyFree;
 268   px := @mProxies[result];
 269   mProxyFree := px.nextLink;
 270   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 271   // add to used list
 272   px.nextLink := -1;
 273   // statistics
 274   Inc(mProxyCount);
 275   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 276 end;
 277
 278 procedure TBodyGrid.freeProxy (body: TBodyProxy);
 279 begin
 280   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 281   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 282   // add to free list
 283   mProxies[body].mObj := nil;
 284   mProxies[body].nextLink := mProxyFree;
 285   mProxyFree := body;
 286   Dec(mProxyCount);
 287 end;
 288
 289
 290 function TBodyGrid.forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
 291 var
 292   gx, gy: Integer;
 293 begin
 294   result := false;
 295   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 296   // fix coords
 297   Dec(x, mMinX);
 298   Dec(y, mMinY);
 299   // go on
 300   if (x+w <= 0) or (y+h <= 0) then exit;
 301   if (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
 302   for gy := y div mTileSize to (y+h-1) div mTileSize do
 303   begin
 304     if (gy < 0) then continue;
 305     if (gy >= mHeight) then break;
 306     for gx := x div mTileSize to (x+w-1) div mTileSize do
 307     begin
 308       if (gx < 0) then continue;
 309       if (gx >= mWidth) then break;
 310       if (cb(gy*mWidth+gx)) then begin result := true; exit; end;
 311     end;
 312   end;
 313 end;
 314
 315
 316 procedure TBodyGrid.insert (body: TBodyProxy);
 317
 318   function inserter (grida: Integer): Boolean;
 319   var
 320     cidx: Integer;
 321     pc: PInteger;
 322     {$IFDEF grid_use_buckets}
 323     pi: PGridCell;
 324     f: Integer;
 325     {$ENDIF}
 326   begin
 327     result := false; // never stop
 328     // add body to the given grid cell
 329     pc := @mGrid[grida];
 330     {$IFDEF grid_use_buckets}
 331     if (pc^ <> -1) then
 332     begin
 333       pi := @mCells[pc^];
 334       f := 0;
 335       for f := 0 to High(TGridCell.bodies) do
 336       begin
 337         if (pi.bodies[f] = -1) then
 338         begin
 339           // can add here
 340           pi.bodies[f] := body;
 341           if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
 342           exit;
 343         end;
 344       end;
 345     end;
 346     // either no room, or no cell at all
 347     cidx := allocCell();
 348     mCells[cidx].bodies[0] := body;
 349     mCells[cidx].bodies[1] := -1;
 350     mCells[cidx].next := pc^;
 351     pc^ := cidx;
 352     {$ELSE}
 353     cidx := allocCell();
 354     //e_WriteLog(Format('  01: allocated cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
 355     mCells[cidx].body := body;
 356     mCells[cidx].next := pc^;
 357     pc^ := cidx;
 358     {$ENDIF}
 359   end;
 360
 361 var
 362   px: PBodyProxyRec;
 363 begin
 364   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 365   px := @mProxies[body];
 366   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter);
 367 end;
 368
 369
 370 // absolutely not tested
 371 procedure TBodyGrid.remove (body: TBodyProxy);
 372
 373 (*
 374   function remover (grida: Integer): Boolean;
 375   var
 376     pidx, idx, tmp: Integer;
 377   begin
 378     result := false; // never stop
 379     // find and remove cell
 380     pidx := -1;
 381     idx := mGrid[grida];
 382     while idx >= 0 do
 383     begin
 384       tmp := mCells[idx].next;
 385       if (mCells[idx].body = body) then
 386       begin
 387         if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 388         freeCell(idx);
 389         break; // assume that we cannot have one object added to bucket twice
 390       end
 391       else
 392       begin
 393         pidx := idx;
 394       end;
 395       idx := tmp;
 396     end;
 397   end;
 398
 399 var
 400   px: PBodyProxyRec;
 401 *)
 402 begin
 403 (*
 404   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 405   px := @mProxies[body];
 406   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover);
 407 *)
 408   raise Exception.Create('TBodyGrid.remove: not yet, sorry');
 409 end;
 410
 411
 412 function TBodyGrid.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
 413 begin
 414   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 415   insert(result);
 416 end;
 417
 418
 419 procedure TBodyGrid.removeBody (aObj: TBodyProxy);
 420 begin
 421   if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case
 422   removeBody(aObj);
 423   freeProxy(aObj);
 424 end;
 425
 426
 427 procedure TBodyGrid.moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 428 var
 429   px: PBodyProxyRec;
 430 begin
 431   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 432   if ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit;
 433   remove(body);
 434   px := @mProxies[body];
 435   Inc(px.mX, dx);
 436   Inc(px.mY, dy);
 437   Inc(px.mWidth, sx);
 438   Inc(px.mHeight, sy);
 439   insert(body);
 440 end;
 441
 442 procedure TBodyGrid.moveBody (body: TBodyProxy; dx, dy: Integer);
 443 begin
 444   moveResizeBody(body, dx, dy, 0, 0);
 445 end;
 446
 447 procedure TBodyGrid.resizeBody (body: TBodyProxy; sx, sy: Integer);
 448 begin
 449   moveResizeBody(body, 0, 0, sx, sy);
 450 end;
 451
 452
 453 function TBodyGrid.forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB; tagmask: Integer=-1): Boolean;
 454   function iterator (grida: Integer): Boolean;
 455   var
 456     idx: Integer;
 457     px: PBodyProxyRec;
 458     {$IFDEF grid_use_buckets}
 459     pi: PGridCell;
 460     f: Integer;
 461     {$ENDIF}
 462   begin
 463     result := false;
 464     idx := mGrid[grida];
 465     while (idx >= 0) do
 466     begin
 467       {$IFDEF grid_use_buckets}
 468       pi := @mCells[idx];
 469       for f := 0 to High(TGridCell.bodies) do
 470       begin
 471         if (pi.bodies[f] = -1) then break;
 472         px := @mProxies[pi.bodies[f]];
 473         if (px.mQueryMark <> mLastQuery) and ((px.mTag and tagmask) <> 0) then
 474         begin
 475           //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);
 476           px.mQueryMark := mLastQuery;
 477           if (cb(px.mObj, px.mTag)) then begin result := true; exit; end;
 478         end;
 479       end;
 480       idx := pi.next;
 481       {$ELSE}
 482       if (mCells[idx].body <> -1) then
 483       begin
 484         px := @mProxies[mCells[idx].body];
 485         if (px.mQueryMark <> mLastQuery) and ((px.mTag and tagmask) <> 0) then
 486         begin
 487           //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);
 488           px.mQueryMark := mLastQuery;
 489           if (cb(px.mObj, px.mTag)) then begin result := true; exit; end;
 490         end;
 491       end;
 492       idx := mCells[idx].next;
 493       {$ENDIF}
 494     end;
 495   end;
 496
 497 var
 498   idx: Integer;
 499 begin
 500   result := false;
 501   if not assigned(cb) then exit;
 502
 503   // increase query counter
 504   Inc(mLastQuery);
 505   if (mLastQuery = 0) then
 506   begin
 507     // just in case of overflow
 508     mLastQuery := 1;
 509     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 510   end;
 511   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 512
 513   result := forGridRect(x, y, w, h, iterator);
 514 end;
 515
 516
 517 (*
 518 function TBodyGrid.getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 519 var
 520   res: TBodyProxy = -1;
 521
 522   function iterator (grida: Integer): Boolean;
 523   var
 524     idx: Integer;
 525   begin
 526     result := false;
 527     idx := mGrid[grida];
 528     while idx >= 0 do
 529     begin
 530       if (mCells[idx].body <> -1) and (mProxies[mCells[idx].body].mObj = aObj) then
 531       begin
 532         result := true;
 533         res := mCells[idx].body;
 534         exit;
 535       end;
 536       idx := mCells[idx].next;
 537     end;
 538   end;
 539
 540 begin
 541   result := -1;
 542   if (aObj = nil) then exit;
 543   forGridRect(x, y, w, h, iterator);
 544   result := res;
 545 end;
 546 *)
 547
 548
 549 end.