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
  23 type
  24   TBodyProxyId = Integer;
  25
  26   generic TBodyGridBase<ITP> = class(TObject)
  27   public
  28     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  29     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
  30
  31     const TagDisabled = $40000000;
  32     const TagFullMask = $3fffffff;
  33
  34   private
  35     const
  36       GridDefaultTileSize = 32;
  37       GridCellBucketSize = 8; // WARNING! can't be less than 2!
  38
  39   private
  40     type
  41       PBodyProxyRec = ^TBodyProxyRec;
  42       TBodyProxyRec = record
  43       private
  44         mX, mY, mWidth, mHeight: Integer; // aabb
  45         mQueryMark: LongWord; // was this object visited at this query?
  46         mObj: ITP;
  47         mTag: Integer; // `TagDisabled` set: disabled ;-)
  48         nextLink: TBodyProxyId; // next free or nothing
  49
  50       private
  51         procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
  52       end;
  53
  54       PGridCell = ^TGridCell;
  55       TGridCell = record
  56         bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  57         next: Integer; // in this cell; index in mCells
  58       end;
  59
  60       TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
  61
  62   private
  63     //mTileSize: Integer;
  64     const mTileSize = GridDefaultTileSize;
  65
  66   private
  67     mMinX, mMinY: Integer; // so grids can start at any origin
  68     mWidth, mHeight: Integer; // in tiles
  69     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  70     mCells: array of TGridCell; // cell pool
  71     mFreeCell: Integer; // first free cell index or -1
  72     mLastQuery: LongWord;
  73     mUsedCells: Integer;
  74     mProxies: array of TBodyProxyRec;
  75     mProxyFree: TBodyProxyId; // free
  76     mProxyCount: Integer; // currently used
  77     mProxyMaxCount: Integer;
  78
  79   private
  80     function allocCell (): Integer;
  81     procedure freeCell (idx: Integer); // `next` is simply overwritten
  82
  83     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
  84     procedure freeProxy (body: TBodyProxyId);
  85
  86     procedure insertInternal (body: TBodyProxyId);
  87     procedure removeInternal (body: TBodyProxyId);
  88
  89     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
  90
  91     function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
  92     function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
  93
  94     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
  95     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
  96
  97     function getGridWidthPx (): Integer; inline;
  98     function getGridHeightPx (): Integer; inline;
  99
 100   public
 101     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 102     destructor Destroy (); override;
 103
 104     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 105     procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
 106
 107     procedure moveBody (body: TBodyProxyId; dx, dy: Integer);
 108     procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
 109     procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 110
 111     function insideGrid (x, y: Integer): Boolean; inline;
 112
 113     // `false` if `body` is surely invalid
 114     function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 115
 116     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 117     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 118     // no callback: return `true` on the first hit
 119     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 120
 121     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 122     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 123     // no callback: return `true` on the first hit
 124     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
 125
 126     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 127     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 128     // cb with `(nil)` will be called before processing new tile
 129     // no callback: return `true` on the nearest hit
 130     function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
 131     function traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 132
 133     procedure dumpStats ();
 134
 135     //WARNING! no sanity checks!
 136     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 137
 138     property gridX0: Integer read mMinX;
 139     property gridY0: Integer read mMinY;
 140     property gridWidth: Integer read getGridWidthPx; // in pixels
 141     property gridHeight: Integer read getGridHeightPx; // in pixels
 142   end;
 143
 144
 145 procedure swapInt (var a: Integer; var b: Integer); inline;
 146
 147
 148 implementation
 149
 150 uses
 151   SysUtils, e_log;
 152
 153
 154 // ////////////////////////////////////////////////////////////////////////// //
 155 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
 156
 157
 158 // ////////////////////////////////////////////////////////////////////////// //
 159 // you are not supposed to understand this
 160 // returns `true` if there is an intersection, and enter coords
 161 // enter coords will be equal to (x0, y0) if starting point is inside the box
 162 // if result is `false`, `inx` and `iny` are undefined
 163 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 164 var
 165   wx0, wy0, wx1, wy1: Integer; // window coordinates
 166   stx, sty: Integer; // "steps" for x and y axes
 167   dsx, dsy: Integer; // "lengthes" for x and y axes
 168   dx2, dy2: Integer; // "double lengthes" for x and y axes
 169   xd, yd: Integer; // current coord
 170   e: Integer; // "error" (as in bresenham algo)
 171   rem: Integer;
 172   term: Integer;
 173   d0, d1: PInteger;
 174   xfixed: Boolean;
 175   temp: Integer;
 176 begin
 177   result := false;
 178   // why not
 179   inx := x0;
 180   iny := y0;
 181   if (bw < 1) or (bh < 1) then exit; // impossible box
 182
 183   if (x0 = x1) and (y0 = y1) then
 184   begin
 185     // check this point
 186     result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
 187     exit;
 188   end;
 189
 190   // check if staring point is inside the box
 191   if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
 192
 193   // clip rectange
 194   wx0 := bx;
 195   wy0 := by;
 196   wx1 := bx+bw-1;
 197   wy1 := by+bh-1;
 198
 199   // horizontal setup
 200   if (x0 < x1) then
 201   begin
 202     // from left to right
 203     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
 204     stx := 1; // going right
 205   end
 206   else
 207   begin
 208     // from right to left
 209     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
 210     stx := -1; // going left
 211     x0 := -x0;
 212     x1 := -x1;
 213     wx0 := -wx0;
 214     wx1 := -wx1;
 215     swapInt(wx0, wx1);
 216   end;
 217
 218   // vertical setup
 219   if (y0 < y1) then
 220   begin
 221     // from top to bottom
 222     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
 223     sty := 1; // going down
 224   end
 225   else
 226   begin
 227     // from bottom to top
 228     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
 229     sty := -1; // going up
 230     y0 := -y0;
 231     y1 := -y1;
 232     wy0 := -wy0;
 233     wy1 := -wy1;
 234     swapInt(wy0, wy1);
 235   end;
 236
 237   dsx := x1-x0;
 238   dsy := y1-y0;
 239
 240   if (dsx < dsy) then
 241   begin
 242     d0 := @yd;
 243     d1 := @xd;
 244     swapInt(x0, y0);
 245     swapInt(x1, y1);
 246     swapInt(dsx, dsy);
 247     swapInt(wx0, wy0);
 248     swapInt(wx1, wy1);
 249     swapInt(stx, sty);
 250   end
 251   else
 252   begin
 253     d0 := @xd;
 254     d1 := @yd;
 255   end;
 256
 257   dx2 := 2*dsx;
 258   dy2 := 2*dsy;
 259   xd := x0;
 260   yd := y0;
 261   e := 2*dsy-dsx;
 262   term := x1;
 263
 264   xfixed := false;
 265   if (y0 < wy0) then
 266   begin
 267     // clip at top
 268     temp := dx2*(wy0-y0)-dsx;
 269     xd += temp div dy2;
 270     rem := temp mod dy2;
 271     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
 272     if (xd+1 >= wx0) then
 273     begin
 274       yd := wy0;
 275       e -= rem+dsx;
 276       if (rem > 0) then begin Inc(xd); e += dy2; end;
 277       xfixed := true;
 278     end;
 279   end;
 280
 281   if (not xfixed) and (x0 < wx0) then
 282   begin
 283     // clip at left
 284     temp := dy2*(wx0-x0);
 285     yd += temp div dx2;
 286     rem := temp mod dx2;
 287     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
 288     xd := wx0;
 289     e += rem;
 290     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
 291   end;
 292
 293   if (y1 > wy1) then
 294   begin
 295     // clip at bottom
 296     temp := dx2*(wy1-y0)+dsx;
 297     term := x0+temp div dy2;
 298     rem := temp mod dy2;
 299     if (rem = 0) then Dec(term);
 300   end;
 301
 302   if (term > wx1) then term := wx1; // clip at right
 303
 304   Inc(term); // draw last point
 305   //if (term = xd) then exit; // this is the only point, get out of here
 306
 307   if (sty = -1) then yd := -yd;
 308   if (stx = -1) then begin xd := -xd; term := -term; end;
 309   dx2 -= dy2;
 310
 311   inx := d0^;
 312   iny := d1^;
 313   result := true;
 314 end;
 315
 316
 317 // ////////////////////////////////////////////////////////////////////////// //
 318 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 319 begin
 320   mX := aX;
 321   mY := aY;
 322   mWidth := aWidth;
 323   mHeight := aHeight;
 324   mQueryMark := 0;
 325   mObj := aObj;
 326   mTag := aTag;
 327   nextLink := -1;
 328 end;
 329
 330
 331 // ////////////////////////////////////////////////////////////////////////// //
 332 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 333 var
 334   idx: Integer;
 335 begin
 336   {
 337   if aTileSize < 1 then aTileSize := 1;
 338   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 339   mTileSize := aTileSize;
 340   }
 341   if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
 342   if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
 343   mMinX := aMinPixX;
 344   mMinY := aMinPixY;
 345   mWidth := (aPixWidth+mTileSize-1) div mTileSize;
 346   mHeight := (aPixHeight+mTileSize-1) div mTileSize;
 347   SetLength(mGrid, mWidth*mHeight);
 348   SetLength(mCells, mWidth*mHeight);
 349   SetLength(mProxies, 8192);
 350   mFreeCell := 0;
 351   // init free list
 352   for idx := 0 to High(mCells) do
 353   begin
 354     mCells[idx].bodies[0] := -1;
 355     mCells[idx].next := idx+1;
 356   end;
 357   mCells[High(mCells)].next := -1; // last cell
 358   // init grid
 359   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 360   // init proxies
 361   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 362   mProxies[High(mProxies)].nextLink := -1;
 363   mLastQuery := 0;
 364   mUsedCells := 0;
 365   mProxyFree := 0;
 366   mProxyCount := 0;
 367   mProxyMaxCount := 0;
 368   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 369 end;
 370
 371
 372 destructor TBodyGridBase.Destroy ();
 373 begin
 374   mCells := nil;
 375   mGrid := nil;
 376   mProxies := nil;
 377   inherited;
 378 end;
 379
 380
 381 // ////////////////////////////////////////////////////////////////////////// //
 382 procedure TBodyGridBase.dumpStats ();
 383 var
 384   idx, mcb, cidx, cnt: Integer;
 385 begin
 386   mcb := 0;
 387   for idx := 0 to High(mGrid) do
 388   begin
 389     cidx := mGrid[idx];
 390     cnt := 0;
 391     while cidx >= 0 do
 392     begin
 393       Inc(cnt);
 394       cidx := mCells[cidx].next;
 395     end;
 396     if (mcb < cnt) then mcb := cnt;
 397   end;
 398   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);
 399 end;
 400
 401
 402 // ////////////////////////////////////////////////////////////////////////// //
 403 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
 404 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
 405
 406
 407 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 408 begin
 409   // fix coords
 410   Dec(x, mMinX);
 411   Dec(y, mMinY);
 412   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 413 end;
 414
 415
 416 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 417 begin
 418   if (body >= 0) and (body < Length(mProxies)) then
 419   begin
 420     with mProxies[body] do begin rx := mX; ry := mY; end;
 421     result := true;
 422   end
 423   else
 424   begin
 425     rx := 0;
 426     ry := 0;
 427     result := false;
 428   end;
 429 end;
 430
 431
 432 // ////////////////////////////////////////////////////////////////////////// //
 433 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 434 begin
 435   if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 436 end;
 437
 438
 439 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 440 begin
 441   if (pid >= 0) then
 442   begin
 443     if val then
 444     begin
 445       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 446     end
 447     else
 448     begin
 449       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
 450     end;
 451   end;
 452 end;
 453
 454
 455 // ////////////////////////////////////////////////////////////////////////// //
 456 function TBodyGridBase.allocCell (): Integer;
 457 var
 458   idx: Integer;
 459 begin
 460   if (mFreeCell < 0) then
 461   begin
 462     // no free cells, want more
 463     mFreeCell := Length(mCells);
 464     SetLength(mCells, mFreeCell+32768); // arbitrary number
 465     for idx := mFreeCell to High(mCells) do
 466     begin
 467       mCells[idx].bodies[0] := -1;
 468       mCells[idx].next := idx+1;
 469     end;
 470     mCells[High(mCells)].next := -1; // last cell
 471   end;
 472   result := mFreeCell;
 473   mFreeCell := mCells[result].next;
 474   mCells[result].next := -1;
 475   mCells[result].bodies[0] := -1;
 476   Inc(mUsedCells);
 477   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 478 end;
 479
 480
 481 procedure TBodyGridBase.freeCell (idx: Integer);
 482 begin
 483   if (idx >= 0) and (idx < Length(mCells)) then
 484   begin
 485     //if mCells[idx].body = -1 then exit; // the thing that should not be
 486     mCells[idx].bodies[0] := -1;
 487     mCells[idx].next := mFreeCell;
 488     mFreeCell := idx;
 489     Dec(mUsedCells);
 490   end;
 491 end;
 492
 493
 494 // ////////////////////////////////////////////////////////////////////////// //
 495 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 496 var
 497   olen, idx: Integer;
 498   px: PBodyProxyRec;
 499 begin
 500   if (mProxyFree = -1) then
 501   begin
 502     // no free proxies, resize list
 503     olen := Length(mProxies);
 504     SetLength(mProxies, olen+8192); // arbitrary number
 505     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 506     mProxies[High(mProxies)].nextLink := -1;
 507     mProxyFree := olen;
 508   end;
 509   // get one from list
 510   result := mProxyFree;
 511   px := @mProxies[result];
 512   mProxyFree := px.nextLink;
 513   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 514   // add to used list
 515   px.nextLink := -1;
 516   // statistics
 517   Inc(mProxyCount);
 518   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 519 end;
 520
 521 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 522 begin
 523   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 524   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 525   // add to free list
 526   mProxies[body].mObj := nil;
 527   mProxies[body].nextLink := mProxyFree;
 528   mProxyFree := body;
 529   Dec(mProxyCount);
 530 end;
 531
 532
 533 // ////////////////////////////////////////////////////////////////////////// //
 534 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 535 const
 536   tsize = mTileSize;
 537 var
 538   gx, gy: Integer;
 539   gw, gh: Integer;
 540 begin
 541   result := false;
 542   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 543   // fix coords
 544   Dec(x, mMinX);
 545   Dec(y, mMinY);
 546   // go on
 547   if (x+w <= 0) or (y+h <= 0) then exit;
 548   gw := mWidth;
 549   gh := mHeight;
 550   //tsize := mTileSize;
 551   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 552   for gy := y div tsize to (y+h-1) div tsize do
 553   begin
 554     if (gy < 0) then continue;
 555     if (gy >= gh) then break;
 556     for gx := x div tsize to (x+w-1) div tsize do
 557     begin
 558       if (gx < 0) then continue;
 559       if (gx >= gw) then break;
 560       result := cb(gy*gw+gx, bodyId);
 561       if result then exit;
 562     end;
 563   end;
 564 end;
 565
 566
 567 // ////////////////////////////////////////////////////////////////////////// //
 568 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 569 var
 570   cidx: Integer;
 571   pc: Integer;
 572   pi: PGridCell;
 573   f: Integer;
 574 begin
 575   result := false; // never stop
 576   // add body to the given grid cell
 577   pc := mGrid[grida];
 578   if (pc <> -1) then
 579   begin
 580     pi := @mCells[pc];
 581     f := 0;
 582     for f := 0 to High(TGridCell.bodies) do
 583     begin
 584       if (pi.bodies[f] = -1) then
 585       begin
 586         // can add here
 587         pi.bodies[f] := bodyId;
 588         if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
 589         exit;
 590       end;
 591     end;
 592   end;
 593   // either no room, or no cell at all
 594   cidx := allocCell();
 595   mCells[cidx].bodies[0] := bodyId;
 596   mCells[cidx].bodies[1] := -1;
 597   mCells[cidx].next := pc;
 598   mGrid[grida] := cidx;
 599 end;
 600
 601 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
 602 var
 603   px: PBodyProxyRec;
 604 begin
 605   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 606   px := @mProxies[body];
 607   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
 608 end;
 609
 610
 611 // absolutely not tested
 612 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 613 var
 614   f: Integer;
 615   pidx, idx, tmp: Integer;
 616   pc: PGridCell;
 617 begin
 618   result := false; // never stop
 619   // find and remove cell
 620   pidx := -1;
 621   idx := mGrid[grida];
 622   while (idx >= 0) do
 623   begin
 624     tmp := mCells[idx].next;
 625     pc := @mCells[idx];
 626     f := 0;
 627     while (f < High(TGridCell.bodies)) do
 628     begin
 629       if (pc.bodies[f] = bodyId) then
 630       begin
 631         // i found her!
 632         if (f = 0) and (pc.bodies[1] = -1) then
 633         begin
 634           // this cell contains no elements, remove it
 635           tmp := mCells[idx].next;
 636           if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 637           freeCell(idx);
 638         end
 639         else
 640         begin
 641           // remove element from bucket
 642           Inc(f);
 643           while (f < High(TGridCell.bodies)) do
 644           begin
 645             pc.bodies[f-1] := pc.bodies[f];
 646             if (pc.bodies[f] = -1) then break;
 647             Inc(f);
 648           end;
 649           pc.bodies[High(TGridCell.bodies)] := -1; // just in case
 650         end;
 651         exit; // assume that we cannot have one object added to bucket twice
 652       end;
 653       Inc(f);
 654     end;
 655     pidx := idx;
 656     idx := tmp;
 657   end;
 658 end;
 659
 660 // absolutely not tested
 661 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
 662 var
 663   px: PBodyProxyRec;
 664 begin
 665   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 666   px := @mProxies[body];
 667   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
 668 end;
 669
 670
 671 // ////////////////////////////////////////////////////////////////////////// //
 672 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 673 begin
 674   aTag := aTag and TagFullMask;
 675   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 676   insertInternal(result);
 677 end;
 678
 679
 680 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
 681 begin
 682   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 683   removeInternal(body);
 684   freeProxy(body);
 685 end;
 686
 687
 688 // ////////////////////////////////////////////////////////////////////////// //
 689 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 690 var
 691   px: PBodyProxyRec;
 692   x0, y0, w, h: Integer;
 693 begin
 694   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 695   if (dx = 0) and (dy = 0) and (sx = 0) and (sy = 0) then exit;
 696   px := @mProxies[body];
 697   x0 := px.mX;
 698   y0 := px.mY;
 699   w := px.mWidth;
 700   h := px.mHeight;
 701   // did any corner crossed tile boundary?
 702   if (x0 div mTileSize <> (x0+dx) div mTileSize) or
 703      (y0 div mTileSize <> (y0+dx) div mTileSize) or
 704      ((x0+w) div mTileSize <> (x0+w+sx) div mTileSize) or
 705      ((y0+h) div mTileSize <> (y0+h+sy) div mTileSize) then
 706   begin
 707     removeInternal(body);
 708     Inc(px.mX, dx);
 709     Inc(px.mY, dy);
 710     Inc(px.mWidth, sx);
 711     Inc(px.mHeight, sy);
 712     insertInternal(body);
 713   end
 714   else
 715   begin
 716     Inc(px.mX, dx);
 717     Inc(px.mY, dy);
 718     Inc(px.mWidth, sx);
 719     Inc(px.mHeight, sy);
 720   end;
 721 end;
 722
 723 procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
 724 var
 725   px: PBodyProxyRec;
 726   nx, ny: Integer;
 727 begin
 728   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 729   if (dx = 0) and (dy = 0) then exit;
 730   // check if tile coords was changed
 731   px := @mProxies[body];
 732   nx := px.mX+dx;
 733   ny := px.mY+dy;
 734   if (nx div mTileSize <> px.mX div mTileSize) or (ny div mTileSize <> px.mY div mTileSize) then
 735   begin
 736     // crossed tile boundary, do heavy work
 737     moveResizeBody(body, dx, dy, 0, 0);
 738   end
 739   else
 740   begin
 741     // nothing to do with the grid, just fix coordinates
 742     px.mX := nx;
 743     px.mY := ny;
 744   end;
 745 end;
 746
 747 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer);
 748 var
 749   px: PBodyProxyRec;
 750   x0, y0: Integer;
 751   nw, nh: Integer;
 752 begin
 753   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 754   if (sx = 0) and (sy = 0) then exit;
 755   // check if tile coords was changed
 756   px := @mProxies[body];
 757   x0 := px.mX;
 758   y0 := px.mY;
 759   nw := px.mWidth+sx;
 760   nh := px.mHeight+sy;
 761   if ((x0+px.mWidth) div mTileSize <> (x0+nw) div mTileSize) or
 762      ((y0+px.mHeight) div mTileSize <> (y0+nh) div mTileSize) then
 763   begin
 764     // crossed tile boundary, do heavy work
 765     moveResizeBody(body, 0, 0, sx, sy);
 766   end
 767   else
 768   begin
 769     // nothing to do with the grid, just fix size
 770     px.mWidth := nw;
 771     px.mHeight := nh;
 772   end;
 773 end;
 774
 775
 776 // ////////////////////////////////////////////////////////////////////////// //
 777 // no callback: return `true` on the first hit
 778 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
 779 var
 780   f: Integer;
 781   idx, curci: Integer;
 782   cc: PGridCell = nil;
 783   px: PBodyProxyRec;
 784   lq: LongWord;
 785   ptag: Integer;
 786 begin
 787   result := Default(ITP);
 788   tagmask := tagmask and TagFullMask;
 789   if (tagmask = 0) then exit;
 790
 791   // make coords (0,0)-based
 792   Dec(x, mMinX);
 793   Dec(y, mMinY);
 794   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
 795
 796   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 797   // restore coords
 798   Inc(x, mMinX);
 799   Inc(y, mMinY);
 800
 801   // increase query counter
 802   Inc(mLastQuery);
 803   if (mLastQuery = 0) then
 804   begin
 805     // just in case of overflow
 806     mLastQuery := 1;
 807     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 808   end;
 809   lq := mLastQuery;
 810
 811   while (curci <> -1) do
 812   begin
 813     cc := @mCells[curci];
 814     for f := 0 to High(TGridCell.bodies) do
 815     begin
 816       if (cc.bodies[f] = -1) then break;
 817       px := @mProxies[cc.bodies[f]];
 818       ptag := px.mTag;
 819       if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 820       begin
 821         if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
 822         begin
 823           px.mQueryMark := lq;
 824           if assigned(cb) then
 825           begin
 826             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
 827           end
 828           else
 829           begin
 830             result := px.mObj;
 831             exit;
 832           end;
 833         end;
 834       end;
 835     end;
 836     curci := cc.next;
 837   end;
 838 end;
 839
 840
 841 // ////////////////////////////////////////////////////////////////////////// //
 842 // no callback: return `true` on the first hit
 843 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 844 const
 845   tsize = mTileSize;
 846 var
 847   idx: Integer;
 848   gx, gy: Integer;
 849   curci: Integer;
 850   f: Integer;
 851   cc: PGridCell = nil;
 852   px: PBodyProxyRec;
 853   lq: LongWord;
 854   gw: Integer;
 855   x0, y0: Integer;
 856   ptag: Integer;
 857 begin
 858   result := Default(ITP);
 859   if (w < 1) or (h < 1) then exit;
 860   tagmask := tagmask and TagFullMask;
 861   if (tagmask = 0) then exit;
 862
 863   x0 := x;
 864   y0 := y;
 865
 866   // fix coords
 867   Dec(x, mMinX);
 868   Dec(y, mMinY);
 869
 870   gw := mWidth;
 871   //tsize := mTileSize;
 872
 873   if (x+w <= 0) or (y+h <= 0) then exit;
 874   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
 875
 876   // increase query counter
 877   Inc(mLastQuery);
 878   if (mLastQuery = 0) then
 879   begin
 880     // just in case of overflow
 881     mLastQuery := 1;
 882     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 883   end;
 884   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 885   lq := mLastQuery;
 886
 887   // go on
 888   for gy := y div tsize to (y+h-1) div tsize do
 889   begin
 890     if (gy < 0) then continue;
 891     if (gy >= mHeight) then break;
 892     for gx := x div tsize to (x+w-1) div tsize do
 893     begin
 894       if (gx < 0) then continue;
 895       if (gx >= gw) then break;
 896       // process cells
 897       curci := mGrid[gy*gw+gx];
 898       while (curci <> -1) do
 899       begin
 900         cc := @mCells[curci];
 901         for f := 0 to High(TGridCell.bodies) do
 902         begin
 903           if (cc.bodies[f] = -1) then break;
 904           px := @mProxies[cc.bodies[f]];
 905           ptag := px.mTag;
 906           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
 907           if ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 908           //if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 909           //if ( ((ptag and TagDisabled) = 0) = ignoreDisabled) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 910           begin
 911             if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
 912             if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
 913             px.mQueryMark := lq;
 914             if assigned(cb) then
 915             begin
 916               if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
 917             end
 918             else
 919             begin
 920               result := px.mObj;
 921               exit;
 922             end;
 923           end;
 924         end;
 925         curci := cc.next;
 926       end;
 927     end;
 928   end;
 929 end;
 930
 931
 932 // ////////////////////////////////////////////////////////////////////////// //
 933 // no callback: return `true` on the nearest hit
 934 function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 935 var
 936   ex, ey: Integer;
 937 begin
 938   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
 939 end;
 940
 941
 942 // no callback: return `true` on the nearest hit
 943 function TBodyGridBase.traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 944 const
 945   tsize = mTileSize;
 946 var
 947   i: Integer;
 948   dx, dy, d: Integer;
 949   xerr, yerr: Integer;
 950   incx, incy: Integer;
 951   stepx, stepy: Integer;
 952   x, y: Integer;
 953   maxx, maxy: Integer;
 954   gw, gh: Integer;
 955   ccidx: Integer;
 956   curci: Integer;
 957   cc: PGridCell;
 958   hasUntried: Boolean;
 959   px: PBodyProxyRec;
 960   lq: LongWord;
 961   prevX, prevY: Integer;
 962   minx, miny: Integer;
 963   ptag: Integer;
 964   lastDistSq, distSq: Integer;
 965   wasHit: Boolean = false;
 966   lastObj: ITP;
 967   lastWasInGrid: Boolean;
 968   tbcross: Boolean;
 969   f: Integer;
 970 begin
 971   result := Default(ITP);
 972   lastObj := Default(ITP);
 973   tagmask := tagmask and TagFullMask;
 974   if (tagmask = 0) then begin ex := x0; ey := y0; exit; end;
 975
 976   minx := mMinX;
 977   miny := mMinY;
 978
 979   dx := x1-x0;
 980   dy := y1-y0;
 981
 982   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
 983   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
 984
 985   dx := abs(dx);
 986   dy := abs(dy);
 987
 988   if (dx > dy) then d := dx else d := dy;
 989
 990   // `x` and `y` will be in grid coords
 991   x := x0-minx;
 992   y := y0-miny;
 993
 994   // increase query counter
 995   Inc(mLastQuery);
 996   if (mLastQuery = 0) then
 997   begin
 998     // just in case of overflow
 999     mLastQuery := 1;
