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     mMinX, mMinY: Integer; // so grids can start at any origin
  65     mWidth, mHeight: Integer; // in tiles
  66     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  67     mCells: array of TGridCell; // cell pool
  68     mFreeCell: Integer; // first free cell index or -1
  69     mLastQuery: LongWord;
  70     mUsedCells: Integer;
  71     mProxies: array of TBodyProxyRec;
  72     mProxyFree: TBodyProxyId; // free
  73     mProxyCount: Integer; // currently used
  74     mProxyMaxCount: Integer;
  75
  76   private
  77     function allocCell: Integer;
  78     procedure freeCell (idx: Integer); // `next` is simply overwritten
  79
  80     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
  81     procedure freeProxy (body: TBodyProxyId);
  82
  83     procedure insertInternal (body: TBodyProxyId);
  84     procedure removeInternal (body: TBodyProxyId);
  85
  86     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
  87
  88     function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
  89     function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
  90
  91     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
  92     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
  93
  94   public
  95     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
  96     destructor Destroy (); override;
  97
  98     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
  99     procedure removeBody (aObj: TBodyProxyId); // WARNING! this WILL destroy proxy!
 100
 101     procedure moveBody (body: TBodyProxyId; dx, dy: Integer);
 102     procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
 103     procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 104
 105     function insideGrid (x, y: Integer): Boolean; inline;
 106
 107     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 108     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 109     // no callback: return `true` on the first hit
 110     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 111
 112     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 113     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 114     // no callback: return `true` on the first hit
 115     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
 116
 117     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 118     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 119     // cb with `(nil)` will be called before processing new tile
 120     // no callback: return `true` on the nearest hit
 121     function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
 122     function traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 123
 124     procedure dumpStats ();
 125
 126     //WARNING! no sanity checks!
 127     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 128   end;
 129
 130
 131 implementation
 132
 133 uses
 134   SysUtils, e_log;
 135
 136
 137 // ////////////////////////////////////////////////////////////////////////// //
 138 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 139 begin
 140   mX := aX;
 141   mY := aY;
 142   mWidth := aWidth;
 143   mHeight := aHeight;
 144   mQueryMark := 0;
 145   mObj := aObj;
 146   mTag := aTag;
 147   nextLink := -1;
 148 end;
 149
 150
 151 // ////////////////////////////////////////////////////////////////////////// //
 152 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 153 var
 154   idx: Integer;
 155 begin
 156   if aTileSize < 1 then aTileSize := 1;
 157   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 158   if aPixWidth < aTileSize then aPixWidth := aTileSize;
 159   if aPixHeight < aTileSize then aPixHeight := aTileSize;
 160   mTileSize := aTileSize;
 161   mMinX := aMinPixX;
 162   mMinY := aMinPixY;
 163   mWidth := (aPixWidth+aTileSize-1) div aTileSize;
 164   mHeight := (aPixHeight+aTileSize-1) div aTileSize;
 165   SetLength(mGrid, mWidth*mHeight);
 166   SetLength(mCells, mWidth*mHeight);
 167   SetLength(mProxies, 8192);
 168   mFreeCell := 0;
 169   // init free list
 170   for idx := 0 to High(mCells) do
 171   begin
 172     mCells[idx].bodies[0] := -1;
 173     mCells[idx].next := idx+1;
 174   end;
 175   mCells[High(mCells)].next := -1; // last cell
 176   // init grid
 177   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 178   // init proxies
 179   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 180   mProxies[High(mProxies)].nextLink := -1;
 181   mLastQuery := 0;
 182   mUsedCells := 0;
 183   mProxyFree := 0;
 184   mProxyCount := 0;
 185   mProxyMaxCount := 0;
 186   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 187 end;
 188
 189
 190 destructor TBodyGridBase.Destroy ();
 191 begin
 192   mCells := nil;
 193   mGrid := nil;
 194   mProxies := nil;
 195   inherited;
 196 end;
 197
 198
 199 procedure TBodyGridBase.dumpStats ();
 200 var
 201   idx, mcb, cidx, cnt: Integer;
 202 begin
 203   mcb := 0;
 204   for idx := 0 to High(mGrid) do
 205   begin
 206     cidx := mGrid[idx];
 207     cnt := 0;
 208     while cidx >= 0 do
 209     begin
 210       Inc(cnt);
 211       cidx := mCells[cidx].next;
 212     end;
 213     if (mcb < cnt) then mcb := cnt;
 214   end;
 215   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);
 216 end;
 217
 218
 219 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 220 begin
 221   // fix coords
 222   Dec(x, mMinX);
 223   Dec(y, mMinY);
 224   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 225 end;
 226
 227
 228 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 229 begin
 230   if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 231 end;
 232
 233
 234 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 235 begin
 236   if (pid >= 0) then
 237   begin
 238     if val then
 239     begin
 240       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 241     end
 242     else
 243     begin
 244       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
 245     end;
 246   end;
 247 end;
 248
 249
 250 function TBodyGridBase.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].bodies[0] := -1;
 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   mCells[result].bodies[0] := -1;
 270   Inc(mUsedCells);
 271   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 272 end;
 273
 274
 275 procedure TBodyGridBase.freeCell (idx: Integer);
 276 begin
 277   if (idx >= 0) and (idx < Length(mCells)) then
 278   begin
 279     //if mCells[idx].body = -1 then exit; // the thing that should not be
 280     mCells[idx].bodies[0] := -1;
 281     mCells[idx].next := mFreeCell;
 282     mFreeCell := idx;
 283     Dec(mUsedCells);
 284   end;
 285 end;
 286
 287
 288 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 289 var
 290   olen, idx: Integer;
 291   px: PBodyProxyRec;
 292 begin
 293   if (mProxyFree = -1) then
 294   begin
 295     // no free proxies, resize list
 296     olen := Length(mProxies);
 297     SetLength(mProxies, olen+8192); // arbitrary number
 298     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 299     mProxies[High(mProxies)].nextLink := -1;
 300     mProxyFree := olen;
 301   end;
 302   // get one from list
 303   result := mProxyFree;
 304   px := @mProxies[result];
 305   mProxyFree := px.nextLink;
 306   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 307   // add to used list
 308   px.nextLink := -1;
 309   // statistics
 310   Inc(mProxyCount);
 311   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 312 end;
 313
 314 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 315 begin
 316   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 317   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 318   // add to free list
 319   mProxies[body].mObj := nil;
 320   mProxies[body].nextLink := mProxyFree;
 321   mProxyFree := body;
 322   Dec(mProxyCount);
 323 end;
 324
 325
 326 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 327 var
 328   gx, gy: Integer;
 329   gw, gh, tsize: Integer;
 330 begin
 331   result := false;
 332   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 333   // fix coords
 334   Dec(x, mMinX);
 335   Dec(y, mMinY);
 336   // go on
 337   if (x+w <= 0) or (y+h <= 0) then exit;
 338   gw := mWidth;
 339   gh := mHeight;
 340   tsize := mTileSize;
 341   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 342   for gy := y div tsize to (y+h-1) div tsize do
 343   begin
 344     if (gy < 0) then continue;
 345     if (gy >= gh) then break;
 346     for gx := x div tsize to (x+w-1) div tsize do
 347     begin
 348       if (gx < 0) then continue;
 349       if (gx >= gw) then break;
 350       result := cb(gy*gw+gx, bodyId);
 351       if result then exit;
 352     end;
 353   end;
 354 end;
 355
 356
 357 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 358 var
 359   cidx: Integer;
 360   pc: Integer;
 361   pi: PGridCell;
 362   f: Integer;
 363 begin
 364   result := false; // never stop
 365   // add body to the given grid cell
 366   pc := mGrid[grida];
 367   if (pc <> -1) then
 368   begin
 369     pi := @mCells[pc];
 370     f := 0;
 371     for f := 0 to High(TGridCell.bodies) do
 372     begin
 373       if (pi.bodies[f] = -1) then
 374       begin
 375         // can add here
 376         pi.bodies[f] := bodyId;
 377         if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
 378         exit;
 379       end;
 380     end;
 381   end;
 382   // either no room, or no cell at all
 383   cidx := allocCell();
 384   mCells[cidx].bodies[0] := bodyId;
 385   mCells[cidx].bodies[1] := -1;
 386   mCells[cidx].next := pc;
 387   mGrid[grida] := cidx;
 388 end;
 389
 390 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
 391 var
 392   px: PBodyProxyRec;
 393 begin
 394   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 395   px := @mProxies[body];
 396   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
 397 end;
 398
 399
 400 // absolutely not tested
 401 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 402 var
 403   f: Integer;
 404   pidx, idx, tmp: Integer;
 405   pc: PGridCell;
 406 begin
 407   result := false; // never stop
 408   // find and remove cell
 409   pidx := -1;
 410   idx := mGrid[grida];
 411   while (idx >= 0) do
 412   begin
 413     tmp := mCells[idx].next;
 414     pc := @mCells[idx];
 415     f := 0;
 416     while (f < High(TGridCell.bodies)) do
 417     begin
 418       if (pc.bodies[f] = bodyId) then
 419       begin
 420         // i found her!
 421         if (f = 0) and (pc.bodies[1] = -1) then
 422         begin
 423           // this cell contains no elements, remove it
 424           tmp := mCells[idx].next;
 425           if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 426           freeCell(idx);
 427         end
 428         else
 429         begin
 430           // remove element from bucket
 431           Inc(f);
 432           while (f < High(TGridCell.bodies)) do
 433           begin
 434             pc.bodies[f-1] := pc.bodies[f];
 435             if (pc.bodies[f] = -1) then break;
 436             Inc(f);
 437           end;
 438           pc.bodies[High(TGridCell.bodies)] := -1; // just in case
 439         end;
 440         exit; // assume that we cannot have one object added to bucket twice
 441       end;
 442       Inc(f);
 443     end;
 444     pidx := idx;
 445     idx := tmp;
 446   end;
 447 end;
 448
 449 // absolutely not tested
 450 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
 451 var
 452   px: PBodyProxyRec;
 453 begin
 454   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 455   px := @mProxies[body];
 456   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
 457 end;
 458
 459
 460 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 461 begin
 462   aTag := aTag and TagFullMask;
 463   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 464   insertInternal(result);
 465 end;
 466
 467
 468 procedure TBodyGridBase.removeBody (aObj: TBodyProxyId);
 469 begin
 470   if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case
 471   removeInternal(aObj);
 472   freeProxy(aObj);
 473 end;
 474
 475
 476 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 477 var
 478   px: PBodyProxyRec;
 479 begin
 480   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 481   if ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit;
 482   removeInternal(body);
 483   px := @mProxies[body];
 484   Inc(px.mX, dx);
 485   Inc(px.mY, dy);
 486   Inc(px.mWidth, sx);
 487   Inc(px.mHeight, sy);
 488   insertInternal(body);
 489 end;
 490
 491 procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
 492 begin
 493   moveResizeBody(body, dx, dy, 0, 0);
 494 end;
 495
 496 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer);
 497 begin
 498   moveResizeBody(body, 0, 0, sx, sy);
 499 end;
 500
 501
 502 // ////////////////////////////////////////////////////////////////////////// //
 503 // no callback: return `true` on the first hit
 504 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
 505 var
 506   f: Integer;
 507   idx, curci: Integer;
 508   cc: PGridCell = nil;
 509   px: PBodyProxyRec;
 510   lq: LongWord;
 511   ptag: Integer;
 512 begin
 513   result := Default(ITP);
 514   tagmask := tagmask and TagFullMask;
 515   if (tagmask = 0) then exit;
 516
 517   // make coords (0,0)-based
 518   Dec(x, mMinX);
 519   Dec(y, mMinY);
 520   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
 521
 522   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 523   // restore coords
 524   Inc(x, mMinX);
 525   Inc(y, mMinY);
 526
 527   // increase query counter
 528   Inc(mLastQuery);
 529   if (mLastQuery = 0) then
 530   begin
 531     // just in case of overflow
 532     mLastQuery := 1;
 533     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 534   end;
 535   lq := mLastQuery;
 536
 537   while (curci <> -1) do
 538   begin
 539     cc := @mCells[curci];
 540     for f := 0 to High(TGridCell.bodies) do
 541     begin
 542       if (cc.bodies[f] = -1) then break;
 543       px := @mProxies[cc.bodies[f]];
 544       ptag := px.mTag;
 545       if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 546       begin
 547         if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
 548         begin
 549           px.mQueryMark := lq;
 550           if assigned(cb) then
 551           begin
 552             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
 553           end
 554           else
 555           begin
 556             result := px.mObj;
 557             exit;
 558           end;
 559         end;
 560       end;
 561     end;
 562     curci := cc.next;
 563   end;
 564 end;
 565
 566
 567 // no callback: return `true` on the first hit
 568 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 569 var
 570   idx: Integer;
 571   gx, gy: Integer;
 572   curci: Integer;
 573   f: Integer;
 574   cc: PGridCell = nil;
 575   px: PBodyProxyRec;
 576   lq: LongWord;
 577   tsize, gw: Integer;
 578   x0, y0: Integer;
 579   ptag: Integer;
 580 begin
 581   result := Default(ITP);
 582   if (w < 1) or (h < 1) then exit;
 583   tagmask := tagmask and TagFullMask;
 584   if (tagmask = 0) then exit;
 585
 586   x0 := x;
 587   y0 := y;
 588
 589   // fix coords
 590   Dec(x, mMinX);
 591   Dec(y, mMinY);
 592
 593   gw := mWidth;
 594   tsize := mTileSize;
 595
 596   if (x+w <= 0) or (y+h <= 0) then exit;
 597   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
 598
 599   // increase query counter
 600   Inc(mLastQuery);
 601   if (mLastQuery = 0) then
 602   begin
 603     // just in case of overflow
 604     mLastQuery := 1;
 605     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 606   end;
 607   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 608   lq := mLastQuery;
 609
 610   // go on
 611   for gy := y div tsize to (y+h-1) div tsize do
 612   begin
 613     if (gy < 0) then continue;
 614     if (gy >= mHeight) then break;
 615     for gx := x div tsize to (x+w-1) div tsize do
 616     begin
 617       if (gx < 0) then continue;
 618       if (gx >= gw) then break;
 619       // process cells
 620       curci := mGrid[gy*gw+gx];
 621       while (curci <> -1) do
 622       begin
 623         cc := @mCells[curci];
 624         for f := 0 to High(TGridCell.bodies) do
 625         begin
 626           if (cc.bodies[f] = -1) then break;
 627           px := @mProxies[cc.bodies[f]];
 628           ptag := px.mTag;
 629           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
 630           if ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 631           //if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 632           //if ( ((ptag and TagDisabled) = 0) = ignoreDisabled) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 633           begin
 634             if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
 635             if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
 636             px.mQueryMark := lq;
 637             if assigned(cb) then
 638             begin
 639               if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
 640             end
 641             else
 642             begin
 643               result := px.mObj;
 644               exit;
 645             end;
 646           end;
 647         end;
 648         curci := cc.next;
 649       end;
 650     end;
 651   end;
 652 end;
 653
 654
 655 // ////////////////////////////////////////////////////////////////////////// //
 656 // no callback: return `true` on the nearest hit
 657 function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 658 var
 659   ex, ey: Integer;
 660 begin
 661   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
 662 end;
 663
 664
 665 // no callback: return `true` on the nearest hit
 666 function TBodyGridBase.traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 667 var
 668   i: Integer;
 669   dx, dy: Integer;
 670   xerr: Integer = 0;
 671   yerr: Integer = 0;
 672   d: Integer;
 673   incx, incy: Integer;
 674   x, y: Integer;
 675   maxx, maxy: Integer;
 676   tsize: Integer; // tile size
 677   gw, gh: Integer;
 678   lastGA: Integer = -1;
 679   ga: Integer = -1; // last used grid address
 680   ccidx: Integer = -1;
 681   curci: Integer = -1;
 682   cc: PGridCell = nil;
 683   hasUntried: Boolean;
 684   f: Integer;
 685   px: PBodyProxyRec;
 686   lq: LongWord;
 687   prevX, prevY: Integer;
 688   minx, miny: Integer;
 689   ptag: Integer;
 690   lastDistSq, distSq: Integer;
 691   wasHit: Boolean = false;
 692   lastObj: ITP;
 693   lastWasInGrid: Boolean = false;
 694 begin
 695   result := Default(ITP);
 696   lastObj := Default(ITP);
 697   tagmask := tagmask and TagFullMask;
 698   if (tagmask = 0) then begin ex := x0; ey := y0; exit; end;
 699
 700   // make coords (0,0)-based
 701   minx := mMinX;
 702   miny := mMinY;
 703   //Dec(x0, minx);
 704   //Dec(y0, miny);
 705   //Dec(x1, minx);
 706   //Dec(y1, miny);
 707
 708   dx := x1-x0;
 709   dy := y1-y0;
 710
 711   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
 712   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
 713
 714   dx := abs(dx);
 715   dy := abs(dy);
 716
 717   if (dx > dy) then d := dx else d := dy;
 718
 719   // `x` and `y` will be in grid coords
 720   x := x0-minx;
 721   y := y0-miny;
 722
 723   // increase query counter
 724   Inc(mLastQuery);
 725   if (mLastQuery = 0) then
 726   begin
 727     // just in case of overflow
 728     mLastQuery := 1;
 729     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
 730   end;
 731   lq := mLastQuery;
 732
 733   tsize := mTileSize;
 734   gw := mWidth;
 735   gh := mHeight;
 736   maxx := gw*tsize-1;
 737   maxy := gh*tsize-1;
 738   lastDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1;
 739   lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
 740
 741   for i := 1 to d do
 742   begin
 743     // prevs are always in map coords
 744     prevX := x+minx;
 745     prevY := y+miny;
 746     // do one step
 747     xerr += dx; if (xerr >= d) then begin xerr -= d; x += incx; end;
 748     yerr += dy; if (yerr >= d) then begin yerr -= d; y += incy; end;
 749
 750     // check for new tile
 751     if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
 752     begin
 753       ga := (y div tsize)*gw+(x div tsize);
 754       if (lastGA <> ga) then
 755       begin
 756         // new cell
 757         lastWasInGrid := true; // do it here, yeah
 758         lastGA := ga;
 759         // had something in the cell we're leaving?
 760         if (ccidx <> -1) then
 761         begin
 762           // yes, signal cell completion
 763           if assigned(cb) then
 764           begin
 765             if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
 766           end
 767           else if wasHit then
 768           begin
 769             result := lastObj;
 770             exit;
 771           end;
 772         end;
 773         // have something in this cell?
 774         ccidx := mGrid[lastGA];
 775       end;
 776     end
 777     else
 778     begin
 779       // out of grid, had something in the cell we're last processed?
 780       if (ccidx <> -1) then
 781       begin
 782         // yes, signal cell completion
 783         ccidx := -1;
 784         if assigned(cb) then
 785         begin
 786           if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
 787         end
 788         else if wasHit then
 789         begin
 790           result := lastObj;
 791           exit;
 792         end;
 793       end;
 794       if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
 795       //lastWasInGrid := false;
 796     end;
 797
 798     // has something to process in the current cell?
 799     if (ccidx <> -1) then
 800     begin
 801       // process cell
 802       curci := ccidx;
 803       hasUntried := false; // this will be set to `true` if we have some panels we still want to process at the next step
 804       // convert coords to map
 805       Inc(x, minx);
 806       Inc(y, miny);
 807       while (curci <> -1) do
 808       begin
 809         cc := @mCells[curci];
 810         for f := 0 to High(TGridCell.bodies) do
 811         begin
 812           if (cc.bodies[f] = -1) then break;
 813           px := @mProxies[cc.bodies[f]];
 814           ptag := px.mTag;
 815           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
 816           begin
 817             // can we process this wall?
 818             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
 819             begin
 820               px.mQueryMark := lq; // mark as processed
 821               if assigned(cb) then
 822               begin
 823                 if cb(px.mObj, ptag, x, y, prevX, prevY) then
 824                 begin
 825                   result := lastObj;
 826                   ex := prevX;
 827                   ey := prevY;
 828                   exit;
 829                 end;
 830               end
 831               else
 832               begin
 833                 // remember this hitpoint if it is nearer than an old one
 834                 distSq := (prevX-x0)*(prevX-x0)+(prevY-y0)*(prevY-y0);
 835                 if (distSq < lastDistSq) then
 836                 begin
 837                   wasHit := true;
 838                   lastDistSq := distSq;
 839                   ex := prevX;
 840                   ey := prevY;
 841                   lastObj := px.mObj;
 842                 end;
 843               end;
 844             end
 845             else
 846             begin
 847               // this is possibly interesting wall, set "has more to check" flag
 848               hasUntried := true;
 849             end;
 850           end;
 851         end;
 852         // next cell
 853         curci := cc.next;
 854       end;
 855       // still has something interesting in this cell?
 856       if not hasUntried then
 857       begin
 858         // nope, don't process this cell anymore; signal cell completion
 859         ccidx := -1;
 860         if assigned(cb) then
 861         begin
 862           if cb(nil, 0, x, y, prevX, prevY) then begin result := lastObj; exit; end;
 863         end
 864         else if wasHit then
 865         begin
 866           result := lastObj;
 867           exit;
 868         end;
 869       end;
 870       // convert coords to grid
 871       Dec(x, minx);
 872       Dec(y, miny);
 873     end;
 874   end;
 875 end;
 876
 877
 878 end.