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 `true` on the first hit
 143     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): 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 `true` on the nearest hit
 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): 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   tagmask := tagmask and TagFullMask;
1071   if (tagmask = 0) then exit;
1072
1073   {$IF DEFINED(D2F_DEBUG_XXQ)}
1074   if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1075   {$ENDIF}
1076
1077   // make coords (0,0)-based
1078   Dec(x, mMinX);
1079   Dec(y, mMinY);
1080   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1081
1082   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1083
1084   {$IF DEFINED(D2F_DEBUG_XXQ)}
1085   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);
1086   {$ENDIF}
1087
1088   // restore coords
1089   Inc(x, mMinX);
1090   Inc(y, mMinY);
1091
1092   // increase query counter
1093   Inc(mLastQuery);
1094   if (mLastQuery = 0) then
1095   begin
1096     // just in case of overflow
1097     mLastQuery := 1;
1098     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1099   end;
1100   lq := mLastQuery;
1101
1102   {$IF DEFINED(D2F_DEBUG_XXQ)}
1103   if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1104   {$ENDIF}
1105
1106   while (curci <> -1) do
1107   begin
1108     {$IF DEFINED(D2F_DEBUG_XXQ)}
1109     if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1110     {$ENDIF}
1111     cc := @mCells[curci];
1112     for f := 0 to GridCellBucketSize-1 do
1113     begin
1114       if (cc.bodies[f] = -1) then break;
1115       px := @mProxies[cc.bodies[f]];
1116       {$IF DEFINED(D2F_DEBUG_XXQ)}
1117       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);
1118       {$ENDIF}
1119       // shit. has to do it this way, so i can change tag in callback
1120       if (px.mQueryMark <> lq) then
1121       begin
1122         px.mQueryMark := lq;
1123         ptag := px.mTag;
1124         if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1125            (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1126         begin
1127           if assigned(cb) then
1128           begin
1129             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1130           end
1131           else
1132           begin
1133             result := px.mObj;
1134             exit;
1135           end;
1136         end;
1137       end;
1138     end;
1139     curci := cc.next;
1140   end;
1141 end;
1142
1143
1144 // ////////////////////////////////////////////////////////////////////////// //
1145 // no callback: return `true` on the first hit
1146 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1147 const
1148   tsize = mTileSize;
1149 var
1150   idx: Integer;
1151   gx, gy: Integer;
1152   curci: Integer;
1153   f: Integer;
1154   cc: PGridCell = nil;
1155   px: PBodyProxyRec;
1156   lq: LongWord;
1157   gw: Integer;
1158   x0, y0: Integer;
1159   ptag: Integer;
1160 begin
1161   result := Default(ITP);
1162   if (w < 1) or (h < 1) then exit;
1163   tagmask := tagmask and TagFullMask;
1164   if (tagmask = 0) then exit;
1165
1166   x0 := x;
1167   y0 := y;
1168
1169   // fix coords
1170   Dec(x, mMinX);
1171   Dec(y, mMinY);
1172
1173   gw := mWidth;
1174   //tsize := mTileSize;
1175
1176   if (x+w <= 0) or (y+h <= 0) then exit;
1177   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1178
1179   // increase query counter
1180   Inc(mLastQuery);
1181   if (mLastQuery = 0) then
1182   begin
1183     // just in case of overflow
1184     mLastQuery := 1;
1185     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1186   end;
1187   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1188   lq := mLastQuery;
1189
1190   // go on
1191   for gy := y div tsize to (y+h-1) div tsize do
1192   begin
1193     if (gy < 0) then continue;
1194     if (gy >= mHeight) then break;
1195     for gx := x div tsize to (x+w-1) div tsize do
1196     begin
1197       if (gx < 0) then continue;
1198       if (gx >= gw) then break;
1199       // process cells
1200       curci := mGrid[gy*gw+gx];
1201       while (curci <> -1) do
1202       begin
1203         cc := @mCells[curci];
1204         for f := 0 to GridCellBucketSize-1 do
1205         begin
1206           if (cc.bodies[f] = -1) then break;
1207           px := @mProxies[cc.bodies[f]];
1208           // shit. has to do it this way, so i can change tag in callback
1209           if (px.mQueryMark = lq) then continue;
1210           px.mQueryMark := lq;
1211           ptag := px.mTag;
1212           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1213           if ((ptag and tagmask) = 0) then continue;
1214           if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1215           if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1216           if assigned(cb) then
1217           begin
1218             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1219           end
1220           else
1221           begin
1222             result := px.mObj;
1223             exit;
1224           end;
1225         end;
1226         curci := cc.next;
1227       end;
1228     end;
1229   end;
1230 end;
1231
1232
1233 // ////////////////////////////////////////////////////////////////////////// //
1234 // no callback: return `true` on the nearest hit
1235 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1236 var
1237   ex, ey: Integer;
1238 begin
1239   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1240 end;
1241
1242
1243 // no callback: return `true` on the nearest hit
1244 // you are not supposed to understand this
1245 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1246 const
1247   tsize = mTileSize;
1248 var
1249   wx0, wy0, wx1, wy1: Integer; // window coordinates
1250   stx, sty: Integer; // "steps" for x and y axes
1251   dsx, dsy: Integer; // "lengthes" for x and y axes
1252   dx2, dy2: Integer; // "double lengthes" for x and y axes
1253   xd, yd: Integer; // current coord
1254   e: Integer; // "error" (as in bresenham algo)
1255   rem: Integer;
1256   term: Integer;
1257   xptr, yptr: PInteger;
1258   xfixed: Boolean;
1259   temp: Integer;
1260   prevx, prevy: Integer;
1261   lastDistSq: Integer;
1262   ccidx, curci: Integer;
1263   hasUntried: Boolean;
1264   lastGA: Integer = -1;
1265   ga, x, y: Integer;
1266   lastObj: ITP;
1267   wasHit: Boolean = false;
1268   gw, gh, minx, miny, maxx, maxy: Integer;
1269   cc: PGridCell;
1270   px: PBodyProxyRec;
1271   lq: LongWord;
1272   f, ptag, distSq: Integer;
1273   x0, y0, x1, y1: Integer;
1274 begin
1275   result := Default(ITP);
1276   lastObj := Default(ITP);
1277   tagmask := tagmask and TagFullMask;
1278   ex := ax1; // why not?
1279   ey := ay1; // why not?
1280   if (tagmask = 0) then exit;
1281
1282   if (ax0 = ax1) and (ay0 = ay1) then exit; // as the first point is ignored, just get outta here
1283
1284   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1285
1286   gw := mWidth;
1287   gh := mHeight;
1288   minx := mMinX;
1289   miny := mMinY;
1290   maxx := gw*tsize-1;
1291   maxy := gh*tsize-1;
1292
1293   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1294   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);
1295   {$ENDIF}
1296
1297   x0 := ax0;
1298   y0 := ay0;
1299   x1 := ax1;
1300   y1 := ay1;
1301
1302   // offset query coords to (0,0)-based
1303   Dec(x0, minx);
1304   Dec(y0, miny);
1305   Dec(x1, minx);
1306   Dec(y1, miny);
1307
1308   // clip rectange
1309   wx0 := 0;
1310   wy0 := 0;
1311   wx1 := maxx;
1312   wy1 := maxy;
1313
1314   // horizontal setup
1315   if (x0 < x1) then
1316   begin
1317     // from left to right
1318     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1319     stx := 1; // going right
1320   end
1321   else
1322   begin
1323     // from right to left
1324     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1325     stx := -1; // going left
1326     x0 := -x0;
1327     x1 := -x1;
1328     wx0 := -wx0;
1329     wx1 := -wx1;
1330     swapInt(wx0, wx1);
1331   end;
1332
1333   // vertical setup
1334   if (y0 < y1) then
1335   begin
1336     // from top to bottom
1337     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1338     sty := 1; // going down
1339   end
1340   else
1341   begin
1342     // from bottom to top
1343     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1344     sty := -1; // going up
1345     y0 := -y0;
1346     y1 := -y1;
1347     wy0 := -wy0;
1348     wy1 := -wy1;
1349     swapInt(wy0, wy1);
1350   end;
1351
1352   dsx := x1-x0;
1353   dsy := y1-y0;
1354
1355   if (dsx < dsy) then
1356   begin
1357     xptr := @yd;
1358     yptr := @xd;
1359     swapInt(x0, y0);
1360     swapInt(x1, y1);
1361     swapInt(dsx, dsy);
1362     swapInt(wx0, wy0);
1363     swapInt(wx1, wy1);
1364     swapInt(stx, sty);
1365   end
1366   else
1367   begin
1368     xptr := @xd;
1369     yptr := @yd;
1370   end;
1371
1372   dx2 := 2*dsx;
1373   dy2 := 2*dsy;
1374   xd := x0;
1375   yd := y0;
1376   e := 2*dsy-dsx;
1377   term := x1;
1378
1379   xfixed := false;
1380   if (y0 < wy0) then
1381   begin
1382     // clip at top
1383     temp := dx2*(wy0-y0)-dsx;
1384     xd += temp div dy2;
1385     rem := temp mod dy2;
1386     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1387     if (xd+1 >= wx0) then
1388     begin
1389       yd := wy0;
1390       e -= rem+dsx;
1391       if (rem > 0) then begin Inc(xd); e += dy2; end;
1392       xfixed := true;
1393     end;
1394   end;
1395
1396   if (not xfixed) and (x0 < wx0) then
1397   begin
1398     // clip at left
1399     temp := dy2*(wx0-x0);
1400     yd += temp div dx2;
1401     rem := temp mod dx2;
1402     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1403     xd := wx0;
1404     e += rem;
1405     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1406   end;
1407
1408   if (y1 > wy1) then
1409   begin
1410     // clip at bottom
1411     temp := dx2*(wy1-y0)+dsx;
1412     term := x0+temp div dy2;
1413     rem := temp mod dy2;
1414     if (rem = 0) then Dec(term);
1415   end;
1416
1417   if (term > wx1) then term := wx1; // clip at right
1418
1419   Inc(term); // draw last point
1420   //if (term = xd) then exit; // this is the only point, get out of here
1421
1422   if (sty = -1) then yd := -yd;
1423   if (stx = -1) then begin xd := -xd; term := -term; end;
1424   dx2 -= dy2;
1425
1426   // first move, to skip starting point
1427   // DON'T DO THIS! loop will take care of that
1428   if (xd = term) then exit;
1429   prevx := xptr^+minx;
1430   prevy := yptr^+miny;
1431   (*
1432   // move coords
1433   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1434   xd += stx;
1435   // done?
1436   if (xd = term) then exit;
1437   *)
1438
1439   {$IF DEFINED(D2F_DEBUG)}
1440   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1441   {$ENDIF}
1442   // DON'T DO THIS! loop will take care of that
1443   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1444   //ccidx := mGrid[lastGA];
1445
1446   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1447   //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1448   {$ENDIF}
1449
1450   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1451   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1452   {$ENDIF}
1453
1454   //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1455
1456   // increase query counter
1457   Inc(mLastQuery);
1458   if (mLastQuery = 0) then
1459   begin
1460     // just in case of overflow
1461     mLastQuery := 1;
1462     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1463   end;
1464   lq := mLastQuery;
1465
1466   ccidx := -1;
1467   // draw it; can omit checks
1468   while (xd <> term) do
1469   begin
1470     // check cell(s)
1471     {$IF DEFINED(D2F_DEBUG)}
1472     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1473     {$ENDIF}
1474     // new tile?
1475     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1476     if (ga <> lastGA) then
1477     begin
1478       // yes
1479       {$IF DEFINED(D2F_DEBUG)}
1480       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1481       {$ENDIF}
1482       if (ccidx <> -1) then
1483       begin
1484         // signal cell completion
1485         if assigned(cb) then
1486         begin
1487           if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; exit; end;
1488         end
1489         else if wasHit then
1490         begin
1491           result := lastObj;
1492           exit;
1493         end;
1494       end;
1495       lastGA := ga;
1496       ccidx := mGrid[lastGA];
1497     end;
1498     // has something to process in this tile?
1499     if (ccidx <> -1) then
1500     begin
1501       // process cell
1502       curci := ccidx;
1503       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1504       // convert coords to map (to avoid ajdusting coords inside the loop)
1505       x := xptr^+minx;
1506       y := yptr^+miny;
1507       // process cell list
1508       while (curci <> -1) do
1509       begin
1510         cc := @mCells[curci];
1511         for f := 0 to GridCellBucketSize-1 do
1512         begin
1513           if (cc.bodies[f] = -1) then break;
1514           px := @mProxies[cc.bodies[f]];
1515           ptag := px.mTag;
1516           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1517           begin
1518             // can we process this proxy?
1519             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1520             begin
1521               px.mQueryMark := lq; // mark as processed
1522               if assigned(cb) then
1523               begin
1524                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1525                 begin
1526                   result := lastObj;
1527                   ex := prevx;
1528                   ey := prevy;
1529                   exit;
1530                 end;
1531                 (*
1532                   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1533                   distSq := distanceSq(ax0, ay0, prevx, prevy);
1534                   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);
1535                   if (distSq < lastDistSq) then
1536                   begin
1537                     wasHit := true;
1538                     lastDistSq := distSq;
1539                     ex := prevx;
1540                     ey := prevy;
1541                     lastObj := px.mObj;
1542                   end;
1543                   {$ENDIF}
1544                 *)
1545               end
1546               else
1547               begin
1548                 // remember this hitpoint if it is nearer than an old one
1549                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1550                 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1551                 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);
1552                 {$ENDIF}
1553                 if (distSq < lastDistSq) then
1554                 begin
1555                   wasHit := true;
1556                   lastDistSq := distSq;
1557                   ex := prevx;
1558                   ey := prevy;
1559                   lastObj := px.mObj;
1560                 end;
1561               end;
1562             end
1563             else
1564             begin
1565               // this is possibly interesting proxy, set "has more to check" flag
1566               hasUntried := true;
1567             end;
1568           end;
1569         end;
1570         // next cell
1571         curci := cc.next;
1572       end;
1573       // still has something interesting in this cell?
1574       if not hasUntried then
1575       begin
1576         // nope, don't process this cell anymore; signal cell completion
1577         ccidx := -1;
1578         if assigned(cb) then
1579         begin
1580           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
1581         end
1582         else if wasHit then
1583         begin
1584           result := lastObj;
1585           exit;
1586         end;
1587       end;
1588     end;
1589     //putPixel(xptr^, yptr^);
1590     // move coords
1591     prevx := xptr^+minx;
1592     prevy := yptr^+miny;
1593     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1594     xd += stx;
1595   end;
1596 end;
1597
1598
1599 // ////////////////////////////////////////////////////////////////////////// //
1600 //FIXME! optimize this with real tile walking
1601 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1602 const
1603   tsize = mTileSize;
1604 var
1605   i: Integer;
1606   dx, dy, d: Integer;
1607   xerr, yerr: Integer;
1608   incx, incy: Integer;
1609   stepx, stepy: Integer;
1610   x, y: Integer;
1611   maxx, maxy: Integer;
1612   gw, gh: Integer;
1613   ccidx: Integer;
1614   curci: Integer;
1615   cc: PGridCell;
1616   px: PBodyProxyRec;
1617   lq: LongWord;
1618   minx, miny: Integer;
1619   ptag: Integer;
1620   lastWasInGrid: Boolean;
1621   tbcross: Boolean;
1622   f: Integer;
1623   //tedist: Integer;
1624 begin
1625   log := false;
1626   result := Default(ITP);
1627   tagmask := tagmask and TagFullMask;
1628   if (tagmask = 0) or not assigned(cb) then exit;
1629
1630   minx := mMinX;
1631   miny := mMinY;
1632
1633   dx := x1-x0;
1634   dy := y1-y0;
1635
1636   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1637   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1638
1639   if (incx = 0) and (incy = 0) then exit; // just incase
1640
1641   dx := abs(dx);
1642   dy := abs(dy);
1643
1644   if (dx > dy) then d := dx else d := dy;
1645
1646   // `x` and `y` will be in grid coords
1647   x := x0-minx;
1648   y := y0-miny;
1649
1650   // increase query counter
1651   Inc(mLastQuery);
1652   if (mLastQuery = 0) then
1653   begin
1654     // just in case of overflow
1655     mLastQuery := 1;
1656     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1657   end;
1658   lq := mLastQuery;
1659
1660   // cache various things
1661   //tsize := mTileSize;
1662   gw := mWidth;
1663   gh := mHeight;
1664   maxx := gw*tsize-1;
1665   maxy := gh*tsize-1;
1666
1667   // setup distance and flags
1668   lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1669
1670   // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1671   if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1672
1673   // it is slightly faster this way
1674   xerr := -d;
1675   yerr := -d;
1676
1677   if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1678
1679   // now trace
1680   i := 0;
1681   while (i < d) do
1682   begin
1683     Inc(i);
1684     // do one step
1685     xerr += dx;
1686     yerr += dy;
1687     // invariant: one of those always changed
1688     {$IF DEFINED(D2F_DEBUG)}
1689     if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1690     {$ENDIF}
1691     if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1692     if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1693     // invariant: we always doing a step
1694     {$IF DEFINED(D2F_DEBUG)}
1695     if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1696     {$ENDIF}
1697     begin
1698       // check for crossing tile/grid boundary
1699       if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1700       begin
1701         // we're still in grid
1702         lastWasInGrid := true;
1703         // check for tile edge crossing
1704              if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1705         else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1706         else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1707         else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1708         else tbcross := false;
1709         // crossed tile edge?
1710         if tbcross then
1711         begin
1712           // setup new cell index
1713           ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1714           if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1715         end
1716         else
1717         if (ccidx = -1) then
1718         begin
1719           // we have nothing interesting here anymore, jump directly to tile edge
1720           (*
1721           if (incx = 0) then
1722           begin
1723             // vertical line
1724             if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1725             if (tedist > 1) then
1726             begin
1727               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);
1728               y += incy*tedist;
1729               Inc(i, tedist);
1730               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);
1731             end;
1732           end
1733           else if (incy = 0) then
1734           begin
1735             // horizontal line
1736             if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1737             if (tedist > 1) then
1738             begin
1739               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);
1740               x += incx*tedist;
1741               Inc(i, tedist);
1742               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);
1743             end;
1744           end;
1745           *)
1746           (*
1747            else if (
1748           // get minimal distance to tile edges
1749           if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1750           {$IF DEFINED(D2F_DEBUG)}
1751           if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1752           {$ENDIF}
1753           if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1754           {$IF DEFINED(D2F_DEBUG)}
1755           if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1756           {$ENDIF}
1757           if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1758           // do jump
1759           if (tedist > 1) then
1760           begin
1761             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);
1762             xerr += dx*tedist;
1763             yerr += dy*tedist;
1764             if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1765             if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1766             Inc(i, tedist);
1767             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);
1768           end;
1769           *)
1770         end;
1771       end
1772       else
1773       begin
1774         // out of grid
1775         if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1776       end;
1777     end;
1778
1779     // has something to process in the current cell?
1780     if (ccidx <> -1) then
1781     begin
1782       // process cell
1783       curci := ccidx;
1784       // convert coords to map (to avoid ajdusting coords inside the loop)
1785       //Inc(x, minx);
1786       //Inc(y, miny);
1787       // process cell list
1788       while (curci <> -1) do
1789       begin
1790         cc := @mCells[curci];
1791         for f := 0 to GridCellBucketSize-1 do
1792         begin
1793           if (cc.bodies[f] = -1) then break;
1794           px := @mProxies[cc.bodies[f]];
1795           ptag := px.mTag;
1796           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1797           begin
1798             px.mQueryMark := lq; // mark as processed
1799             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1800           end;
1801         end;
1802         // next cell
1803         curci := cc.next;
1804       end;
1805       ccidx := -1; // don't process this anymore
1806       // convert coords to grid
1807       //Dec(x, minx);
1808       //Dec(y, miny);
1809     end;
1810   end;
1811 end;
1812
1813
1814 end.