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