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 {$IF DEFINED(D2F_DEBUG)}
  19   {.$DEFINE D2F_DEBUG_RAYTRACE}
  20   {.$DEFINE D2F_DEBUG_XXQ}
  21   {.$DEFINE D2F_DEBUG_MOVER}
  22 {$ENDIF}
  23 unit g_grid;
  24
  25 interface
  26
  27
  28 type
  29   TBodyProxyId = Integer;
  30
  31   generic TBodyGridBase<ITP> = class(TObject)
  32   public
  33     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  34     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
  35     type TGridAlongQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  36
  37     type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
  38
  39     const TagDisabled = $40000000;
  40     const TagFullMask = $3fffffff;
  41
  42   private
  43     const
  44       GridDefaultTileSize = 32; // must be power of two!
  45       GridCellBucketSize = 8; // WARNING! can't be less than 2!
  46
  47   private
  48     type
  49       PBodyProxyRec = ^TBodyProxyRec;
  50       TBodyProxyRec = record
  51       private
  52         mX, mY, mWidth, mHeight: Integer; // aabb
  53         mQueryMark: LongWord; // was this object visited at this query?
  54         mObj: ITP;
  55         mTag: Integer; // `TagDisabled` set: disabled ;-)
  56         nextLink: TBodyProxyId; // next free or nothing
  57
  58       private
  59         procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
  60       end;
  61
  62       PGridCell = ^TGridCell;
  63       TGridCell = record
  64         bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  65         next: Integer; // in this cell; index in mCells
  66       end;
  67
  68       TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
  69
  70   private
  71     //mTileSize: Integer;
  72     const mTileSize = GridDefaultTileSize;
  73
  74   public
  75     const tileSize = mTileSize;
  76
  77   private
  78     mMinX, mMinY: Integer; // so grids can start at any origin
  79     mWidth, mHeight: Integer; // in tiles
  80     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  81     mCells: array of TGridCell; // cell pool
  82     mFreeCell: Integer; // first free cell index or -1
  83     mLastQuery: LongWord;
  84     mUsedCells: Integer;
  85     mProxies: array of TBodyProxyRec;
  86     mProxyFree: TBodyProxyId; // free
  87     mProxyCount: Integer; // currently used
  88     mProxyMaxCount: Integer;
  89
  90   public
  91     dbgShowTraceLog: Boolean;
  92     {$IF DEFINED(D2F_DEBUG)}
  93     dbgRayTraceTileHitCB: TCellQueryCB;
  94     {$ENDIF}
  95
  96   private
  97     function allocCell (): Integer;
  98     procedure freeCell (idx: Integer); // `next` is simply overwritten
  99
 100     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 101     procedure freeProxy (body: TBodyProxyId);
 102
 103     procedure insertInternal (body: TBodyProxyId);
 104     procedure removeInternal (body: TBodyProxyId);
 105
 106     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 107
 108     function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 109     function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 110
 111     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 112     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 113
 114     function getGridWidthPx (): Integer; inline;
 115     function getGridHeightPx (): Integer; inline;
 116
 117   public
 118     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 119     destructor Destroy (); override;
 120
 121     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 122     procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
 123
 124     procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
 125     procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
 126     procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
 127
 128     function insideGrid (x, y: Integer): Boolean; inline;
 129
 130     // `false` if `body` is surely invalid
 131     function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 132     function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 133     function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 134
 135     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 136     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 137     // no callback: return `true` on the first hit
 138     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 139
 140     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 141     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 142     // no callback: return object on the first hit or nil
 143     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
 144
 145     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 146     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 147     // cb with `(nil)` will be called before processing new tile
 148     // no callback: return object of the nearest hit or nil
 149     //WARNING: don't change tags in callbacks here!
 150     function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
 151     function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 152
 153     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 154     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 155     // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
 156     //WARNING: don't change tags in callbacks here!
 157     function forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
 158
 159     // debug
 160     procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 161     function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 162     procedure dumpStats ();
 163
 164     //WARNING! no sanity checks!
 165     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 166
 167     property gridX0: Integer read mMinX;
 168     property gridY0: Integer read mMinY;
 169     property gridWidth: Integer read getGridWidthPx; // in pixels
 170     property gridHeight: Integer read getGridHeightPx; // in pixels
 171   end;
 172
 173
 174 // you are not supposed to understand this
 175 // returns `true` if there is an intersection, and enter coords
 176 // enter coords will be equal to (x0, y0) if starting point is inside the box
 177 // if result is `false`, `inx` and `iny` are undefined
 178 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 179
 180 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
 181
 182 procedure swapInt (var a: Integer; var b: Integer); inline;
 183 function minInt (a, b: Integer): Integer; inline;
 184 function maxInt (a, b: Integer): Integer; inline;
 185
 186
 187 implementation
 188
 189 uses
 190   SysUtils, e_log;
 191
 192
 193 // ////////////////////////////////////////////////////////////////////////// //
 194 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
 195 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
 196 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
 197
 198 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
 199
 200
 201 // ////////////////////////////////////////////////////////////////////////// //
 202 // you are not supposed to understand this
 203 // returns `true` if there is an intersection, and enter coords
 204 // enter coords will be equal to (x0, y0) if starting point is inside the box
 205 // if result is `false`, `inx` and `iny` are undefined
 206 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 207 var
 208   wx0, wy0, wx1, wy1: Integer; // window coordinates
 209   stx, sty: Integer; // "steps" for x and y axes
 210   dsx, dsy: Integer; // "lengthes" for x and y axes
 211   dx2, dy2: Integer; // "double lengthes" for x and y axes
 212   xd, yd: Integer; // current coord
 213   e: Integer; // "error" (as in bresenham algo)
 214   rem: Integer;
 215   //!term: Integer;
 216   d0, d1: PInteger;
 217   xfixed: Boolean;
 218   temp: Integer;
 219 begin
 220   result := false;
 221   // why not
 222   inx := x0;
 223   iny := y0;
 224   if (bw < 1) or (bh < 1) then exit; // impossible box
 225
 226   if (x0 = x1) and (y0 = y1) then
 227   begin
 228     // check this point
 229     result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
 230     exit;
 231   end;
 232
 233   // check if staring point is inside the box
 234   if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
 235
 236   // clip rectange
 237   wx0 := bx;
 238   wy0 := by;
 239   wx1 := bx+bw-1;
 240   wy1 := by+bh-1;
 241
 242   // horizontal setup
 243   if (x0 < x1) then
 244   begin
 245     // from left to right
 246     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
 247     stx := 1; // going right
 248   end
 249   else
 250   begin
 251     // from right to left
 252     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
 253     stx := -1; // going left
 254     x0 := -x0;
 255     x1 := -x1;
 256     wx0 := -wx0;
 257     wx1 := -wx1;
 258     swapInt(wx0, wx1);
 259   end;
 260
 261   // vertical setup
 262   if (y0 < y1) then
 263   begin
 264     // from top to bottom
 265     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
 266     sty := 1; // going down
 267   end
 268   else
 269   begin
 270     // from bottom to top
 271     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
 272     sty := -1; // going up
 273     y0 := -y0;
 274     y1 := -y1;
 275     wy0 := -wy0;
 276     wy1 := -wy1;
 277     swapInt(wy0, wy1);
 278   end;
 279
 280   dsx := x1-x0;
 281   dsy := y1-y0;
 282
 283   if (dsx < dsy) then
 284   begin
 285     d0 := @yd;
 286     d1 := @xd;
 287     swapInt(x0, y0);
 288     swapInt(x1, y1);
 289     swapInt(dsx, dsy);
 290     swapInt(wx0, wy0);
 291     swapInt(wx1, wy1);
 292     swapInt(stx, sty);
 293   end
 294   else
 295   begin
 296     d0 := @xd;
 297     d1 := @yd;
 298   end;
 299
 300   dx2 := 2*dsx;
 301   dy2 := 2*dsy;
 302   xd := x0;
 303   yd := y0;
 304   e := 2*dsy-dsx;
 305   //!term := x1;
 306
 307   xfixed := false;
 308   if (y0 < wy0) then
 309   begin
 310     // clip at top
 311     temp := dx2*(wy0-y0)-dsx;
 312     xd += temp div dy2;
 313     rem := temp mod dy2;
 314     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
 315     if (xd+1 >= wx0) then
 316     begin
 317       yd := wy0;
 318       e -= rem+dsx;
 319       if (rem > 0) then begin Inc(xd); e += dy2; end;
 320       xfixed := true;
 321     end;
 322   end;
 323
 324   if (not xfixed) and (x0 < wx0) then
 325   begin
 326     // clip at left
 327     temp := dy2*(wx0-x0);
 328     yd += temp div dx2;
 329     rem := temp mod dx2;
 330     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
 331     xd := wx0;
 332     e += rem;
 333     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
 334   end;
 335
 336   (*
 337   if (y1 > wy1) then
 338   begin
 339     // clip at bottom
 340     temp := dx2*(wy1-y0)+dsx;
 341     term := x0+temp div dy2;
 342     rem := temp mod dy2;
 343     if (rem = 0) then Dec(term);
 344   end;
 345
 346   if (term > wx1) then term := wx1; // clip at right
 347
 348   Inc(term); // draw last point
 349   //if (term = xd) then exit; // this is the only point, get out of here
 350   *)
 351
 352   if (sty = -1) then yd := -yd;
 353   if (stx = -1) then begin xd := -xd; {!term := -term;} end;
 354   //!dx2 -= dy2;
 355
 356   inx := d0^;
 357   iny := d1^;
 358   result := true;
 359 end;
 360
 361
 362 // ////////////////////////////////////////////////////////////////////////// //
 363 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 364 begin
 365   mX := aX;
 366   mY := aY;
 367   mWidth := aWidth;
 368   mHeight := aHeight;
 369   mQueryMark := 0;
 370   mObj := aObj;
 371   mTag := aTag;
 372   nextLink := -1;
 373 end;
 374
 375
 376 // ////////////////////////////////////////////////////////////////////////// //
 377 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 378 var
 379   idx: Integer;
 380 begin
 381   dbgShowTraceLog := false;
 382   {$IF DEFINED(D2F_DEBUG)}
 383   dbgRayTraceTileHitCB := nil;
 384   {$ENDIF}
 385   {
 386   if aTileSize < 1 then aTileSize := 1;
 387   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 388   mTileSize := aTileSize;
 389   }
 390   if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
 391   if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
 392   mMinX := aMinPixX;
 393   mMinY := aMinPixY;
 394   mWidth := (aPixWidth+mTileSize-1) div mTileSize;
 395   mHeight := (aPixHeight+mTileSize-1) div mTileSize;
 396   SetLength(mGrid, mWidth*mHeight);
 397   SetLength(mCells, mWidth*mHeight);
 398   SetLength(mProxies, 8192);
 399   mFreeCell := 0;
 400   // init free list
 401   for idx := 0 to High(mCells) do
 402   begin
 403     mCells[idx].bodies[0] := -1;
 404     mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
 405     mCells[idx].next := idx+1;
 406   end;
 407   mCells[High(mCells)].next := -1; // last cell
 408   // init grid
 409   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 410   // init proxies
 411   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 412   mProxies[High(mProxies)].nextLink := -1;
 413   mLastQuery := 0;
 414   mUsedCells := 0;
 415   mProxyFree := 0;
 416   mProxyCount := 0;
 417   mProxyMaxCount := 0;
 418   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 419 end;
 420
 421
 422 destructor TBodyGridBase.Destroy ();
 423 begin
 424   mCells := nil;
 425   mGrid := nil;
 426   mProxies := nil;
 427   inherited;
 428 end;
 429
 430
 431 // ////////////////////////////////////////////////////////////////////////// //
 432 procedure TBodyGridBase.dumpStats ();
 433 var
 434   idx, mcb, cidx, cnt: Integer;
 435 begin
 436   mcb := 0;
 437   for idx := 0 to High(mGrid) do
 438   begin
 439     cidx := mGrid[idx];
 440     cnt := 0;
 441     while cidx >= 0 do
 442     begin
 443       Inc(cnt);
 444       cidx := mCells[cidx].next;
 445     end;
 446     if (mcb < cnt) then mcb := cnt;
 447   end;
 448   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);
 449 end;
 450
 451
 452 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 453 var
 454   g, f, cidx: Integer;
 455   cc: PGridCell;
 456 begin
 457   if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
 458   for g := 0 to High(mGrid) do
 459   begin
 460     cidx := mGrid[g];
 461     while (cidx <> -1) do
 462     begin
 463       cc := @mCells[cidx];
 464       for f := 0 to GridCellBucketSize-1 do
 465       begin
 466         if (cc.bodies[f] = -1) then break;
 467         if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
 468       end;
 469       // next cell
 470       cidx := cc.next;
 471     end;
 472   end;
 473 end;
 474
 475
 476 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 477 var
 478   f, cidx: Integer;
 479   cc: PGridCell;
 480 begin
 481   result := Default(ITP);
 482   if not assigned(cb) then exit;
 483   Dec(x, mMinX);
 484   Dec(y, mMinY);
 485   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
 486   cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 487   while (cidx <> -1) do
 488   begin
 489     cc := @mCells[cidx];
 490     for f := 0 to GridCellBucketSize-1 do
 491     begin
 492       if (cc.bodies[f] = -1) then break;
 493       if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
 494     end;
 495     // next cell
 496     cidx := cc.next;
 497   end;
 498 end;
 499
 500
 501 // ////////////////////////////////////////////////////////////////////////// //
 502 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
 503 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
 504
 505
 506 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 507 begin
 508   // fix coords
 509   Dec(x, mMinX);
 510   Dec(y, mMinY);
 511   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 512 end;
 513
 514
 515 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 516 begin
 517   if (body >= 0) and (body < Length(mProxies)) then
 518   begin
 519     with mProxies[body] do begin rx := mX; ry := mY; end;
 520     result := true;
 521   end
 522   else
 523   begin
 524     rx := 0;
 525     ry := 0;
 526     result := false;
 527   end;
 528 end;
 529
 530
 531 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 532 begin
 533   if (body >= 0) and (body < Length(mProxies)) then
 534   begin
 535     with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
 536     result := true;
 537   end
 538   else
 539   begin
 540     rw := 0;
 541     rh := 0;
 542     result := false;
 543   end;
 544 end;
 545
 546
 547 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 548 begin
 549   if (body >= 0) and (body < Length(mProxies)) then
 550   begin
 551     with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
 552     result := true;
 553   end
 554   else
 555   begin
 556     rx := 0;
 557     ry := 0;
 558     rw := 0;
 559     rh := 0;
 560     result := false;
 561   end;
 562 end;
 563
 564
 565
 566 // ////////////////////////////////////////////////////////////////////////// //
 567 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 568 begin
 569   if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 570 end;
 571
 572
 573 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 574 begin
 575   if (pid >= 0) then
 576   begin
 577     if val then
 578     begin
 579       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 580     end
 581     else
 582     begin
 583       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
 584     end;
 585   end;
 586 end;
 587
 588
 589 // ////////////////////////////////////////////////////////////////////////// //
 590 function TBodyGridBase.allocCell (): Integer;
 591 var
 592   idx: Integer;
 593   pc: PGridCell;
 594 begin
 595   if (mFreeCell < 0) then
 596   begin
 597     // no free cells, want more
 598     mFreeCell := Length(mCells);
 599     SetLength(mCells, mFreeCell+32768); // arbitrary number
 600     for idx := mFreeCell to High(mCells) do
 601     begin
 602       mCells[idx].bodies[0] := -1;
 603       mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 604       mCells[idx].next := idx+1;
 605     end;
 606     mCells[High(mCells)].next := -1; // last cell
 607   end;
 608   result := mFreeCell;
 609   pc := @mCells[result];
 610   mFreeCell := pc.next;
 611   pc.next := -1;
 612   Inc(mUsedCells);
 613   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 614 end;
 615
 616
 617 procedure TBodyGridBase.freeCell (idx: Integer);
 618 begin
 619   if (idx >= 0) and (idx < Length(mCells)) then
 620   begin
 621     with mCells[idx] do
 622     begin
 623       bodies[0] := -1;
 624       bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 625       next := mFreeCell;
 626     end;
 627     mFreeCell := idx;
 628     Dec(mUsedCells);
 629   end;
 630 end;
 631
 632
 633 // ////////////////////////////////////////////////////////////////////////// //
 634 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 635 var
 636   olen, idx: Integer;
 637   px: PBodyProxyRec;
 638 begin
 639   if (mProxyFree = -1) then
 640   begin
 641     // no free proxies, resize list
 642     olen := Length(mProxies);
 643     SetLength(mProxies, olen+8192); // arbitrary number
 644     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 645     mProxies[High(mProxies)].nextLink := -1;
 646     mProxyFree := olen;
 647   end;
 648   // get one from list
 649   result := mProxyFree;
 650   px := @mProxies[result];
 651   mProxyFree := px.nextLink;
 652   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 653   // add to used list
 654   px.nextLink := -1;
 655   // statistics
 656   Inc(mProxyCount);
 657   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 658 end;
 659
 660 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 661 begin
 662   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 663   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 664   // add to free list
 665   mProxies[body].mObj := nil;
 666   mProxies[body].nextLink := mProxyFree;
 667   mProxyFree := body;
 668   Dec(mProxyCount);
 669 end;
 670
 671
 672 // ////////////////////////////////////////////////////////////////////////// //
 673 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 674 const
 675   tsize = mTileSize;
 676 var
 677   gx, gy: Integer;
 678   gw, gh: Integer;
 679 begin
 680   result := false;
 681   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 682   // fix coords
 683   Dec(x, mMinX);
 684   Dec(y, mMinY);
 685   // go on
 686   if (x+w <= 0) or (y+h <= 0) then exit;
 687   gw := mWidth;
 688   gh := mHeight;
 689   //tsize := mTileSize;
 690   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 691   for gy := y div tsize to (y+h-1) div tsize do
 692   begin
 693     if (gy < 0) then continue;
 694     if (gy >= gh) then break;
 695     for gx := x div tsize to (x+w-1) div tsize do
 696     begin
 697       if (gx < 0) then continue;
 698       if (gx >= gw) then break;
 699       result := cb(gy*gw+gx, bodyId);
 700       if result then exit;
 701     end;
 702   end;
 703 end;
 704
 705
 706 // ////////////////////////////////////////////////////////////////////////// //
 707 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 708 var
 709   cidx: Integer;
 710   pc: Integer;
 711   pi: PGridCell;
 712   f: Integer;
 713 begin
 714   result := false; // never stop
 715   // add body to the given grid cell
 716   pc := mGrid[grida];
 717   if (pc <> -1) then
 718   begin
 719     {$IF DEFINED(D2F_DEBUG)}
 720     cidx := pc;
 721     while (cidx <> -1) do
 722     begin
 723       pi := @mCells[cidx];
 724       for f := 0 to GridCellBucketSize-1 do
 725       begin
 726         if (pi.bodies[f] = -1) then break;
 727         if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
 728       end;
 729       cidx := pi.next;
 730     end;
 731     {$ENDIF}
 732     cidx := pc;
 733     while (cidx <> -1) do
 734     begin
 735       pi := @mCells[cidx];
 736       // check "has room" flag
 737       if (pi.bodies[GridCellBucketSize-1] = -1) then
 738       begin
 739         // can add here
 740         for f := 0 to GridCellBucketSize-1 do
 741         begin
 742           if (pi.bodies[f] = -1) then
 743           begin
 744             pi.bodies[f] := bodyId;
 745             if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
 746             exit;
 747           end;
 748         end;
 749         raise Exception.Create('internal error in grid inserter');
 750       end;
 751       // no room, go to next cell in list (if there is any)
 752       cidx := pi.next;
 753     end;
 754     // no room in cells, add new cell to list
 755   end;
 756   // either no room, or no cell at all
 757   cidx := allocCell();
 758   pi := @mCells[cidx];
 759   pi.bodies[0] := bodyId;
 760   pi.bodies[1] := -1;
 761   pi.next := pc;
 762   mGrid[grida] := cidx;
 763 end;
 764
 765 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
 766 var
 767   px: PBodyProxyRec;
 768 begin
 769   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 770   px := @mProxies[body];
 771   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
 772 end;
 773
 774
 775 // assume that we cannot have one object added to bucket twice
 776 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 777 var
 778   f, c: Integer;
 779   pidx, cidx: Integer;
 780   pc: PGridCell;
 781 begin
 782   result := false; // never stop
 783   // find and remove cell
 784   pidx := -1; // previous cell index
 785   cidx := mGrid[grida]; // current cell index
 786   while (cidx <> -1) do
 787   begin
 788     pc := @mCells[cidx];
 789     for f := 0 to GridCellBucketSize-1 do
 790     begin
 791       if (pc.bodies[f] = bodyId) then
 792       begin
 793         // i found her!
 794         if (f = 0) and (pc.bodies[1] = -1) then
 795         begin
 796           // this cell contains no elements, remove it
 797           if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
 798           freeCell(cidx);
 799           exit;
 800         end;
 801         // remove element from bucket
 802         for c := f to GridCellBucketSize-2 do
 803         begin
 804           pc.bodies[c] := pc.bodies[c+1];
 805           if (pc.bodies[c] = -1) then break;
 806         end;
 807         pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
 808         exit;
 809       end;
 810     end;
 811     pidx := cidx;
 812     cidx := pc.next;
 813   end;
 814 end;
 815
 816 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
 817 var
 818   px: PBodyProxyRec;
 819 begin
 820   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 821   px := @mProxies[body];
 822   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
 823 end;
 824
 825
 826 // ////////////////////////////////////////////////////////////////////////// //
 827 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 828 begin
 829   aTag := aTag and TagFullMask;
 830   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 831   insertInternal(result);
 832 end;
 833
 834
 835 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
 836 begin
 837   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 838   removeInternal(body);
 839   freeProxy(body);
 840 end;
 841
 842
 843 // ////////////////////////////////////////////////////////////////////////// //
 844 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
 845 var
 846   px: PBodyProxyRec;
 847   x0, y0, w, h: Integer;
 848 begin
 849   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 850   px := @mProxies[body];
 851   x0 := px.mX;
 852   y0 := px.mY;
 853   w := px.mWidth;
 854   h := px.mHeight;
 855   {$IF DEFINED(D2F_DEBUG_MOVER)}
 856   e_WriteLog(Format('proxy #%d: MOVERESIZE: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d;nw=%d;nh=%d', [body, x0-mMinX, y0-mMinY, w, h, nx-mMinX, ny-mMinY, nw, nh]), MSG_NOTIFY);
 857   {$ENDIF}
 858   if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
 859   // map -> grid
 860   Dec(x0, mMinX);
 861   Dec(y0, mMinY);
 862   Dec(nx, mMinX);
 863   Dec(ny, mMinY);
 864   // did any corner crossed tile boundary?
 865   if (x0 div mTileSize <> nx div mTileSize) or
 866      (y0 div mTileSize <> ny div mTileSize) or
 867      ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
 868      ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
 869   begin
 870     removeInternal(body);
 871     px.mX := nx+mMinX;
 872     px.mY := ny+mMinY;
 873     px.mWidth := nw;
 874     px.mHeight := nh;
 875     insertInternal(body);
 876   end
 877   else
 878   begin
 879     px.mX := nx+mMinX;
 880     px.mY := ny+mMinY;
 881     px.mWidth := nw;
 882     px.mHeight := nh;
 883   end;
 884 end;
 885
 886 //TODO: optimize for horizontal/vertical moves
 887 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
 888 var
 889   px: PBodyProxyRec;
 890   x0, y0: Integer;
 891   ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
 892   ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
 893   gx, gy: Integer;
 894   gw, gh: Integer;
 895   pw, ph: Integer;
 896 begin
 897   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 898   // check if tile coords was changed
 899   px := @mProxies[body];
 900   x0 := px.mX;
 901   y0 := px.mY;
 902   if (nx = x0) and (ny = y0) then exit;
 903   // map -> grid
 904   Dec(x0, mMinX);
 905   Dec(y0, mMinY);
 906   Dec(nx, mMinX);
 907   Dec(ny, mMinY);
 908   // check for heavy work
 909   pw := px.mWidth;
 910   ph := px.mHeight;
 911   ogx0 := x0 div mTileSize;
 912   ogy0 := y0 div mTileSize;
 913   ngx0 := nx div mTileSize;
 914   ngy0 := ny div mTileSize;
 915   ogx1 := (x0+pw-1) div mTileSize;
 916   ogy1 := (y0+ph-1) div mTileSize;
 917   ngx1 := (nx+pw-1) div mTileSize;
 918   ngy1 := (ny+ph-1) div mTileSize;
 919   {$IF DEFINED(D2F_DEBUG_MOVER)}
 920   e_WriteLog(Format('proxy #%d: checkmove: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
 921   {$ENDIF}
 922   if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
 923   begin
 924     // crossed tile boundary, do heavy work
 925     gw := mWidth;
 926     gh := mHeight;
 927     // cycle with old rect, remove body where it is necessary
 928     // optimized for horizontal moves
 929     {$IF DEFINED(D2F_DEBUG_MOVER)}
 930     e_WriteLog(Format('proxy #%d: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
 931     {$ENDIF}
 932     // remove stale marks
 933     if not ((ogy0 >= gh) or (ogy1 < 0)) and
 934        not ((ogx0 >= gw) or (ogx1 < 0)) then
 935     begin
 936       if (ogx0 < 0) then ogx0 := 0;
 937       if (ogy0 < 0) then ogy0 := 0;
 938       if (ogx1 > gw-1) then ogx1 := gw-1;
 939       if (ogy1 > gh-1) then ogy1 := gh-1;
 940       {$IF DEFINED(D2F_DEBUG_MOVER)}
 941       e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
 942       {$ENDIF}
 943       for gx := ogx0 to ogx1 do
 944       begin
 945         if (gx < ngx0) or (gx > ngx1) then
 946         begin
 947           // this column is completely outside of new rect
 948           for gy := ogy0 to ogy1 do
 949           begin
 950             {$IF DEFINED(D2F_DEBUG_MOVER)}
 951             e_WriteLog(Format('  remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
 952             {$ENDIF}
 953             remover(gy*gw+gx, body);
 954           end;
 955         end
 956         else
 957         begin
 958           // heavy checks
 959           for gy := ogy0 to ogy1 do
 960           begin
 961             if (gy < ngy0) or (gy > ngy1) then
 962             begin
 963               {$IF DEFINED(D2F_DEBUG_MOVER)}
 964               e_WriteLog(Format('  remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
 965               {$ENDIF}
 966               remover(gy*gw+gx, body);
 967             end;
 968           end;
 969         end;
 970       end;
 971     end;
 972     // cycle with new rect, add body where it is necessary
 973     if not ((ngy0 >= gh) or (ngy1 < 0)) and
 974        not ((ngx0 >= gw) or (ngx1 < 0)) then
 975     begin
 976       if (ngx0 < 0) then ngx0 := 0;
 977       if (ngy0 < 0) then ngy0 := 0;
 978       if (ngx1 > gw-1) then ngx1 := gw-1;
 979       if (ngy1 > gh-1) then ngy1 := gh-1;
 980       {$IF DEFINED(D2F_DEBUG_MOVER)}
 981       e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
 982       {$ENDIF}
 983       for gx := ngx0 to ngx1 do
 984       begin
 985         if (gx < ogx0) or (gx > ogx1) then
 986         begin
 987           // this column is completely outside of old rect
 988           for gy := ngy0 to ngy1 do
 989           begin
 990             {$IF DEFINED(D2F_DEBUG_MOVER)}
 991             e_WriteLog(Format('  insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
 992             {$ENDIF}
 993             inserter(gy*gw+gx, body);
 994           end;
 995         end
 996         else
 997         begin
 998           // heavy checks
 999           for gy := ngy0 to ngy1 do
1000           begin
1001             if (gy < ogy0) or (gy > ogy1) then
1002             begin
1003               {$IF DEFINED(D2F_DEBUG_MOVER)}
1004               e_WriteLog(Format('  insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1005               {$ENDIF}
1006               inserter(gy*gw+gx, body);
1007             end;
1008           end;
1009         end;
1010       end;
1011     end;
1012     // done
1013   end
1014   else
1015   begin
1016     {$IF DEFINED(D2F_DEBUG_MOVER)}
1017     e_WriteLog(Format('proxy #%d: GRID OK: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1018     {$ENDIF}
1019   end;
1020   // update coordinates
1021   px.mX := nx+mMinX;
1022   px.mY := ny+mMinY;
1023 end;
1024
1025 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1026 var
1027   px: PBodyProxyRec;
1028   x0, y0, w, h: Integer;
1029 begin
1030   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1031   // check if tile coords was changed
1032   px := @mProxies[body];
1033   x0 := px.mX-mMinX;
1034   y0 := px.mY-mMinY;
1035   w := px.mWidth;
1036   h := px.mHeight;
1037   {$IF DEFINED(D2F_DEBUG_MOVER)}
1038   e_WriteLog(Format('proxy #%d: RESIZE: xg=%d;yg=%d;w=%d;h=%d;nw=%d;nh=%d', [body, x0, y0, w, h, nw, nh]), MSG_NOTIFY);
1039   {$ENDIF}
1040   if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1041      ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1042   begin
1043     // crossed tile boundary, do heavy work
1044     removeInternal(body);
1045     px.mWidth := nw;
1046     px.mHeight := nh;
1047     insertInternal(body);
1048   end
1049   else
1050   begin
1051     // nothing to do with the grid, just fix size
1052     px.mWidth := nw;
1053     px.mHeight := nh;
1054   end;
1055 end;
1056
1057
1058 // ////////////////////////////////////////////////////////////////////////// //
1059 // no callback: return `true` on the first hit
1060 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1061 var
1062   f: Integer;
1063   idx, curci: Integer;
1064   cc: PGridCell = nil;
1065   px: PBodyProxyRec;
1066   lq: LongWord;
1067   ptag: Integer;
1068 begin
1069   result := Default(ITP);
1070   if (exittag <> nil) then exittag^ := 0;
1071   tagmask := tagmask and TagFullMask;
1072   if (tagmask = 0) then exit;
1073
1074   {$IF DEFINED(D2F_DEBUG_XXQ)}
1075   if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1076   {$ENDIF}
1077
1078   // make coords (0,0)-based
1079   Dec(x, mMinX);
1080   Dec(y, mMinY);
1081   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1082
1083   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1084
1085   {$IF DEFINED(D2F_DEBUG_XXQ)}
1086   if (assigned(cb)) then e_WriteLog(Format('1: grid pointquery: (%d,%d) (%d,%d) %d', [x, y, (x div mTileSize), (y div mTileSize), curci]), MSG_NOTIFY);
1087   {$ENDIF}
1088
1089   // restore coords
1090   Inc(x, mMinX);
1091   Inc(y, mMinY);
1092
1093   // increase query counter
1094   Inc(mLastQuery);
1095   if (mLastQuery = 0) then
1096   begin
1097     // just in case of overflow
1098     mLastQuery := 1;
1099     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1100   end;
1101   lq := mLastQuery;
1102
1103   {$IF DEFINED(D2F_DEBUG_XXQ)}
1104   if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1105   {$ENDIF}
1106
1107   while (curci <> -1) do
1108   begin
1109     {$IF DEFINED(D2F_DEBUG_XXQ)}
1110     if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1111     {$ENDIF}
1112     cc := @mCells[curci];
1113     for f := 0 to GridCellBucketSize-1 do
1114     begin
1115       if (cc.bodies[f] = -1) then break;
1116       px := @mProxies[cc.bodies[f]];
1117       {$IF DEFINED(D2F_DEBUG_XXQ)}
1118       if (assigned(cb)) then e_WriteLog(Format('  proxy #%d; qm:%u; tag:%08x; tagflag:%d  %u', [cc.bodies[f], px.mQueryMark, px.mTag, (px.mTag and tagmask), LongWord(px.mObj)]), MSG_NOTIFY);
1119       {$ENDIF}
1120       // shit. has to do it this way, so i can change tag in callback
1121       if (px.mQueryMark <> lq) then
1122       begin
1123         px.mQueryMark := lq;
1124         ptag := px.mTag;
1125         if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1126            (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1127         begin
1128           if assigned(cb) then
1129           begin
1130             if cb(px.mObj, ptag) then
1131             begin
1132               result := px.mObj;
1133               if (exittag <> nil) then exittag^ := ptag;
1134               exit;
1135             end;
1136           end
1137           else
1138           begin
1139             result := px.mObj;
1140             if (exittag <> nil) then exittag^ := ptag;
1141             exit;
1142           end;
1143         end;
1144       end;
1145     end;
1146     curci := cc.next;
1147   end;
1148 end;
1149
1150
1151 // ////////////////////////////////////////////////////////////////////////// //
1152 // no callback: return `true` on the first hit
1153 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1154 const
1155   tsize = mTileSize;
1156 var
1157   idx: Integer;
1158   gx, gy: Integer;
1159   curci: Integer;
1160   f: Integer;
1161   cc: PGridCell = nil;
1162   px: PBodyProxyRec;
1163   lq: LongWord;
1164   gw: Integer;
1165   x0, y0: Integer;
1166   ptag: Integer;
1167 begin
1168   result := Default(ITP);
1169   if (w < 1) or (h < 1) then exit;
1170   tagmask := tagmask and TagFullMask;
1171   if (tagmask = 0) then exit;
1172
1173   x0 := x;
1174   y0 := y;
1175
1176   // fix coords
1177   Dec(x, mMinX);
1178   Dec(y, mMinY);
1179
1180   gw := mWidth;
1181   //tsize := mTileSize;
1182
1183   if (x+w <= 0) or (y+h <= 0) then exit;
1184   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1185
1186   // increase query counter
1187   Inc(mLastQuery);
1188   if (mLastQuery = 0) then
1189   begin
1190     // just in case of overflow
1191     mLastQuery := 1;
1192     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1193   end;
1194   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1195   lq := mLastQuery;
1196
1197   // go on
1198   for gy := y div tsize to (y+h-1) div tsize do
1199   begin
1200     if (gy < 0) then continue;
1201     if (gy >= mHeight) then break;
1202     for gx := x div tsize to (x+w-1) div tsize do
1203     begin
1204       if (gx < 0) then continue;
1205       if (gx >= gw) then break;
1206       // process cells
1207       curci := mGrid[gy*gw+gx];
1208       while (curci <> -1) do
1209       begin
1210         cc := @mCells[curci];
1211         for f := 0 to GridCellBucketSize-1 do
1212         begin
1213           if (cc.bodies[f] = -1) then break;
1214           px := @mProxies[cc.bodies[f]];
1215           // shit. has to do it this way, so i can change tag in callback
1216           if (px.mQueryMark = lq) then continue;
1217           px.mQueryMark := lq;
1218           ptag := px.mTag;
1219           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1220           if ((ptag and tagmask) = 0) then continue;
1221           if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1222           if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1223           if assigned(cb) then
1224           begin
1225             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1226           end
1227           else
1228           begin
1229             result := px.mObj;
1230             exit;
1231           end;
1232         end;
1233         curci := cc.next;
1234       end;
1235     end;
1236   end;
1237 end;
1238
1239
1240 // ////////////////////////////////////////////////////////////////////////// //
1241 // no callback: return `true` on the nearest hit
1242 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1243 var
1244   ex, ey: Integer;
1245 begin
1246   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1247 end;
1248
1249
1250 // no callback: return `true` on the nearest hit
1251 // you are not supposed to understand this
1252 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1253 const
1254   tsize = mTileSize;
1255 var
1256   wx0, wy0, wx1, wy1: Integer; // window coordinates
1257   stx, sty: Integer; // "steps" for x and y axes
1258   dsx, dsy: Integer; // "lengthes" for x and y axes
1259   dx2, dy2: Integer; // "double lengthes" for x and y axes
1260   xd, yd: Integer; // current coord
1261   e: Integer; // "error" (as in bresenham algo)
1262   rem: Integer;
1263   term: Integer;
1264   xptr, yptr: PInteger;
1265   xfixed: Boolean;
1266   temp: Integer;
1267   prevx, prevy: Integer;
1268   lastDistSq: Integer;
1269   ccidx, curci: Integer;
1270   hasUntried: Boolean;
1271   lastGA: Integer = -1;
1272   ga, x, y: Integer;
1273   lastObj: ITP;
1274   wasHit: Boolean = false;
1275   gw, gh, minx, miny, maxx, maxy: Integer;
1276   cc: PGridCell;
1277   px: PBodyProxyRec;
1278   lq: LongWord;
1279   f, ptag, distSq: Integer;
1280   x0, y0, x1, y1: Integer;
1281 begin
1282   result := Default(ITP);
1283   lastObj := Default(ITP);
1284   tagmask := tagmask and TagFullMask;
1285   ex := ax1; // why not?
1286   ey := ay1; // why not?
1287   if (tagmask = 0) then exit;
1288
1289   if (ax0 = ax1) and (ay0 = ay1) then
1290   begin
1291     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1292     if (result <> nil) then
1293     begin
1294       if assigned(cb) then
1295       begin
1296         if cb(result, ptag, ax0, ay0, ax0, ay0) then
1297         begin
1298           ex := ax0;
1299           ey := ay0;
1300         end
1301         else
1302         begin
1303           result := nil;
1304         end;
1305       end
1306       else
1307       begin
1308         ex := ax0;
1309         ey := ay0;
1310       end;
1311     end;
1312     exit;
1313   end;
1314
1315   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1316
1317   gw := mWidth;
1318   gh := mHeight;
1319   minx := mMinX;
1320   miny := mMinY;
1321   maxx := gw*tsize-1;
1322   maxy := gh*tsize-1;
1323
1324   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1325   if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format('TRACING: (%d,%d)-(%d,%d) [(%d,%d)-(%d,%d)]; maxdistsq=%d', [ax0, ay0, ax1, ay1, minx, miny, maxx, maxy, lastDistSq]), MSG_NOTIFY);
1326   {$ENDIF}
1327
1328   x0 := ax0;
1329   y0 := ay0;
1330   x1 := ax1;
1331   y1 := ay1;
1332
1333   // offset query coords to (0,0)-based
1334   Dec(x0, minx);
1335   Dec(y0, miny);
1336   Dec(x1, minx);
1337   Dec(y1, miny);
1338
1339   // clip rectange
1340   wx0 := 0;
1341   wy0 := 0;
1342   wx1 := maxx;
1343   wy1 := maxy;
1344
1345   // horizontal setup
1346   if (x0 < x1) then
1347   begin
1348     // from left to right
1349     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1350     stx := 1; // going right
1351   end
1352   else
1353   begin
1354     // from right to left
1355     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1356     stx := -1; // going left
1357     x0 := -x0;
1358     x1 := -x1;
1359     wx0 := -wx0;
1360     wx1 := -wx1;
1361     swapInt(wx0, wx1);
1362   end;
1363
1364   // vertical setup
1365   if (y0 < y1) then
1366   begin
1367     // from top to bottom
1368     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1369     sty := 1; // going down
1370   end
1371   else
1372   begin
1373     // from bottom to top
1374     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1375     sty := -1; // going up
1376     y0 := -y0;
1377     y1 := -y1;
1378     wy0 := -wy0;
1379     wy1 := -wy1;
1380     swapInt(wy0, wy1);
1381   end;
1382
1383   dsx := x1-x0;
1384   dsy := y1-y0;
1385
1386   if (dsx < dsy) then
1387   begin
1388     xptr := @yd;
1389     yptr := @xd;
1390     swapInt(x0, y0);
1391     swapInt(x1, y1);
1392     swapInt(dsx, dsy);
1393     swapInt(wx0, wy0);
1394     swapInt(wx1, wy1);
1395     swapInt(stx, sty);
1396   end
1397   else
1398   begin
1399     xptr := @xd;
1400     yptr := @yd;
1401   end;
1402
1403   dx2 := 2*dsx;
1404   dy2 := 2*dsy;
1405   xd := x0;
1406   yd := y0;
1407   e := 2*dsy-dsx;
1408   term := x1;
1409
1410   xfixed := false;
1411   if (y0 < wy0) then
1412   begin
1413     // clip at top
1414     temp := dx2*(wy0-y0)-dsx;
1415     xd += temp div dy2;
1416     rem := temp mod dy2;
1417     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1418     if (xd+1 >= wx0) then
1419     begin
1420       yd := wy0;
1421       e -= rem+dsx;
1422       if (rem > 0) then begin Inc(xd); e += dy2; end;
1423       xfixed := true;
1424     end;
1425   end;
1426
1427   if (not xfixed) and (x0 < wx0) then
1428   begin
1429     // clip at left
1430     temp := dy2*(wx0-x0);
1431     yd += temp div dx2;
1432     rem := temp mod dx2;
1433     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1434     xd := wx0;
1435     e += rem;
1436     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1437   end;
1438
1439   if (y1 > wy1) then
1440   begin
1441     // clip at bottom
1442     temp := dx2*(wy1-y0)+dsx;
1443     term := x0+temp div dy2;
1444     rem := temp mod dy2;
1445     if (rem = 0) then Dec(term);
1446   end;
1447
1448   if (term > wx1) then term := wx1; // clip at right
1449
1450   Inc(term); // draw last point
1451   //if (term = xd) then exit; // this is the only point, get out of here
1452
1453   if (sty = -1) then yd := -yd;
1454   if (stx = -1) then begin xd := -xd; term := -term; end;
1455   dx2 -= dy2;
1456
1457   // first move, to skip starting point
1458   // DON'T DO THIS! loop will take care of that
1459   if (xd = term) then
1460   begin
1461     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1462     if (result <> nil) then
1463     begin
1464       if assigned(cb) then
1465       begin
1466         if cb(result, ptag, ax0, ay0, ax0, ay0) then
1467         begin
1468           ex := ax0;
1469           ey := ay0;
1470         end
1471         else
1472         begin
1473           result := nil;
1474         end;
1475       end
1476       else
1477       begin
1478         ex := ax0;
1479         ey := ay0;
1480       end;
1481     end;
1482     exit;
1483   end;
1484
1485   prevx := xptr^+minx;
1486   prevy := yptr^+miny;
1487   (*
1488   // move coords
1489   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1490   xd += stx;
1491   // done?
1492   if (xd = term) then exit;
1493   *)
1494
1495   {$IF DEFINED(D2F_DEBUG)}
1496   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1497   {$ENDIF}
1498   // DON'T DO THIS! loop will take care of that
1499   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1500   //ccidx := mGrid[lastGA];
1501
1502   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1503   //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1504   {$ENDIF}
1505
1506   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1507   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1508   {$ENDIF}
1509
1510   //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1511
1512   // increase query counter
1513   Inc(mLastQuery);
1514   if (mLastQuery = 0) then
1515   begin
1516     // just in case of overflow
1517     mLastQuery := 1;
1518     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1519   end;
1520   lq := mLastQuery;
1521
1522   ccidx := -1;
1523   // draw it; can omit checks
1524   while (xd <> term) do
1525   begin
1526     // check cell(s)
1527     {$IF DEFINED(D2F_DEBUG)}
1528     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1529     {$ENDIF}
1530     // new tile?
1531     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1532     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1533     if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' xd=%d; term=%d; gx=%d; gy=%d; ga=%d; lastga=%d', [xd, term, xptr^, yptr^, ga, lastGA]), MSG_NOTIFY);
1534     {$ENDIF}
1535     if (ga <> lastGA) then
1536     begin
1537       // yes
1538       {$IF DEFINED(D2F_DEBUG)}
1539       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1540       {$ENDIF}
1541       if (ccidx <> -1) then
1542       begin
1543         // signal cell completion
1544         if assigned(cb) then
1545         begin
1546           if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; exit; end;
1547         end
1548         else if wasHit then
1549         begin
1550           result := lastObj;
1551           exit;
1552         end;
1553       end;
1554       lastGA := ga;
1555       ccidx := mGrid[lastGA];
1556     end;
1557     // has something to process in this tile?
1558     if (ccidx <> -1) then
1559     begin
1560       // process cell
1561       curci := ccidx;
1562       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1563       // convert coords to map (to avoid ajdusting coords inside the loop)
1564       x := xptr^+minx;
1565       y := yptr^+miny;
1566       // process cell list
1567       while (curci <> -1) do
1568       begin
1569         cc := @mCells[curci];
1570         for f := 0 to GridCellBucketSize-1 do
1571         begin
1572           if (cc.bodies[f] = -1) then break;
1573           px := @mProxies[cc.bodies[f]];
1574           ptag := px.mTag;
1575           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1576           begin
1577             // can we process this proxy?
1578             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1579             begin
1580               px.mQueryMark := lq; // mark as processed
1581               if assigned(cb) then
1582               begin
1583                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1584                 begin
1585                   result := lastObj;
1586                   ex := prevx;
1587                   ey := prevy;
1588                   exit;
1589                 end;
1590                 (*
1591                   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1592                   distSq := distanceSq(ax0, ay0, prevx, prevy);
1593                   if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format('  hit(%d): a=(%d,%d), h=(%d,%d), p=(%d,%d); distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, prevx, prevy, distSq, lastDistSq]), MSG_NOTIFY);
1594                   if (distSq < lastDistSq) then
1595                   begin
1596                     wasHit := true;
1597                     lastDistSq := distSq;
1598                     ex := prevx;
1599                     ey := prevy;
1600                     lastObj := px.mObj;
1601                   end;
1602                   {$ENDIF}
1603                 *)
1604               end
1605               else
1606               begin
1607                 // remember this hitpoint if it is nearer than an old one
1608                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1609                 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1610                 if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format('  hit(%d): a=(%d,%d), h=(%d,%d), p=(%d,%d); distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, prevx, prevy, distSq, lastDistSq]), MSG_NOTIFY);
1611                 {$ENDIF}
1612                 if (distSq < lastDistSq) then
1613                 begin
1614                   wasHit := true;
1615                   lastDistSq := distSq;
1616                   ex := prevx;
1617                   ey := prevy;
1618                   lastObj := px.mObj;
1619                 end;
1620               end;
1621             end
1622             else
1623             begin
1624               // this is possibly interesting proxy, set "has more to check" flag
1625               hasUntried := true;
1626             end;
1627           end;
1628         end;
1629         // next cell
1630         curci := cc.next;
1631       end;
1632       // still has something interesting in this cell?
1633       if not hasUntried then
1634       begin
1635         // nope, don't process this cell anymore; signal cell completion
1636         ccidx := -1;
1637         if assigned(cb) then
1638         begin
1639           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
1640         end
1641         else if wasHit then
1642         begin
1643           result := lastObj;
1644           exit;
1645         end;
1646       end;
1647     end;
1648     //putPixel(xptr^, yptr^);
1649     // move coords
1650     prevx := xptr^+minx;
1651     prevy := yptr^+miny;
1652     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1653     xd += stx;
1654   end;
1655   // we can travel less than one cell
1656   if wasHit and not assigned(cb) then
1657   begin
1658     result := lastObj;
1659   end
1660   else
1661   begin
1662     ex := ax1; // why not?
1663     ey := ay1; // why not?
1664   end;
1665 end;
1666
1667
1668 // ////////////////////////////////////////////////////////////////////////// //
1669 //FIXME! optimize this with real tile walking
1670 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1671 const
1672   tsize = mTileSize;
1673 var
1674   i: Integer;
1675   dx, dy, d: Integer;
1676   xerr, yerr: Integer;
1677   incx, incy: Integer;
1678   stepx, stepy: Integer;
1679   x, y: Integer;
1680   maxx, maxy: Integer;
1681   gw, gh: Integer;
1682   ccidx: Integer;
1683   curci: Integer;
1684   cc: PGridCell;
1685   px: PBodyProxyRec;
1686   lq: LongWord;
1687   minx, miny: Integer;
1688   ptag: Integer;
1689   lastWasInGrid: Boolean;
1690   tbcross: Boolean;
1691   f: Integer;
1692   //tedist: Integer;
1693 begin
1694   log := false;
1695   result := Default(ITP);
1696   tagmask := tagmask and TagFullMask;
1697   if (tagmask = 0) or not assigned(cb) then exit;
1698
1699   minx := mMinX;
1700   miny := mMinY;
1701
1702   dx := x1-x0;
1703   dy := y1-y0;
1704
1705   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1706   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1707
1708   if (incx = 0) and (incy = 0) then exit; // just incase
1709
1710   dx := abs(dx);
1711   dy := abs(dy);
1712
1713   if (dx > dy) then d := dx else d := dy;
1714
1715   // `x` and `y` will be in grid coords
1716   x := x0-minx;
1717   y := y0-miny;
1718
1719   // increase query counter
1720   Inc(mLastQuery);
1721   if (mLastQuery = 0) then
1722   begin
1723     // just in case of overflow
1724     mLastQuery := 1;
1725     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1726   end;
1727   lq := mLastQuery;
1728
1729   // cache various things
1730   //tsize := mTileSize;
1731   gw := mWidth;
1732   gh := mHeight;
1733   maxx := gw*tsize-1;
1734   maxy := gh*tsize-1;
1735
1736   // setup distance and flags
1737   lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1738
1739   // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1740   if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1741
1742   // it is slightly faster this way
1743   xerr := -d;
1744   yerr := -d;
1745
1746   if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1747
1748   // now trace
1749   i := 0;
1750   while (i < d) do
1751   begin
1752     Inc(i);
1753     // do one step
1754     xerr += dx;
1755     yerr += dy;
1756     // invariant: one of those always changed
1757     {$IF DEFINED(D2F_DEBUG)}
1758     if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1759     {$ENDIF}
1760     if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1761     if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1762     // invariant: we always doing a step
1763     {$IF DEFINED(D2F_DEBUG)}
1764     if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1765     {$ENDIF}
1766     begin
1767       // check for crossing tile/grid boundary
1768       if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1769       begin
1770         // we're still in grid
1771         lastWasInGrid := true;
1772         // check for tile edge crossing
1773              if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1774         else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1775         else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1776         else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1777         else tbcross := false;
1778         // crossed tile edge?
1779         if tbcross then
1780         begin
1781           // setup new cell index
1782           ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1783           if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1784         end
1785         else
1786         if (ccidx = -1) then
1787         begin
1788           // we have nothing interesting here anymore, jump directly to tile edge
1789           (*
1790           if (incx = 0) then
1791           begin
1792             // vertical line
1793             if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1794             if (tedist > 1) then
1795             begin
1796               if (log) then e_WriteLog(Format('  doing vertical jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1797               y += incy*tedist;
1798               Inc(i, tedist);
1799               if (log) then e_WriteLog(Format('   jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1800             end;
1801           end
1802           else if (incy = 0) then
1803           begin
1804             // horizontal line
1805             if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1806             if (tedist > 1) then
1807             begin
1808               if (log) then e_WriteLog(Format('  doing horizontal jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1809               x += incx*tedist;
1810               Inc(i, tedist);
1811               if (log) then e_WriteLog(Format('   jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1812             end;
1813           end;
1814           *)
1815           (*
1816            else if (
1817           // get minimal distance to tile edges
1818           if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1819           {$IF DEFINED(D2F_DEBUG)}
1820           if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1821           {$ENDIF}
1822           if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1823           {$IF DEFINED(D2F_DEBUG)}
1824           if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1825           {$ENDIF}
1826           if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1827           // do jump
1828           if (tedist > 1) then
1829           begin
1830             if (log) then e_WriteLog(Format('  doing jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1831             xerr += dx*tedist;
1832             yerr += dy*tedist;
1833             if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1834             if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1835             Inc(i, tedist);
1836             if (log) then e_WriteLog(Format('   jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1837           end;
1838           *)
1839         end;
1840       end
1841       else
1842       begin
1843         // out of grid
1844         if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1845       end;
1846     end;
1847
1848     // has something to process in the current cell?
1849     if (ccidx <> -1) then
1850     begin
1851       // process cell
1852       curci := ccidx;
1853       // convert coords to map (to avoid ajdusting coords inside the loop)
1854       //Inc(x, minx);
1855       //Inc(y, miny);
1856       // process cell list
1857       while (curci <> -1) do
1858       begin
1859         cc := @mCells[curci];
1860         for f := 0 to GridCellBucketSize-1 do
1861         begin
1862           if (cc.bodies[f] = -1) then break;
1863           px := @mProxies[cc.bodies[f]];
1864           ptag := px.mTag;
1865           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1866           begin
1867             px.mQueryMark := lq; // mark as processed
1868             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1869           end;
1870         end;
1871         // next cell
1872         curci := cc.next;
1873       end;
1874       ccidx := -1; // don't process this anymore
1875       // convert coords to grid
1876       //Dec(x, minx);
1877       //Dec(y, miny);
1878     end;
1879   end;
1880 end;
1881
1882
1883 end.