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 {$MODE DELPHI}
  17 {$modeswitch nestedprocvars}
  18 unit g_grid;
  19
  20 interface
  21
  22 uses e_log;
  23
  24 const
  25   GridDefaultTileSize = 32;
  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 = class(TObject)
  34   private
  35     mX, mY, mWidth, mHeight: Integer; // aabb
  36     mQueryMark: DWord; // was this object visited at this query?
  37     mObj: TObject;
  38     mGrid: TBodyGrid;
  39     mTag: Integer;
  40     prevLink: TBodyProxy; // only for used
  41     nextLink: TBodyProxy; // either used or free
  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: TBodyProxy;
  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     mWidth, mHeight: Integer; // in tiles
  71     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  72     mCells: array of TGridCell; // cell pool
  73     mFreeCell: Integer; // first free cell index or -1
  74     mLastQuery: Integer;
  75     mUsedCells: Integer;
  76     mProxyFree: TBodyProxy; // free
  77     mProxyList: TBodyProxy; // used
  78     mProxyCount: Integer; // total allocated
  79
  80   private
  81     function allocCell: Integer;
  82     procedure freeCell (idx: Integer); // `next` is simply overwritten
  83
  84     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
  85     procedure freeProxy (body: TBodyProxy);
  86
  87     procedure insert (body: TBodyProxy);
  88     procedure remove (body: TBodyProxy);
  89
  90     function forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
  91
  92   public
  93     constructor Create (aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
  94     destructor Destroy (); override;
  95
  96     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
  97     procedure removeBody (aObj: TBodyProxy); // WARNING! this will NOT destroy proxy!
  98
  99     procedure moveBody (body: TBodyProxy; dx, dy: Integer);
 100     procedure resizeBody (body: TBodyProxy; sx, sy: Integer);
 101     procedure moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 102
 103     function forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
 104
 105     function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 106
 107     procedure dumpStats ();
 108   end;
 109
 110
 111 type
 112   TBinaryHeapLessFn = function (a, b: TObject): Boolean;
 113
 114   TBinaryHeapObj = class(TObject)
 115   private
 116     elem: array of TObject;
 117     elemUsed: Integer;
 118     lessfn: TBinaryHeapLessFn;
 119
 120   private
 121     procedure heapify (root: Integer);
 122
 123   public
 124     constructor Create (alessfn: TBinaryHeapLessFn);
 125     destructor Destroy (); override;
 126
 127     procedure clear ();
 128
 129     procedure insert (val: TObject);
 130
 131     function front (): TObject;
 132     procedure popFront ();
 133
 134     property count: Integer read elemUsed;
 135   end;
 136
 137
 138 implementation
 139
 140 uses
 141   SysUtils;
 142
 143
 144 // ////////////////////////////////////////////////////////////////////////// //
 145 constructor TBodyProxy.Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 146 begin
 147   mGrid := aGrid;
 148   setup(aX, aY, aWidth, aHeight, aObj, aTag);
 149 end;
 150
 151
 152 destructor TBodyProxy.Destroy ();
 153 begin
 154   inherited;
 155 end;
 156
 157
 158 procedure TBodyProxy.setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 159 begin
 160   mX := aX;
 161   mY := aY;
 162   mWidth := aWidth;
 163   mHeight := aHeight;
 164   mQueryMark := 0;
 165   mObj := aObj;
 166   mTag := aTag;
 167   prevLink := nil;
 168   nextLink := nil;
 169 end;
 170
 171
 172 // ////////////////////////////////////////////////////////////////////////// //
 173 constructor TBodyGrid.Create (aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 174 var
 175   idx: Integer;
 176 begin
 177   if aTileSize < 1 then aTileSize := 1;
 178   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 179   if aPixWidth < aTileSize then aPixWidth := aTileSize;
 180   if aPixHeight < aTileSize then aPixHeight := aTileSize;
 181   mTileSize := aTileSize;
 182   mWidth := (aPixWidth+aTileSize-1) div aTileSize;
 183   mHeight := (aPixHeight+aTileSize-1) div aTileSize;
 184   SetLength(mGrid, mWidth*mHeight);
 185   SetLength(mCells, mWidth*mHeight);
 186   mFreeCell := 0;
 187   // init free list
 188   for idx := 0 to High(mCells) do
 189   begin
 190     mCells[idx].body := nil;
 191     mCells[idx].next := idx+1;
 192   end;
 193   mCells[High(mCells)].next := -1; // last cell
 194   // init grid
 195   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 196   mLastQuery := 0;
 197   mUsedCells := 0;
 198   mProxyFree := nil;
 199   mProxyList := nil;
 200   mProxyCount := 0;
 201   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 202 end;
 203
 204
 205 destructor TBodyGrid.Destroy ();
 206 var
 207   px: TBodyProxy;
 208 begin
 209   // free all owned proxies
 210   while mProxyFree <> nil do
 211   begin
 212     px := mProxyFree;
 213     mProxyFree := px.nextLink;
 214     px.Free();
 215   end;
 216
 217   while mProxyList <> nil do
 218   begin
 219     px := mProxyList;
 220     mProxyList := px.nextLink;
 221     px.Free();
 222   end;
 223
 224   mCells := nil;
 225   mGrid := nil;
 226   inherited;
 227 end;
 228
 229
 230 procedure TBodyGrid.dumpStats ();
 231 var
 232   idx, mcb, cidx, cnt: Integer;
 233 begin
 234   mcb := 0;
 235   for idx := 0 to High(mGrid) do
 236   begin
 237     cidx := mGrid[idx];
 238     cnt := 0;
 239     while cidx >= 0 do
 240     begin
 241       Inc(cnt);
 242       cidx := mCells[cidx].next;
 243     end;
 244     if (mcb < cnt) then mcb := cnt;
 245   end;
 246   e_WriteLog(Format('grid size: %dx%d (tile size: %d); pix: %dx%d; used cells: %d; max bodies in cell: %d; proxies allocated: %d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize, mUsedCells, mcb, mProxyCount]), MSG_NOTIFY);
 247 end;
 248
 249
 250 function TBodyGrid.allocCell: Integer;
 251 var
 252   idx: Integer;
 253 begin
 254   if (mFreeCell < 0) then
 255   begin
 256     // no free cells, want more
 257     mFreeCell := Length(mCells);
 258     SetLength(mCells, mFreeCell+32768); // arbitrary number
 259     for idx := mFreeCell to High(mCells) do
 260     begin
 261       mCells[idx].body := nil;
 262       mCells[idx].next := idx+1;
 263     end;
 264     mCells[High(mCells)].next := -1; // last cell
 265   end;
 266   result := mFreeCell;
 267   mFreeCell := mCells[result].next;
 268   mCells[result].next := -1;
 269   Inc(mUsedCells);
 270   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 271 end;
 272
 273
 274 procedure TBodyGrid.freeCell (idx: Integer);
 275 begin
 276   if (idx >= 0) and (idx < High(mCells)) then
 277   begin
 278     if mCells[idx].body = nil then exit; // the thing that should not be
 279     mCells[idx].body := nil;
 280     mCells[idx].next := mFreeCell;
 281     mFreeCell := idx;
 282     Dec(mUsedCells);
 283   end;
 284 end;
 285
 286
 287 function TBodyGrid.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TBodyProxy;
 288 begin
 289   if (mProxyFree = nil) then
 290   begin
 291     // no free proxies, create new
 292     result := TBodyProxy.Create(self, aX, aY, aWidth, aHeight, aObj, aTag);
 293     Inc(mProxyCount);
 294   end
 295   else
 296   begin
 297     // get one from list
 298     result := mProxyFree;
 299     mProxyFree := result.nextLink;
 300     result.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 301   end;
 302   // add to used list
 303   result.nextLink := mProxyList;
 304   if (mProxyList <> nil) then mProxyList.prevLink := result;
 305   mProxyList := result;
 306 end;
 307
 308 procedure TBodyGrid.freeProxy (body: TBodyProxy);
 309 begin
 310   if body = nil then exit; // just in case
 311   // remove from used list
 312   if (body.prevLink = nil) then
 313   begin
 314     // this must be head
 315     if (body <> mProxyList) then raise Exception.Create('wutafuuuuu in grid?');
 316     mProxyList := body.nextLink;
 317   end
 318   else
 319   begin
 320     body.prevLink.nextLink := body.nextLink;
 321   end;
 322   if (body.nextLink <> nil) then body.nextLink.prevLink := body.prevLink;
 323   // add to free list
 324   //body.mObj := nil; //WARNING! DON'T DO THIS! `removeBody()` depends on valid mObj
 325   body.prevLink := nil;
 326   body.nextLink := mProxyFree;
 327   mProxyFree := body;
 328 end;
 329
 330
 331 function TBodyGrid.forGridRect (x, y, w, h: Integer; cb: GridInternalCB): Boolean;
 332 var
 333   gx, gy: Integer;
 334 begin
 335   result := false;
 336   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 337   if (x+w <= 0) or (y+h <= 0) then exit;
 338   if (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
 339   for gy := y div mTileSize to (y+h-1) div mTileSize do
 340   begin
 341     if (gy < 0) then continue;
 342     if (gy >= mHeight) then break;
 343     for gx := x div mTileSize to (x+w-1) div mTileSize do
 344     begin
 345       if (gx < 0) then continue;
 346       if (gx >= mWidth) then break;
 347       if (cb(gy*mWidth+gx)) then begin result := true; exit; end;
 348     end;
 349   end;
 350 end;
 351
 352
 353 procedure TBodyGrid.insert (body: TBodyProxy);
 354
 355   function inserter (grida: Integer): Boolean;
 356   var
 357     cidx: Integer;
 358   begin
 359     result := false; // never stop
 360     // add body to the given grid cell
 361     cidx := allocCell();
 362     //e_WriteLog(Format('  01: allocated cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
 363     mCells[cidx].body := body;
 364     mCells[cidx].next := mGrid[grida];
 365     mGrid[grida] := cidx;
 366   end;
 367
 368 begin
 369   if body = nil then exit;
 370   forGridRect(body.mX, body.mY, body.mWidth, body.mHeight, inserter);
 371 end;
 372
 373
 374 // absolutely not tested
 375 procedure TBodyGrid.remove (body: TBodyProxy);
 376
 377   function remover (grida: Integer): Boolean;
 378   var
 379     pidx, idx, tmp: Integer;
 380   begin
 381     result := false; // never stop
 382     // find and remove cell
 383     pidx := -1;
 384     idx := mGrid[grida];
 385     while idx >= 0 do
 386     begin
 387       tmp := mCells[idx].next;
 388       if (mCells[idx].body = body) then
 389       begin
 390         if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 391         freeCell(idx);
 392         break; // assume that we cannot have one object added to bucket twice
 393       end
 394       else
 395       begin
 396         pidx := idx;
 397       end;
 398       idx := tmp;
 399     end;
 400   end;
 401
 402 begin
 403   if body = nil then exit;
 404   forGridRect(body.mX, body.mY, body.mWidth, body.mHeight, remover);
 405 end;
 406
 407
 408 function TBodyGrid.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
 409 begin
 410   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 411   insert(result);
 412 end;
 413
 414
 415 // WARNING! this will NOT destroy proxy!
 416 procedure TBodyGrid.removeBody (aObj: TBodyProxy);
 417 begin
 418   if aObj = nil then exit;
 419   if (aObj.mGrid <> self) then raise Exception.Create('trying to remove alien proxy from grid');
 420   removeBody(aObj);
 421   //HACK!
 422   freeProxy(aObj);
 423   if (mProxyFree <> aObj) then raise Exception.Create('grid deletion invariant fucked');
 424   mProxyFree := aObj.nextLink;
 425   aObj.nextLink := nil;
 426 end;
 427
 428
 429 procedure TBodyGrid.moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 430 begin
 431   if (body = nil) or ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit;
 432   remove(body);
 433   Inc(body.mX, dx);
 434   Inc(body.mY, dy);
 435   Inc(body.mWidth, sx);
 436   Inc(body.mHeight, sy);
 437   insert(body);
 438 end;
 439
 440 procedure TBodyGrid.moveBody (body: TBodyProxy; dx, dy: Integer);
 441 begin
 442   moveResizeBody(body, dx, dy, 0, 0);
 443 end;
 444
 445 procedure TBodyGrid.resizeBody (body: TBodyProxy; sx, sy: Integer);
 446 begin
 447   moveResizeBody(body, 0, 0, sx, sy);
 448 end;
 449
 450
 451 function TBodyGrid.forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
 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 <> nil) and (mCells[idx].body.mQueryMark <> mLastQuery) then
 461       begin
 462         //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);
 463         mCells[idx].body.mQueryMark := mLastQuery;
 464         if (cb(mCells[idx].body.mObj, mCells[idx].body.mTag)) then begin result := true; exit; end;
 465       end;
 466       idx := mCells[idx].next;
 467     end;
 468   end;
 469
 470 var
 471   idx: Integer;
 472 begin
 473   result := false;
 474   if not assigned(cb) then exit;
 475
 476   // increase query counter
 477   Inc(mLastQuery);
 478   if (mLastQuery = 0) then
 479   begin
 480     // just in case of overflow
 481     mLastQuery := 1;
 482     for idx := 0 to High(mCells) do if (mCells[idx].body <> nil) then mCells[idx].body.mQueryMark := 0;
 483   end;
 484   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 485
 486   result := forGridRect(x, y, w, h, iterator);
 487 end;
 488
 489
 490 function TBodyGrid.getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 491 var
 492   res: TBodyProxy = nil;
 493
 494   function iterator (grida: Integer): Boolean;
 495   var
 496     idx: Integer;
 497   begin
 498     result := false;
 499     idx := mGrid[grida];
 500     while idx >= 0 do
 501     begin
 502       if (mCells[idx].body <> nil) and (mCells[idx].body = aObj) then
 503       begin
 504         result := true;
 505         res := mCells[idx].body;
 506         exit;
 507       end;
 508       idx := mCells[idx].next;
 509     end;
 510   end;
 511
 512 begin
 513   result := nil;
 514   if (aObj = nil) then exit;
 515   forGridRect(x, y, w, h, iterator);
 516   result := res;
 517 end;
 518
 519
 520 // ////////////////////////////////////////////////////////////////////////// //
 521 constructor TBinaryHeapObj.Create (alessfn: TBinaryHeapLessFn);
 522 begin
 523   if not assigned(alessfn) then raise Exception.Create('wutafuck?!');
 524   lessfn := alessfn;
 525   SetLength(elem, 8192); // 'cause why not?
 526   elemUsed := 0;
 527 end;
 528
 529
 530 destructor TBinaryHeapObj.Destroy ();
 531 begin
 532   inherited;
 533 end;
 534
 535
 536 procedure TBinaryHeapObj.clear ();
 537 begin
 538   elemUsed := 0;
 539 end;
 540
 541
 542 procedure TBinaryHeapObj.heapify (root: Integer);
 543 var
 544   smallest, right: Integer;
 545   tmp: TObject;
 546 begin
 547   while true do
 548   begin
 549     smallest := 2*root+1; // left child
 550     if (smallest >= elemUsed) then break; // anyway
 551     right := smallest+1; // right child
 552     if not lessfn(elem[smallest], elem[root]) then smallest := root;
 553     if (right < elemUsed) and (lessfn(elem[right], elem[smallest])) then smallest := right;
 554     if (smallest = root) then break;
 555     // swap
 556     tmp := elem[root];
 557     elem[root] := elem[smallest];
 558     elem[smallest] := tmp;
 559     root := smallest;
 560   end;
 561 end;
 562
 563
 564 procedure TBinaryHeapObj.insert (val: TObject);
 565 var
 566   i, par: Integer;
 567 begin
 568   if (val = nil) then exit;
 569   i := elemUsed;
 570   if (i = Length(elem)) then SetLength(elem, Length(elem)+16384); // arbitrary number
 571   Inc(elemUsed);
 572   while (i <> 0) do
 573   begin
 574     par := (i-1) div 2; // parent
 575     if not lessfn(val, elem[par]) then break;
 576     elem[i] := elem[par];
 577     i := par;
 578   end;
 579   elem[i] := val;
 580 end;
 581
 582 function TBinaryHeapObj.front (): TObject;
 583 begin
 584   if elemUsed > 0 then result := elem[0] else result := nil;
 585 end;
 586
 587
 588 procedure TBinaryHeapObj.popFront ();
 589 begin
 590   if (elemUsed > 0) then
 591   begin
 592     Dec(elemUsed);
 593     elem[0] := elem[elemUsed];
 594     heapify(0);
 595   end;
 596 end;
 597
 598
 599 end.