1000     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1001   end;
1002   lq := mLastQuery;
1003
1004   // cache various things
1005   //tsize := mTileSize;
1006   gw := mWidth;
1007   gh := mHeight;
1008   maxx := gw*tsize-1;
1009   maxy := gh*tsize-1;
1010
1011   // setup distance and flags
1012   lastDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1;
1013   lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1014
1015   // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1016   if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1017
1018   // it is slightly faster this way
1019   xerr := -d;
1020   yerr := -d;
1021
1022   // now trace
1023   for i := 1 to d do
1024   begin
1025     // prevs are always in map coords
1026     prevX := x+minx;
1027     prevY := y+miny;
1028     // do one step
1029     xerr += dx;
1030     yerr += dy;
1031     // invariant: one of those always changed
1032     if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1033     if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1034     if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1035     // invariant: we always doing a step
1036     if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1037     begin
1038       // check for crossing tile/grid boundary
1039       if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1040       begin
1041         // we're still in grid
1042         lastWasInGrid := true;
1043         // check for tile edge crossing
1044              if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1045         else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1046         else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1047         else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1048         else tbcross := false;
1049         // crossed tile edge?
1050         if tbcross then
1051         begin
1052           // had something in the cell we're leaving?
1053           if (ccidx <> -1) then
1054           begin
1055             // yes, signal cell completion
1056             if assigned(cb) then
1057             begin
1058               if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
1059             end
1060             else if wasHit then
1061             begin
1062               result := lastObj;
1063               exit;
1064             end;
1065           end;
1066           // setup new cell index
1067           ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1068         end;
1069       end
1070       else
1071       begin
1072         // out of grid, had something in the last processed cell?
1073         if (ccidx <> -1) then
1074         begin
1075           // yes, signal cell completion
1076           ccidx := -1;
1077           if assigned(cb) then
1078           begin
1079             if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
1080           end
1081           else if wasHit then
1082           begin
1083             result := lastObj;
1084             exit;
1085           end;
1086         end;
1087         if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1088       end;
1089     end;
1090
1091     // has something to process in the current cell?
1092     if (ccidx <> -1) then
1093     begin
1094       // process cell
1095       curci := ccidx;
1096       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1097       // convert coords to map (to avoid ajdusting coords inside the loop)
1098       Inc(x, minx);
1099       Inc(y, miny);
1100       // process cell list
1101       while (curci <> -1) do
1102       begin
1103         cc := @mCells[curci];
1104         for f := 0 to High(TGridCell.bodies) do
1105         begin
1106           if (cc.bodies[f] = -1) then break;
1107           px := @mProxies[cc.bodies[f]];
1108           ptag := px.mTag;
1109           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1110           begin
1111             // can we process this proxy?
1112             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1113             begin
1114               px.mQueryMark := lq; // mark as processed
1115               if assigned(cb) then
1116               begin
1117                 if cb(px.mObj, ptag, x, y, prevX, prevY) then
1118                 begin
1119                   result := lastObj;
1120                   ex := prevX;
1121                   ey := prevY;
1122                   exit;
1123                 end;
1124               end
1125               else
1126               begin
1127                 // remember this hitpoint if it is nearer than an old one
1128                 distSq := (prevX-x0)*(prevX-x0)+(prevY-y0)*(prevY-y0);
1129                 if (distSq < lastDistSq) then
1130                 begin
1131                   wasHit := true;
1132                   lastDistSq := distSq;
1133                   ex := prevX;
1134                   ey := prevY;
1135                   lastObj := px.mObj;
1136                 end;
1137               end;
1138             end
1139             else
1140             begin
1141               // this is possibly interesting proxy, set "has more to check" flag
1142               hasUntried := true;
1143             end;
1144           end;
1145         end;
1146         // next cell
1147         curci := cc.next;
1148       end;
1149       // still has something interesting in this cell?
1150       if not hasUntried then
1151       begin
1152         // nope, don't process this cell anymore; signal cell completion
1153         ccidx := -1;
1154         if assigned(cb) then
1155         begin
1156           if cb(nil, 0, x, y, prevX, prevY) then begin result := lastObj; exit; end;
1157         end
1158         else if wasHit then
1159         begin
1160           result := lastObj;
1161           exit;
1162         end;
1163       end;
1164       // convert coords to grid
1165       Dec(x, minx);
1166       Dec(y, miny);
1167     end;
1168   end;
1169 end;
1170
1171
1172 end.