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
  41   public
  42     constructor Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  43     destructor Destroy (); override;
  44
  45     property x: Integer read mX;
  46     property y: Integer read mY;
  47     property width: Integer read mWidth;
  48     property height: Integer read mHeight;
  49     property obj: TObject read mObj;
  50     property tag: Integer read mTag;
  51     property grid: TBodyGrid read mGrid;
  52   end;
  53
  54   PGridCell = ^TGridCell;
  55   TGridCell = record
  56     body: TBodyProxy;
  57     next: Integer; // in this cell; index in mCells
  58   end;
  59
  60   TBodyGrid = class(TObject)
  61   private
  62     mTileSize: Integer;
  63     mWidth, mHeight: Integer; // in tiles
  64     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  65     mCells: array of TGridCell; // cell pool
  66     mFreeCell: Integer; // first free cell index or -1
  67     mLastQuery: Integer;
  68     mUsedCells: Integer;
  69
  70   private
  71     function allocCell: Integer;
  72     procedure freeCell (idx: Integer); // `next` is simply overwritten
  73
  74     procedure insert (body: TBodyProxy);
  75     procedure remove (body: TBodyProxy);
  76
  77   public
  78     constructor Create (aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
  79     destructor Destroy (); override;
  80
  81     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
  82     procedure moveBody (body: TBodyProxy; dx, dy: Integer);
  83     procedure resizeBody (body: TBodyProxy; sx, sy: Integer);
  84     procedure moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
  85
  86     function forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
  87
  88     function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
  89
  90     procedure dumpStats ();
  91   end;
  92
  93
  94 implementation
  95
  96 uses
  97   SysUtils;
  98
  99
 100 // ////////////////////////////////////////////////////////////////////////// //
 101 constructor TBodyProxy.Create (aGrid: TBodyGrid; aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 102 begin
 103   mX := aX;
 104   mY := aY;
 105   mWidth := aWidth;
 106   mHeight := aHeight;
 107   mQueryMark := 0;
 108   mObj := aObj;
 109   mGrid := aGrid;
 110   mTag := aTag;
 111 end;
 112
 113 destructor TBodyProxy.Destroy ();
 114 begin
 115 end;
 116
 117
 118 // ////////////////////////////////////////////////////////////////////////// //
 119 constructor TBodyGrid.Create (aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 120 var
 121   idx: Integer;
 122 begin
 123   if aTileSize < 1 then aTileSize := 1;
 124   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 125   if aPixWidth < aTileSize then aPixWidth := aTileSize;
 126   if aPixHeight < aTileSize then aPixHeight := aTileSize;
 127   mTileSize := aTileSize;
 128   mWidth := (aPixWidth+aTileSize-1) div aTileSize;
 129   mHeight := (aPixHeight+aTileSize-1) div aTileSize;
 130   SetLength(mGrid, mWidth*mHeight);
 131   SetLength(mCells, mWidth*mHeight);
 132   mFreeCell := 0;
 133   // init free list
 134   for idx := 0 to High(mCells) do
 135   begin
 136     mCells[idx].body := nil;
 137     mCells[idx].next := idx+1;
 138   end;
 139   mCells[High(mCells)].next := -1; // last cell
 140   // init grid
 141   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 142   mLastQuery := 0;
 143   mUsedCells := 0;
 144   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 145 end;
 146
 147
 148 destructor TBodyGrid.Destroy ();
 149 var
 150   idx: Integer;
 151 begin
 152   // free all owned proxies
 153   for idx := 0 to High(mCells) do mCells[idx].body.Free;
 154   mCells := nil;
 155   mGrid := nil;
 156 end;
 157
 158
 159 procedure TBodyGrid.dumpStats ();
 160 var
 161   idx, mcb, cidx, cnt: Integer;
 162 begin
 163   mcb := 0;
 164   for idx := 0 to High(mGrid) do
 165   begin
 166     cidx := mGrid[idx];
 167     cnt := 0;
 168     while cidx >= 0 do
 169     begin
 170       Inc(cnt);
 171       cidx := mCells[cidx].next;
 172     end;
 173     if (mcb < cnt) then mcb := cnt;
 174   end;
 175   e_WriteLog(Format('grid size: %dx%d (tile size: %d); pix: %dx%d; used cells: %d; max bodys in cell: %d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize, mUsedCells, mcb]), MSG_NOTIFY);
 176 end;
 177
 178
 179 function TBodyGrid.allocCell: Integer;
 180 var
 181   idx: Integer;
 182 begin
 183   if (mFreeCell < 0) then
 184   begin
 185     // no free cells, want more
 186     mFreeCell := Length(mCells);
 187     SetLength(mCells, mFreeCell+16384); // arbitrary number
 188     for idx := mFreeCell 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   end;
 195   result := mFreeCell;
 196   mFreeCell := mCells[result].next;
 197   mCells[result].next := -1;
 198   Inc(mUsedCells);
 199   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 200 end;
 201
 202
 203 procedure TBodyGrid.freeCell (idx: Integer);
 204 begin
 205   if (idx >= 0) and (idx < High(mCells)) then
 206   begin
 207     if mCells[idx].body = nil then exit; // the thing that should not be
 208     mCells[idx].body := nil;
 209     mCells[idx].next := mFreeCell;
 210     mFreeCell := idx;
 211     Dec(mUsedCells);
 212   end;
 213 end;
 214
 215
 216 procedure TBodyGrid.insert (body: TBodyProxy);
 217 var
 218   dx, dy, gx, gy, cidx: Integer;
 219 begin
 220   if body = nil then exit;
 221   if (body.mWidth < 1) or (body.mHeight < 1) then exit;
 222   // out of grid?
 223   if (body.mX+body.mWidth <= 0) or (body.mY+body.mHeight <= 0) then exit;
 224   if (body.mX >= mWidth*mTileSize) or (body.mY >= mHeight*mTileSize) then exit;
 225   //e_WriteLog(Format('grid: inserting body: (%d,%d)-(%dx%d)', [body.mX, body.mY, body.mWidth, body.mHeight]), MSG_NOTIFY);
 226   gy := body.mY div mTileSize;
 227   dy := 0;
 228   while (dy < body.mHeight) do
 229   begin
 230     if (gy >= 0) and (gy < mHeight) then
 231     begin
 232       dx := 0;
 233       gx := body.mX div mTileSize;
 234       while (dx < body.mWidth) do
 235       begin
 236         if (gx >= 0) and (gx < mWidth) then
 237         begin
 238           //e_WriteLog(Format('  00: allocating cell for grid coords (%d,%d), body coords:(%d,%d)', [gx, gy, dx, dy]), MSG_NOTIFY);
 239           cidx := allocCell();
 240           //e_WriteLog(Format('  01: allocated cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
 241           mCells[cidx].body := body;
 242           mCells[cidx].next := mGrid[gy*mWidth+gx];
 243           mGrid[gy*mWidth+gx] := cidx;
 244           //e_WriteLog(Format('  02: put cell for grid coords (%d,%d), body coords:(%d,%d): #%d', [gx, gy, dx, dy, cidx]), MSG_NOTIFY);
 245         end;
 246         Inc(dx, mTileSize);
 247         Inc(gx);
 248       end;
 249     end;
 250     Inc(dy, mTileSize);
 251     Inc(gy);
 252   end;
 253 end;
 254
 255
 256 // absolutely not tested
 257 procedure TBodyGrid.remove (body: TBodyProxy);
 258 var
 259   dx, dy, gx, gy, idx, pidx, tmp: Integer;
 260 begin
 261   if body = nil then exit;
 262   if (body.mWidth < 1) or (body.mHeight < 1) then exit;
 263   // out of grid?
 264   if (body.mX+body.mWidth <= 0) or (body.mY+body.mHeight <= 0) then exit;
 265   if (body.mX >= mWidth*mTileSize) or (body.mY >= mHeight*mTileSize) then exit;
 266   gy := body.mY div mTileSize;
 267   dy := 0;
 268   pidx := -1;
 269   while (dy < body.mHeight) do
 270   begin
 271     if (gy >= 0) and (gy < mHeight) then
 272     begin
 273       dx := 0;
 274       gx := body.mX div mTileSize;
 275       while (dx < body.mWidth) do
 276       begin
 277         if (gx >= 0) and (gx < mWidth) then
 278         begin
 279           // find and remove cell
 280           pidx := -1;
 281           idx := mGrid[gy*mWidth+gx];
 282           while idx >= 0 do
 283           begin
 284             tmp := mCells[idx].next;
 285             if mCells[idx].body = body then
 286             begin
 287               if pidx = -1 then mGrid[gy*mWidth+gx] := tmp else mCells[pidx].next := tmp;
 288               freeCell(idx);
 289             end
 290             else
 291             begin
 292               pidx := idx;
 293             end;
 294             idx := tmp;
 295           end;
 296         end;
 297         Inc(dx, mTileSize);
 298         Inc(gx);
 299       end;
 300     end;
 301     Inc(dy, mTileSize);
 302     Inc(gy);
 303   end;
 304 end;
 305
 306
 307 function TBodyGrid.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxy;
 308 begin
 309   result := nil;
 310   if aObj = nil then exit;
 311   result := TBodyProxy.Create(self, aX, aY, aWidth, aHeight, aObj, aTag);
 312   insert(result);
 313 end;
 314
 315
 316 procedure TBodyGrid.moveResizeBody (body: TBodyProxy; dx, dy, sx, sy: Integer);
 317 begin
 318   if (body = nil) or ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit;
 319   remove(body);
 320   Inc(body.mX, dx);
 321   Inc(body.mY, dy);
 322   Inc(body.mWidth, sx);
 323   Inc(body.mHeight, sy);
 324   insert(body);
 325 end;
 326
 327 procedure TBodyGrid.moveBody (body: TBodyProxy; dx, dy: Integer);
 328 begin
 329   moveResizeBody(body, dx, dy, 0, 0);
 330 end;
 331
 332 procedure TBodyGrid.resizeBody (body: TBodyProxy; sx, sy: Integer);
 333 begin
 334   moveResizeBody(body, 0, 0, sx, sy);
 335 end;
 336
 337
 338 function TBodyGrid.forEachInAABB (x, y, w, h: Integer; cb: GridQueryCB): Boolean;
 339 var
 340   gx, gy, idx: Integer;
 341   minx, miny, maxx, maxy: Integer;
 342 begin
 343   result := false;
 344   if not assigned(cb) then exit;
 345   if (w < 1) or (h < 1) then exit;
 346   minx := x;
 347   miny := y;
 348   maxx := x+w-1;
 349   maxy := y+h-1;
 350   if (minx > maxx) or (miny > maxy) then exit;
 351   if (maxx < 0) or (maxy < 0) then exit;
 352   if (minx >= mWidth*mTileSize) or (miny >= mHeight*mTileSize) then exit;
 353   // increase query counter
 354   Inc(mLastQuery);
 355   if (mLastQuery = 0) then
 356   begin
 357     // just in case of overflow
 358     mLastQuery := 1;
 359     for idx := 0 to High(mCells) do if (mCells[idx].body <> nil) then mCells[idx].body.mQueryMark := 0;
 360   end;
 361   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 362   // process grid
 363   for gy := miny div mTileSize to maxy div mTileSize do
 364   begin
 365     if (gy < 0) then continue;
 366     if (gy >= mHeight) then break;
 367     for gx := minx div mTileSize to maxx div mTileSize do
 368     begin
 369       if (gx < 0) then continue;
 370       if (gx >= mWidth) then break;
 371       idx := mGrid[gy*mWidth+gx];
 372       while idx >= 0 do
 373       begin
 374         if (mCells[idx].body <> nil) and (mCells[idx].body.mQueryMark <> mLastQuery) then
 375         begin
 376           //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);
 377           mCells[idx].body.mQueryMark := mLastQuery;
 378           if (cb(mCells[idx].body.mObj, mCells[idx].body.mTag)) then begin result := true; exit; end;
 379         end;
 380         idx := mCells[idx].next;
 381       end;
 382     end;
 383   end;
 384 end;
 385
 386
 387 function TBodyGrid.getProxyForBody (aObj: TObject; x, y, w, h: Integer): TBodyProxy;
 388
 389   function qq (obj: TObject; tag: Integer): Boolean;
 390   begin
 391     result := (obj = aObj);
 392   end;
 393
 394 begin
 395   result := nil;
 396   forEachInAABB(x, y, w, h, qq);
 397 end;
 398
 399 end.