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