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 {.$DEFINE GRID_USE_ORTHO_ACCEL}
  24 unit g_grid;
  25
  26 interface
  27
  28
  29 type
  30   TBodyProxyId = Integer;
  31
  32   generic TBodyGridBase<ITP> = class(TObject)
  33   public
  34     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  35     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: 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   public
  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
  61         function getTag (): Integer; inline;
  62         procedure setTag (v: Integer); inline;
  63
  64         function getEnabled (): Boolean; inline;
  65         procedure setEnabled (v: Boolean); inline;
  66
  67         function getX1 (): Integer; inline;
  68         function getY1 (): Integer; inline;
  69
  70       public
  71         property x: Integer read mX;
  72         property y: Integer read mY;
  73         property width: Integer read mWidth;
  74         property height: Integer read mHeight;
  75         property tag: Integer read getTag write setTag;
  76         property enabled: Boolean read getEnabled write setEnabled;
  77         property obj: ITP read mObj;
  78
  79         property x0: Integer read mX;
  80         property y0: Integer read mY;
  81         property x1: Integer read getX1;
  82         property y1: Integer read getY1;
  83       end;
  84
  85   private
  86     type
  87       PGridCell = ^TGridCell;
  88       TGridCell = record
  89         bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  90         next: Integer; // in this cell; index in mCells
  91       end;
  92
  93       TCellArray = array of TGridCell;
  94
  95       TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
  96
  97   private
  98     //mTileSize: Integer;
  99     const mTileSize = GridDefaultTileSize;
 100     type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
 101
 102   public
 103     const tileSize = mTileSize;
 104
 105     type
 106       TAtPointEnumerator = record
 107       private
 108         mCells: TCellArray;
 109         curidx, curbki: Integer;
 110         getpx: TGetProxyFn;
 111       public
 112         constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
 113         function MoveNext (): Boolean; inline;
 114         function getCurrent (): PBodyProxyRec; inline;
 115         property Current: PBodyProxyRec read getCurrent;
 116       end;
 117
 118   private
 119     mMinX, mMinY: Integer; // so grids can start at any origin
 120     mWidth, mHeight: Integer; // in tiles
 121     mGrid: array of Integer; // mWidth*mHeight, index in mCells
 122     mCells: TCellArray; // cell pool
 123     mFreeCell: Integer; // first free cell index or -1
 124     mLastQuery: LongWord;
 125     mUsedCells: Integer;
 126     mProxies: array of TBodyProxyRec;
 127     mProxyFree: TBodyProxyId; // free
 128     mProxyCount: Integer; // currently used
 129     mProxyMaxCount: Integer;
 130     mInQuery: Boolean;
 131
 132   public
 133     dbgShowTraceLog: Boolean;
 134     {$IF DEFINED(D2F_DEBUG)}
 135     dbgRayTraceTileHitCB: TCellQueryCB;
 136     {$ENDIF}
 137
 138   private
 139     function allocCell (): Integer;
 140     procedure freeCell (idx: Integer); // `next` is simply overwritten
 141
 142     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 143     procedure freeProxy (body: TBodyProxyId);
 144
 145     procedure insertInternal (body: TBodyProxyId);
 146     procedure removeInternal (body: TBodyProxyId);
 147
 148     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 149
 150     function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 151     function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 152
 153     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 154     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 155
 156     function getGridWidthPx (): Integer; inline;
 157     function getGridHeightPx (): Integer; inline;
 158
 159     function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
 160
 161   public
 162     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 163     destructor Destroy (); override;
 164
 165     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 166     procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
 167
 168     procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
 169     procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
 170     procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
 171
 172     function insideGrid (x, y: Integer): Boolean; inline;
 173
 174     // `false` if `body` is surely invalid
 175     function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 176     function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 177     function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 178
 179     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 180     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 181     // no callback: return `true` on the first hit
 182     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 183
 184     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 185     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 186     // no callback: return object on the first hit or nil
 187     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
 188
 189     function atCellInPoint (x, y: Integer): TAtPointEnumerator;
 190
 191     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 192     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 193     // cb with `(nil)` will be called before processing new tile
 194     // no callback: return object of the nearest hit or nil
 195     // if `inverted` is true, trace will register bodies *exluding* tagmask
 196     //WARNING: don't change tags in callbacks here!
 197     function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
 198     function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 199
 200     // return `false` if we're still inside at the end
 201     // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
 202     // `true`: endpoint will point at the last "inside" pixel
 203     // `false`: endpoint will be (ax1, ay1)
 204     function traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
 205
 206     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 207     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 208     // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
 209     //WARNING: don't change tags in callbacks here!
 210     function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
 211
 212     // trace box with the given velocity; return object hit (if any)
 213     // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
 214     function traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
 215
 216     // debug
 217     procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 218     function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 219     procedure dumpStats ();
 220
 221   public
 222     //WARNING! no sanity checks!
 223     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 224
 225     property gridX0: Integer read mMinX;
 226     property gridY0: Integer read mMinY;
 227     property gridWidth: Integer read getGridWidthPx; // in pixels
 228     property gridHeight: Integer read getGridHeightPx; // in pixels
 229
 230     property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
 231   end;
 232
 233
 234 // you are not supposed to understand this
 235 // returns `true` if there is an intersection, and enter coords
 236 // enter coords will be equal to (x0, y0) if starting point is inside the box
 237 // if result is `false`, `inx` and `iny` are undefined
 238 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 239
 240 // sweep two AABB's to see if and when they are overlapping
 241 // returns `true` if collision was detected (but boxes doesn't overlap)
 242 // u1 and u1 has no sense if no collision was detected
 243 // u0 = normalized time of first collision (i.e. collision starts at myMove*u0)
 244 // u1 = normalized time of second collision (i.e. collision stops after myMove*u1)
 245 // hitedge for `it`: 0: top; 1: right; 2: bottom; 3: left
 246 // enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision)
 247 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
 248                     u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean;
 249
 250 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
 251
 252 procedure swapInt (var a: Integer; var b: Integer); inline;
 253 function minInt (a, b: Integer): Integer; inline;
 254 function maxInt (a, b: Integer): Integer; inline;
 255
 256
 257 implementation
 258
 259 uses
 260   SysUtils, e_log, g_console, utils;
 261
 262
 263 // ////////////////////////////////////////////////////////////////////////// //
 264 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
 265 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
 266 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
 267
 268 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
 269
 270
 271 // ////////////////////////////////////////////////////////////////////////// //
 272 // you are not supposed to understand this
 273 // returns `true` if there is an intersection, and enter coords
 274 // enter coords will be equal to (x0, y0) if starting point is inside the box
 275 // if result is `false`, `inx` and `iny` are undefined
 276 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 277 var
 278   wx0, wy0, wx1, wy1: Integer; // window coordinates
 279   stx, sty: Integer; // "steps" for x and y axes
 280   dsx, dsy: Integer; // "lengthes" for x and y axes
 281   dx2, dy2: Integer; // "double lengthes" for x and y axes
 282   xd, yd: Integer; // current coord
 283   e: Integer; // "error" (as in bresenham algo)
 284   rem: Integer;
 285   //!term: Integer;
 286   d0, d1: PInteger;
 287   xfixed: Boolean;
 288   temp: Integer;
 289 begin
 290   result := false;
 291   // why not
 292   inx := x0;
 293   iny := y0;
 294   if (bw < 1) or (bh < 1) then exit; // impossible box
 295
 296   if (x0 = x1) and (y0 = y1) then
 297   begin
 298     // check this point
 299     result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
 300     exit;
 301   end;
 302
 303   // check if staring point is inside the box
 304   if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
 305
 306   // clip rectange
 307   wx0 := bx;
 308   wy0 := by;
 309   wx1 := bx+bw-1;
 310   wy1 := by+bh-1;
 311
 312   // horizontal setup
 313   if (x0 < x1) then
 314   begin
 315     // from left to right
 316     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
 317     stx := 1; // going right
 318   end
 319   else
 320   begin
 321     // from right to left
 322     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
 323     stx := -1; // going left
 324     x0 := -x0;
 325     x1 := -x1;
 326     wx0 := -wx0;
 327     wx1 := -wx1;
 328     swapInt(wx0, wx1);
 329   end;
 330
 331   // vertical setup
 332   if (y0 < y1) then
 333   begin
 334     // from top to bottom
 335     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
 336     sty := 1; // going down
 337   end
 338   else
 339   begin
 340     // from bottom to top
 341     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
 342     sty := -1; // going up
 343     y0 := -y0;
 344     y1 := -y1;
 345     wy0 := -wy0;
 346     wy1 := -wy1;
 347     swapInt(wy0, wy1);
 348   end;
 349
 350   dsx := x1-x0;
 351   dsy := y1-y0;
 352
 353   if (dsx < dsy) then
 354   begin
 355     d0 := @yd;
 356     d1 := @xd;
 357     swapInt(x0, y0);
 358     swapInt(x1, y1);
 359     swapInt(dsx, dsy);
 360     swapInt(wx0, wy0);
 361     swapInt(wx1, wy1);
 362     swapInt(stx, sty);
 363   end
 364   else
 365   begin
 366     d0 := @xd;
 367     d1 := @yd;
 368   end;
 369
 370   dx2 := 2*dsx;
 371   dy2 := 2*dsy;
 372   xd := x0;
 373   yd := y0;
 374   e := 2*dsy-dsx;
 375   //!term := x1;
 376
 377   xfixed := false;
 378   if (y0 < wy0) then
 379   begin
 380     // clip at top
 381     temp := dx2*(wy0-y0)-dsx;
 382     xd += temp div dy2;
 383     rem := temp mod dy2;
 384     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
 385     if (xd+1 >= wx0) then
 386     begin
 387       yd := wy0;
 388       e -= rem+dsx;
 389       if (rem > 0) then begin Inc(xd); e += dy2; end;
 390       xfixed := true;
 391     end;
 392   end;
 393
 394   if (not xfixed) and (x0 < wx0) then
 395   begin
 396     // clip at left
 397     temp := dy2*(wx0-x0);
 398     yd += temp div dx2;
 399     rem := temp mod dx2;
 400     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
 401     xd := wx0;
 402     e += rem;
 403     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
 404   end;
 405
 406   (*
 407   if (y1 > wy1) then
 408   begin
 409     // clip at bottom
 410     temp := dx2*(wy1-y0)+dsx;
 411     term := x0+temp div dy2;
 412     rem := temp mod dy2;
 413     if (rem = 0) then Dec(term);
 414   end;
 415
 416   if (term > wx1) then term := wx1; // clip at right
 417
 418   Inc(term); // draw last point
 419   //if (term = xd) then exit; // this is the only point, get out of here
 420   *)
 421
 422   if (sty = -1) then yd := -yd;
 423   if (stx = -1) then begin xd := -xd; {!term := -term;} end;
 424   //!dx2 -= dy2;
 425
 426   inx := d0^;
 427   iny := d1^;
 428   result := true;
 429 end;
 430
 431
 432 // ////////////////////////////////////////////////////////////////////////// //
 433 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
 434                     u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean;
 435 var
 436   tin, tout: Single;
 437
 438   function axisOverlap (me0, me1, it0, it1, d, he0, he1: Integer): Boolean; inline;
 439   var
 440     t: Single;
 441   begin
 442     result := false;
 443
 444     if (me1 < it0) then
 445     begin
 446       if (d >= 0) then exit; // oops, no hit
 447       t := (me1-it0+1)/d;
 448       if (t > tin) then begin tin := t; hitedge^ := he1; end;
 449     end
 450     else if (it1 < me0) then
 451     begin
 452       if (d <= 0) then exit; // oops, no hit
 453       t := (me0-it1-1)/d;
 454       if (t > tin) then begin tin := t; hitedge^ := he0; end;
 455     end;
 456
 457     if (d < 0) and (it1 > me0) then
 458     begin
 459       t := (me0-it1-1)/d;
 460       if (t < tout) then tout := t;
 461     end
 462     else if (d > 0) and (me1 > it0) then
 463     begin
 464       t := (me1-it0+1)/d;
 465       if (t < tout) then tout := t;
 466     end;
 467
 468     result := true;
 469   end;
 470
 471 var
 472   mex1, mey1, itx1, ity1, vx, vy: Integer;
 473   htt: Integer = -1;
 474 begin
 475   result := false;
 476   if (u0 <> nil) then u0^ := -1.0;
 477   if (u1 <> nil) then u1^ := -1.0;
 478   if (hitedge = nil) then hitedge := @htt else hitedge^ := -1;
 479
 480   if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit;
 481
 482   mex1 := mex0+mew-1;
 483   mey1 := mey0+meh-1;
 484   itx1 := itx0+itw-1;
 485   ity1 := ity0+ith-1;
 486
 487   // check if they are overlapping right now (SAT)
 488   //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end;
 489
 490   if (medx = 0) and (medy = 0) then exit; // both boxes are sationary
 491
 492   // treat b as stationary, so invert v to get relative velocity
 493   vx := -medx;
 494   vy := -medy;
 495
 496   tin := -100000000.0;
 497   tout := 100000000.0;
 498
 499   if not axisOverlap(mex0, mex1, itx0, itx1, vx, 1, 3) then exit;
 500   if not axisOverlap(mey0, mey1, ity0, ity1, vy, 2, 0) then exit;
 501
 502   if (u0 <> nil) then u0^ := tin;
 503   if (u1 <> nil) then u1^ := tout;
 504
 505   if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then
 506   begin
 507     result := true;
 508   end;
 509 end;
 510
 511
 512 // ////////////////////////////////////////////////////////////////////////// //
 513 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 514 begin
 515   mX := aX;
 516   mY := aY;
 517   mWidth := aWidth;
 518   mHeight := aHeight;
 519   mQueryMark := 0;
 520   mObj := aObj;
 521   mTag := aTag;
 522   nextLink := -1;
 523 end;
 524
 525
 526 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
 527 begin
 528   result := mTag and TagFullMask;
 529 end;
 530
 531 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
 532 begin
 533   mTag := (mTag and TagDisabled) or (v and TagFullMask);
 534 end;
 535
 536 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
 537 begin
 538   result := ((mTag and TagDisabled) = 0);
 539 end;
 540
 541 procedure TBodyGridBase.TBodyProxyRec.setEnabled (v: Boolean); inline;
 542 begin
 543   if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled;
 544 end;
 545
 546 function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline;
 547 begin
 548   result := mX+mWidth-1;
 549 end;
 550
 551 function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline;
 552 begin
 553   result := mY+mHeight-1;
 554 end;
 555
 556
 557 // ////////////////////////////////////////////////////////////////////////// //
 558 constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
 559 begin
 560   mCells := acells;
 561   curidx := aidx;
 562   curbki := -1;
 563   getpx := agetpx;
 564 end;
 565
 566
 567 function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline;
 568 begin
 569   while (curidx <> -1) do
 570   begin
 571     while (curbki < GridCellBucketSize) do
 572     begin
 573       Inc(curbki);
 574       if (mCells[curidx].bodies[curbki] = -1) then break;
 575       result := true;
 576       exit;
 577     end;
 578     curidx := mCells[curidx].next;
 579     curbki := -1;
 580   end;
 581   result := false;
 582 end;
 583
 584
 585 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
 586 begin
 587   result := getpx(mCells[curidx].bodies[curbki]);
 588 end;
 589
 590
 591 // ////////////////////////////////////////////////////////////////////////// //
 592 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 593 var
 594   idx: Integer;
 595 begin
 596   dbgShowTraceLog := false;
 597   {$IF DEFINED(D2F_DEBUG)}
 598   dbgRayTraceTileHitCB := nil;
 599   {$ENDIF}
 600   {
 601   if aTileSize < 1 then aTileSize := 1;
 602   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 603   mTileSize := aTileSize;
 604   }
 605   if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
 606   if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
 607   mMinX := aMinPixX;
 608   mMinY := aMinPixY;
 609   mWidth := (aPixWidth+mTileSize-1) div mTileSize;
 610   mHeight := (aPixHeight+mTileSize-1) div mTileSize;
 611   SetLength(mGrid, mWidth*mHeight);
 612   SetLength(mCells, mWidth*mHeight);
 613   SetLength(mProxies, 8192);
 614   mFreeCell := 0;
 615   // init free list
 616   for idx := 0 to High(mCells) do
 617   begin
 618     mCells[idx].bodies[0] := -1;
 619     mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
 620     mCells[idx].next := idx+1;
 621   end;
 622   mCells[High(mCells)].next := -1; // last cell
 623   // init grid
 624   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 625   // init proxies
 626   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 627   mProxies[High(mProxies)].nextLink := -1;
 628   mLastQuery := 0;
 629   mUsedCells := 0;
 630   mProxyFree := 0;
 631   mProxyCount := 0;
 632   mProxyMaxCount := 0;
 633   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 634 end;
 635
 636
 637 destructor TBodyGridBase.Destroy ();
 638 begin
 639   mCells := nil;
 640   mGrid := nil;
 641   mProxies := nil;
 642   inherited;
 643 end;
 644
 645
 646 // ////////////////////////////////////////////////////////////////////////// //
 647 procedure TBodyGridBase.dumpStats ();
 648 var
 649   idx, mcb, cidx, cnt: Integer;
 650 begin
 651   mcb := 0;
 652   for idx := 0 to High(mGrid) do
 653   begin
 654     cidx := mGrid[idx];
 655     cnt := 0;
 656     while cidx >= 0 do
 657     begin
 658       Inc(cnt);
 659       cidx := mCells[cidx].next;
 660     end;
 661     if (mcb < cnt) then mcb := cnt;
 662   end;
 663   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);
 664 end;
 665
 666
 667 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 668 var
 669   g, f, cidx: Integer;
 670   cc: PGridCell;
 671 begin
 672   if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
 673   for g := 0 to High(mGrid) do
 674   begin
 675     cidx := mGrid[g];
 676     while (cidx <> -1) do
 677     begin
 678       cc := @mCells[cidx];
 679       for f := 0 to GridCellBucketSize-1 do
 680       begin
 681         if (cc.bodies[f] = -1) then break;
 682         if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
 683       end;
 684       // next cell
 685       cidx := cc.next;
 686     end;
 687   end;
 688 end;
 689
 690
 691 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 692 var
 693   f, cidx: Integer;
 694   cc: PGridCell;
 695 begin
 696   result := Default(ITP);
 697   if not assigned(cb) then exit;
 698   Dec(x, mMinX);
 699   Dec(y, mMinY);
 700   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
 701   cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 702   while (cidx <> -1) do
 703   begin
 704     cc := @mCells[cidx];
 705     for f := 0 to GridCellBucketSize-1 do
 706     begin
 707       if (cc.bodies[f] = -1) then break;
 708       if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
 709     end;
 710     // next cell
 711     cidx := cc.next;
 712   end;
 713 end;
 714
 715
 716 // ////////////////////////////////////////////////////////////////////////// //
 717 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
 718 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
 719
 720
 721 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 722 begin
 723   // fix coords
 724   Dec(x, mMinX);
 725   Dec(y, mMinY);
 726   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 727 end;
 728
 729
 730 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 731 begin
 732   if (body >= 0) and (body < Length(mProxies)) then
 733   begin
 734     with mProxies[body] do begin rx := mX; ry := mY; end;
 735     result := true;
 736   end
 737   else
 738   begin
 739     rx := 0;
 740     ry := 0;
 741     result := false;
 742   end;
 743 end;
 744
 745
 746 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 747 begin
 748   if (body >= 0) and (body < Length(mProxies)) then
 749   begin
 750     with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
 751     result := true;
 752   end
 753   else
 754   begin
 755     rw := 0;
 756     rh := 0;
 757     result := false;
 758   end;
 759 end;
 760
 761
 762 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 763 begin
 764   if (body >= 0) and (body < Length(mProxies)) then
 765   begin
 766     with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
 767     result := true;
 768   end
 769   else
 770   begin
 771     rx := 0;
 772     ry := 0;
 773     rw := 0;
 774     rh := 0;
 775     result := false;
 776   end;
 777 end;
 778
 779
 780
 781 // ////////////////////////////////////////////////////////////////////////// //
 782 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 783 begin
 784   if (pid >= 0) and (pid < Length(mProxies)) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 785 end;
 786
 787
 788 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 789 begin
 790   if (pid >= 0) and (pid < Length(mProxies)) then
 791   begin
 792     if val then
 793     begin
 794       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 795     end
 796     else
 797     begin
 798       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
 799     end;
 800   end;
 801 end;
 802
 803
 804 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
 805 begin
 806   if (idx >= 0) and (idx < Length(mProxies)) then result := @mProxies[idx] else result := nil;
 807 end;
 808
 809
 810 // ////////////////////////////////////////////////////////////////////////// //
 811 function TBodyGridBase.allocCell (): Integer;
 812 var
 813   idx: Integer;
 814   pc: PGridCell;
 815 begin
 816   if (mFreeCell < 0) then
 817   begin
 818     // no free cells, want more
 819     mFreeCell := Length(mCells);
 820     SetLength(mCells, mFreeCell+32768); // arbitrary number
 821     for idx := mFreeCell to High(mCells) do
 822     begin
 823       mCells[idx].bodies[0] := -1;
 824       mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 825       mCells[idx].next := idx+1;
 826     end;
 827     mCells[High(mCells)].next := -1; // last cell
 828   end;
 829   result := mFreeCell;
 830   pc := @mCells[result];
 831   mFreeCell := pc.next;
 832   pc.next := -1;
 833   Inc(mUsedCells);
 834   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 835 end;
 836
 837
 838 procedure TBodyGridBase.freeCell (idx: Integer);
 839 begin
 840   if (idx >= 0) and (idx < Length(mCells)) then
 841   begin
 842     with mCells[idx] do
 843     begin
 844       bodies[0] := -1;
 845       bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 846       next := mFreeCell;
 847     end;
 848     mFreeCell := idx;
 849     Dec(mUsedCells);
 850   end;
 851 end;
 852
 853
 854 // ////////////////////////////////////////////////////////////////////////// //
 855 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 856 var
 857   olen, idx: Integer;
 858   px: PBodyProxyRec;
 859 begin
 860   if (mProxyFree = -1) then
 861   begin
 862     // no free proxies, resize list
 863     olen := Length(mProxies);
 864     SetLength(mProxies, olen+8192); // arbitrary number
 865     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 866     mProxies[High(mProxies)].nextLink := -1;
 867     mProxyFree := olen;
 868   end;
 869   // get one from list
 870   result := mProxyFree;
 871   px := @mProxies[result];
 872   mProxyFree := px.nextLink;
 873   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 874   // add to used list
 875   px.nextLink := -1;
 876   // statistics
 877   Inc(mProxyCount);
 878   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 879 end;
 880
 881 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 882 begin
 883   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 884   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 885   // add to free list
 886   mProxies[body].mObj := nil;
 887   mProxies[body].nextLink := mProxyFree;
 888   mProxyFree := body;
 889   Dec(mProxyCount);
 890 end;
 891
 892
 893 // ////////////////////////////////////////////////////////////////////////// //
 894 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 895 const
 896   tsize = mTileSize;
 897 var
 898   gx, gy: Integer;
 899   gw, gh: Integer;
 900 begin
 901   result := false;
 902   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 903   // fix coords
 904   Dec(x, mMinX);
 905   Dec(y, mMinY);
 906   // go on
 907   if (x+w <= 0) or (y+h <= 0) then exit;
 908   gw := mWidth;
 909   gh := mHeight;
 910   //tsize := mTileSize;
 911   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 912   for gy := y div tsize to (y+h-1) div tsize do
 913   begin
 914     if (gy < 0) then continue;
 915     if (gy >= gh) then break;
 916     for gx := x div tsize to (x+w-1) div tsize do
 917     begin
 918       if (gx < 0) then continue;
 919       if (gx >= gw) then break;
 920       result := cb(gy*gw+gx, bodyId);
 921       if result then exit;
 922     end;
 923   end;
 924 end;
 925
 926
 927 // ////////////////////////////////////////////////////////////////////////// //
 928 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 929 var
 930   cidx: Integer;
 931   pc: Integer;
 932   pi: PGridCell;
 933   f: Integer;
 934 begin
 935   result := false; // never stop
 936   // add body to the given grid cell
 937   pc := mGrid[grida];
 938   if (pc <> -1) then
 939   begin
 940     {$IF DEFINED(D2F_DEBUG)}
 941     cidx := pc;
 942     while (cidx <> -1) do
 943     begin
 944       pi := @mCells[cidx];
 945       for f := 0 to GridCellBucketSize-1 do
 946       begin
 947         if (pi.bodies[f] = -1) then break;
 948         if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
 949       end;
 950       cidx := pi.next;
 951     end;
 952     {$ENDIF}
 953     cidx := pc;
 954     while (cidx <> -1) do
 955     begin
 956       pi := @mCells[cidx];
 957       // check "has room" flag
 958       if (pi.bodies[GridCellBucketSize-1] = -1) then
 959       begin
 960         // can add here
 961         for f := 0 to GridCellBucketSize-1 do
 962         begin
 963           if (pi.bodies[f] = -1) then
 964           begin
 965             pi.bodies[f] := bodyId;
 966             if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
 967             exit;
 968           end;
 969         end;
 970         raise Exception.Create('internal error in grid inserter');
 971       end;
 972       // no room, go to next cell in list (if there is any)
 973       cidx := pi.next;
 974     end;
 975     // no room in cells, add new cell to list
 976   end;
 977   // either no room, or no cell at all
 978   cidx := allocCell();
 979   pi := @mCells[cidx];
 980   pi.bodies[0] := bodyId;
 981   pi.bodies[1] := -1;
 982   pi.next := pc;
 983   mGrid[grida] := cidx;
 984 end;
 985
 986 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
 987 var
 988   px: PBodyProxyRec;
 989 begin
 990   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 991   px := @mProxies[body];
 992   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
 993 end;
 994
 995
 996 // assume that we cannot have one object added to bucket twice
 997 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 998 var
 999   f, c: Integer;
1000   pidx, cidx: Integer;
1001   pc: PGridCell;
1002 begin
1003   result := false; // never stop
1004   // find and remove cell
1005   pidx := -1; // previous cell index
1006   cidx := mGrid[grida]; // current cell index
1007   while (cidx <> -1) do
1008   begin
1009     pc := @mCells[cidx];
1010     for f := 0 to GridCellBucketSize-1 do
1011     begin
1012       if (pc.bodies[f] = bodyId) then
1013       begin
1014         // i found her!
1015         if (f = 0) and (pc.bodies[1] = -1) then
1016         begin
1017           // this cell contains no elements, remove it
1018           if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
1019           freeCell(cidx);
1020           exit;
1021         end;
1022         // remove element from bucket
1023         for c := f to GridCellBucketSize-2 do
1024         begin
1025           pc.bodies[c] := pc.bodies[c+1];
1026           if (pc.bodies[c] = -1) then break;
1027         end;
1028         pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
1029         exit;
1030       end;
1031     end;
1032     pidx := cidx;
1033     cidx := pc.next;
1034   end;
1035 end;
1036
1037 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
1038 var
1039   px: PBodyProxyRec;
1040 begin
1041   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1042   px := @mProxies[body];
1043   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1044 end;
1045
1046
1047 // ////////////////////////////////////////////////////////////////////////// //
1048 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
1049 begin
1050   aTag := aTag and TagFullMask;
1051   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
1052   insertInternal(result);
1053 end;
1054
1055
1056 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
1057 begin
1058   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1059   removeInternal(body);
1060   freeProxy(body);
1061 end;
1062
1063
1064 // ////////////////////////////////////////////////////////////////////////// //
1065 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
1066 var
1067   px: PBodyProxyRec;
1068   x0, y0, w, h: Integer;
1069 begin
1070   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1071   px := @mProxies[body];
1072   x0 := px.mX;
1073   y0 := px.mY;
1074   w := px.mWidth;
1075   h := px.mHeight;
1076   {$IF DEFINED(D2F_DEBUG_MOVER)}
1077   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);
1078   {$ENDIF}
1079   if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
1080   // map -> grid
1081   Dec(x0, mMinX);
1082   Dec(y0, mMinY);
1083   Dec(nx, mMinX);
1084   Dec(ny, mMinY);
1085   // did any corner crossed tile boundary?
1086   if (x0 div mTileSize <> nx div mTileSize) or
1087      (y0 div mTileSize <> ny div mTileSize) or
1088      ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
1089      ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
1090   begin
1091     removeInternal(body);
1092     px.mX := nx+mMinX;
1093     px.mY := ny+mMinY;
1094     px.mWidth := nw;
1095     px.mHeight := nh;
1096     insertInternal(body);
1097   end
1098   else
1099   begin
1100     px.mX := nx+mMinX;
1101     px.mY := ny+mMinY;
1102     px.mWidth := nw;
1103     px.mHeight := nh;
1104   end;
1105 end;
1106
1107 //TODO: optimize for horizontal/vertical moves
1108 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
1109 var
1110   px: PBodyProxyRec;
1111   x0, y0: Integer;
1112   ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
1113   ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
1114   gx, gy: Integer;
1115   gw, gh: Integer;
1116   pw, ph: Integer;
1117 begin
1118   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1119   // check if tile coords was changed
1120   px := @mProxies[body];
1121   x0 := px.mX;
1122   y0 := px.mY;
1123   if (nx = x0) and (ny = y0) then exit;
1124   // map -> grid
1125   Dec(x0, mMinX);
1126   Dec(y0, mMinY);
1127   Dec(nx, mMinX);
1128   Dec(ny, mMinY);
1129   // check for heavy work
1130   pw := px.mWidth;
1131   ph := px.mHeight;
1132   ogx0 := x0 div mTileSize;
1133   ogy0 := y0 div mTileSize;
1134   ngx0 := nx div mTileSize;
1135   ngy0 := ny div mTileSize;
1136   ogx1 := (x0+pw-1) div mTileSize;
1137   ogy1 := (y0+ph-1) div mTileSize;
1138   ngx1 := (nx+pw-1) div mTileSize;
1139   ngy1 := (ny+ph-1) div mTileSize;
1140   {$IF DEFINED(D2F_DEBUG_MOVER)}
1141   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);
1142   {$ENDIF}
1143   if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1144   begin
1145     // crossed tile boundary, do heavy work
1146     gw := mWidth;
1147     gh := mHeight;
1148     // cycle with old rect, remove body where it is necessary
1149     // optimized for horizontal moves
1150     {$IF DEFINED(D2F_DEBUG_MOVER)}
1151     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);
1152     {$ENDIF}
1153     // remove stale marks
1154     if not ((ogy0 >= gh) or (ogy1 < 0)) and
1155        not ((ogx0 >= gw) or (ogx1 < 0)) then
1156     begin
1157       if (ogx0 < 0) then ogx0 := 0;
1158       if (ogy0 < 0) then ogy0 := 0;
1159       if (ogx1 > gw-1) then ogx1 := gw-1;
1160       if (ogy1 > gh-1) then ogy1 := gh-1;
1161       {$IF DEFINED(D2F_DEBUG_MOVER)}
1162       e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1163       {$ENDIF}
1164       for gx := ogx0 to ogx1 do
1165       begin
1166         if (gx < ngx0) or (gx > ngx1) then
1167         begin
1168           // this column is completely outside of new rect
1169           for gy := ogy0 to ogy1 do
1170           begin
1171             {$IF DEFINED(D2F_DEBUG_MOVER)}
1172             e_WriteLog(Format('  remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1173             {$ENDIF}
1174             remover(gy*gw+gx, body);
1175           end;
1176         end
1177         else
1178         begin
1179           // heavy checks
1180           for gy := ogy0 to ogy1 do
1181           begin
1182             if (gy < ngy0) or (gy > ngy1) then
1183             begin
1184               {$IF DEFINED(D2F_DEBUG_MOVER)}
1185               e_WriteLog(Format('  remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1186               {$ENDIF}
1187               remover(gy*gw+gx, body);
1188             end;
1189           end;
1190         end;
1191       end;
1192     end;
1193     // cycle with new rect, add body where it is necessary
1194     if not ((ngy0 >= gh) or (ngy1 < 0)) and
1195        not ((ngx0 >= gw) or (ngx1 < 0)) then
1196     begin
1197       if (ngx0 < 0) then ngx0 := 0;
1198       if (ngy0 < 0) then ngy0 := 0;
1199       if (ngx1 > gw-1) then ngx1 := gw-1;
1200       if (ngy1 > gh-1) then ngy1 := gh-1;
1201       {$IF DEFINED(D2F_DEBUG_MOVER)}
1202       e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1203       {$ENDIF}
1204       for gx := ngx0 to ngx1 do
1205       begin
1206         if (gx < ogx0) or (gx > ogx1) then
1207         begin
1208           // this column is completely outside of old rect
1209           for gy := ngy0 to ngy1 do
1210           begin
1211             {$IF DEFINED(D2F_DEBUG_MOVER)}
1212             e_WriteLog(Format('  insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1213             {$ENDIF}
1214             inserter(gy*gw+gx, body);
1215           end;
1216         end
1217         else
1218         begin
1219           // heavy checks
1220           for gy := ngy0 to ngy1 do
1221           begin
1222             if (gy < ogy0) or (gy > ogy1) then
1223             begin
1224               {$IF DEFINED(D2F_DEBUG_MOVER)}
1225               e_WriteLog(Format('  insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1226               {$ENDIF}
1227               inserter(gy*gw+gx, body);
1228             end;
1229           end;
1230         end;
1231       end;
1232     end;
1233     // done
1234   end
1235   else
1236   begin
1237     {$IF DEFINED(D2F_DEBUG_MOVER)}
1238     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);
1239     {$ENDIF}
1240   end;
1241   // update coordinates
1242   px.mX := nx+mMinX;
1243   px.mY := ny+mMinY;
1244 end;
1245
1246 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1247 var
1248   px: PBodyProxyRec;
1249   x0, y0, w, h: Integer;
1250 begin
1251   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1252   // check if tile coords was changed
1253   px := @mProxies[body];
1254   x0 := px.mX-mMinX;
1255   y0 := px.mY-mMinY;
1256   w := px.mWidth;
1257   h := px.mHeight;
1258   {$IF DEFINED(D2F_DEBUG_MOVER)}
1259   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);
1260   {$ENDIF}
1261   if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1262      ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1263   begin
1264     // crossed tile boundary, do heavy work
1265     removeInternal(body);
1266     px.mWidth := nw;
1267     px.mHeight := nh;
1268     insertInternal(body);
1269   end
1270   else
1271   begin
1272     // nothing to do with the grid, just fix size
1273     px.mWidth := nw;
1274     px.mHeight := nh;
1275   end;
1276 end;
1277
1278
1279 // ////////////////////////////////////////////////////////////////////////// //
1280 function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator;
1281 var
1282   cidx: Integer = -1;
1283 begin
1284   Dec(x, mMinX);
1285   Dec(y, mMinY);
1286   if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1287   result := TAtPointEnumerator.Create(mCells, cidx, getProxyById);
1288 end;
1289
1290
1291 // ////////////////////////////////////////////////////////////////////////// //
1292 // no callback: return `true` on the first hit
1293 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1294 var
1295   f: Integer;
1296   idx, curci: Integer;
1297   cc: PGridCell = nil;
1298   px: PBodyProxyRec;
1299   lq: LongWord;
1300   ptag: Integer;
1301 begin
1302   result := Default(ITP);
1303   if (exittag <> nil) then exittag^ := 0;
1304   tagmask := tagmask and TagFullMask;
1305   if (tagmask = 0) then exit;
1306
1307   {$IF DEFINED(D2F_DEBUG_XXQ)}
1308   if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1309   {$ENDIF}
1310
1311   // make coords (0,0)-based
1312   Dec(x, mMinX);
1313   Dec(y, mMinY);
1314   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1315
1316   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1317
1318   {$IF DEFINED(D2F_DEBUG_XXQ)}
1319   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);
1320   {$ENDIF}
1321
1322   // restore coords
1323   Inc(x, mMinX);
1324   Inc(y, mMinY);
1325
1326   // increase query counter
1327   Inc(mLastQuery);
1328   if (mLastQuery = 0) then
1329   begin
1330     // just in case of overflow
1331     mLastQuery := 1;
1332     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1333   end;
1334   lq := mLastQuery;
1335
1336   {$IF DEFINED(D2F_DEBUG_XXQ)}
1337   if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1338   {$ENDIF}
1339
1340   while (curci <> -1) do
1341   begin
1342     {$IF DEFINED(D2F_DEBUG_XXQ)}
1343     if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1344     {$ENDIF}
1345     cc := @mCells[curci];
1346     for f := 0 to GridCellBucketSize-1 do
1347     begin
1348       if (cc.bodies[f] = -1) then break;
1349       px := @mProxies[cc.bodies[f]];
1350       {$IF DEFINED(D2F_DEBUG_XXQ)}
1351       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);
1352       {$ENDIF}
1353       // shit. has to do it this way, so i can change tag in callback
1354       if (px.mQueryMark <> lq) then
1355       begin
1356         px.mQueryMark := lq;
1357         ptag := px.mTag;
1358         if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1359            (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1360         begin
1361           if assigned(cb) then
1362           begin
1363             if cb(px.mObj, ptag) then
1364             begin
1365               result := px.mObj;
1366               if (exittag <> nil) then exittag^ := ptag;
1367               exit;
1368             end;
1369           end
1370           else
1371           begin
1372             result := px.mObj;
1373             if (exittag <> nil) then exittag^ := ptag;
1374             exit;
1375           end;
1376         end;
1377       end;
1378     end;
1379     curci := cc.next;
1380   end;
1381 end;
1382
1383
1384 // ////////////////////////////////////////////////////////////////////////// //
1385 // no callback: return `true` on the first hit
1386 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1387 const
1388   tsize = mTileSize;
1389 var
1390   idx: Integer;
1391   gx, gy: Integer;
1392   curci: Integer;
1393   f: Integer;
1394   cc: PGridCell = nil;
1395   px: PBodyProxyRec;
1396   lq: LongWord;
1397   gw: Integer;
1398   x0, y0: Integer;
1399   ptag: Integer;
1400 begin
1401   result := Default(ITP);
1402   if (w < 1) or (h < 1) then exit;
1403   tagmask := tagmask and TagFullMask;
1404   if (tagmask = 0) then exit;
1405
1406   x0 := x;
1407   y0 := y;
1408
1409   // fix coords
1410   Dec(x, mMinX);
1411   Dec(y, mMinY);
1412
1413   gw := mWidth;
1414   //tsize := mTileSize;
1415
1416   if (x+w <= 0) or (y+h <= 0) then exit;
1417   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1418
1419   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1420   mInQuery := true;
1421
1422   // increase query counter
1423   Inc(mLastQuery);
1424   if (mLastQuery = 0) then
1425   begin
1426     // just in case of overflow
1427     mLastQuery := 1;
1428     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1429   end;
1430   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1431   lq := mLastQuery;
1432
1433   // go on
1434   for gy := y div tsize to (y+h-1) div tsize do
1435   begin
1436     if (gy < 0) then continue;
1437     if (gy >= mHeight) then break;
1438     for gx := x div tsize to (x+w-1) div tsize do
1439     begin
1440       if (gx < 0) then continue;
1441       if (gx >= gw) then break;
1442       // process cells
1443       curci := mGrid[gy*gw+gx];
1444       while (curci <> -1) do
1445       begin
1446         cc := @mCells[curci];
1447         for f := 0 to GridCellBucketSize-1 do
1448         begin
1449           if (cc.bodies[f] = -1) then break;
1450           px := @mProxies[cc.bodies[f]];
1451           // shit. has to do it this way, so i can change tag in callback
1452           if (px.mQueryMark = lq) then continue;
1453           px.mQueryMark := lq;
1454           ptag := px.mTag;
1455           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1456           if ((ptag and tagmask) = 0) then continue;
1457           if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1458           if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1459           if assigned(cb) then
1460           begin
1461             if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
1462           end
1463           else
1464           begin
1465             result := px.mObj;
1466             mInQuery := false;
1467             exit;
1468           end;
1469         end;
1470         curci := cc.next;
1471       end;
1472     end;
1473   end;
1474
1475   mInQuery := false;
1476 end;
1477
1478
1479 // ////////////////////////////////////////////////////////////////////////// //
1480 // no callback: return `true` on the nearest hit
1481 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1482 var
1483   ex, ey: Integer;
1484 begin
1485   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1486 end;
1487
1488
1489 // no callback: return `true` on the nearest hit
1490 // you are not supposed to understand this
1491 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1492 const
1493   tsize = mTileSize;
1494 var
1495   wx0, wy0, wx1, wy1: Integer; // window coordinates
1496   stx, sty: Integer; // "steps" for x and y axes
1497   dsx, dsy: Integer; // "lengthes" for x and y axes
1498   dx2, dy2: Integer; // "double lengthes" for x and y axes
1499   xd, yd: Integer; // current coord
1500   e: Integer; // "error" (as in bresenham algo)
1501   rem: Integer;
1502   term: Integer;
1503   xptr, yptr: PInteger;
1504   xfixed: Boolean;
1505   temp: Integer;
1506   prevx, prevy: Integer;
1507   lastDistSq: Integer;
1508   ccidx, curci: Integer;
1509   hasUntried: Boolean;
1510   lastGA: Integer = -1;
1511   ga, x, y: Integer;
1512   lastObj: ITP;
1513   wasHit: Boolean = false;
1514   gw, gh, minx, miny, maxx, maxy: Integer;
1515   cc: PGridCell;
1516   px: PBodyProxyRec;
1517   lq: LongWord;
1518   f, ptag, distSq: Integer;
1519   x0, y0, x1, y1: Integer;
1520   //swapped: Boolean = false; // true: xd is yd, and vice versa
1521   // horizontal walker
1522   {$IFDEF GRID_USE_ORTHO_ACCEL}
1523   wklen, wkstep: Integer;
1524   //wksign: Integer;
1525   hopt: Boolean;
1526   {$ENDIF}
1527   // skipper
1528   xdist, ydist: Integer;
1529 begin
1530   result := Default(ITP);
1531   lastObj := Default(ITP);
1532   tagmask := tagmask and TagFullMask;
1533   ex := ax1; // why not?
1534   ey := ay1; // why not?
1535   if (tagmask = 0) then exit;
1536
1537   if (ax0 = ax1) and (ay0 = ay1) then
1538   begin
1539     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1540     if (result <> nil) then
1541     begin
1542       if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
1543     end;
1544     exit;
1545   end;
1546
1547   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1548
1549   gw := mWidth;
1550   gh := mHeight;
1551   minx := mMinX;
1552   miny := mMinY;
1553   maxx := gw*tsize-1;
1554   maxy := gh*tsize-1;
1555
1556   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1557   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);
1558   {$ENDIF}
1559
1560   x0 := ax0;
1561   y0 := ay0;
1562   x1 := ax1;
1563   y1 := ay1;
1564
1565   // offset query coords to (0,0)-based
1566   Dec(x0, minx);
1567   Dec(y0, miny);
1568   Dec(x1, minx);
1569   Dec(y1, miny);
1570
1571   // clip rectange
1572   wx0 := 0;
1573   wy0 := 0;
1574   wx1 := maxx;
1575   wy1 := maxy;
1576
1577   // horizontal setup
1578   if (x0 < x1) then
1579   begin
1580     // from left to right
1581     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1582     stx := 1; // going right
1583   end
1584   else
1585   begin
1586     // from right to left
1587     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1588     stx := -1; // going left
1589     x0 := -x0;
1590     x1 := -x1;
1591     wx0 := -wx0;
1592     wx1 := -wx1;
1593     swapInt(wx0, wx1);
1594   end;
1595
1596   // vertical setup
1597   if (y0 < y1) then
1598   begin
1599     // from top to bottom
1600     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1601     sty := 1; // going down
1602   end
1603   else
1604   begin
1605     // from bottom to top
1606     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1607     sty := -1; // going up
1608     y0 := -y0;
1609     y1 := -y1;
1610     wy0 := -wy0;
1611     wy1 := -wy1;
1612     swapInt(wy0, wy1);
1613   end;
1614
1615   dsx := x1-x0;
1616   dsy := y1-y0;
1617
1618   if (dsx < dsy) then
1619   begin
1620     //swapped := true;
1621     xptr := @yd;
1622     yptr := @xd;
1623     swapInt(x0, y0);
1624     swapInt(x1, y1);
1625     swapInt(dsx, dsy);
1626     swapInt(wx0, wy0);
1627     swapInt(wx1, wy1);
1628     swapInt(stx, sty);
1629   end
1630   else
1631   begin
1632     xptr := @xd;
1633     yptr := @yd;
1634   end;
1635
1636   dx2 := 2*dsx;
1637   dy2 := 2*dsy;
1638   xd := x0;
1639   yd := y0;
1640   e := 2*dsy-dsx;
1641   term := x1;
1642
1643   xfixed := false;
1644   if (y0 < wy0) then
1645   begin
1646     // clip at top
1647     temp := dx2*(wy0-y0)-dsx;
1648     xd += temp div dy2;
1649     rem := temp mod dy2;
1650     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1651     if (xd+1 >= wx0) then
1652     begin
1653       yd := wy0;
1654       e -= rem+dsx;
1655       if (rem > 0) then begin Inc(xd); e += dy2; end;
1656       xfixed := true;
1657     end;
1658   end;
1659
1660   if (not xfixed) and (x0 < wx0) then
1661   begin
1662     // clip at left
1663     temp := dy2*(wx0-x0);
1664     yd += temp div dx2;
1665     rem := temp mod dx2;
1666     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1667     xd := wx0;
1668     e += rem;
1669     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1670   end;
1671
1672   if (y1 > wy1) then
1673   begin
1674     // clip at bottom
1675     temp := dx2*(wy1-y0)+dsx;
1676     term := x0+temp div dy2;
1677     rem := temp mod dy2;
1678     if (rem = 0) then Dec(term);
1679   end;
1680
1681   if (term > wx1) then term := wx1; // clip at right
1682
1683   Inc(term); // draw last point
1684   //if (term = xd) then exit; // this is the only point, get out of here
1685
1686   if (sty = -1) then yd := -yd;
1687   if (stx = -1) then begin xd := -xd; term := -term; end;
1688   dx2 -= dy2;
1689
1690   // first move, to skip starting point
1691   // DON'T DO THIS! loop will take care of that
1692   if (xd = term) then
1693   begin
1694     //FIXME!
1695     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1696     if (result <> nil) then
1697     begin
1698       if assigned(cb) then
1699       begin
1700         if cb(result, ptag, ax0, ay0, ax0, ay0) then
1701         begin
1702           ex := ax0;
1703           ey := ay0;
1704         end
1705         else
1706         begin
1707           result := nil;
1708         end;
1709       end
1710       else
1711       begin
1712         ex := ax0;
1713         ey := ay0;
1714       end;
1715     end;
1716     exit;
1717   end;
1718
1719   prevx := xptr^+minx;
1720   prevy := yptr^+miny;
1721   (*
1722   // move coords
1723   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1724   xd += stx;
1725   // done?
1726   if (xd = term) then exit;
1727   *)
1728
1729   {$IF DEFINED(D2F_DEBUG)}
1730   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1731   {$ENDIF}
1732   // DON'T DO THIS! loop will take care of that
1733   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1734   //ccidx := mGrid[lastGA];
1735
1736   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1737   //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1738   {$ENDIF}
1739
1740   //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1741
1742   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1743   mInQuery := true;
1744
1745   // increase query counter
1746   Inc(mLastQuery);
1747   if (mLastQuery = 0) then
1748   begin
1749     // just in case of overflow
1750     mLastQuery := 1;
1751     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1752   end;
1753   lq := mLastQuery;
1754
1755   {$IFDEF GRID_USE_ORTHO_ACCEL}
1756   // if this is strict horizontal/vertical trace, use optimized codepath
1757   if (ax0 = ax1) or (ay0 = ay1) then
1758   begin
1759     // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
1760     //   stx < 0: going left, otherwise `stx` is > 0, and we're going right
1761     // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
1762     //   stx < 0: going up, otherwise `stx` is > 0, and we're going down
1763     hopt := (ay0 = ay1); // horizontal?
1764     if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
1765     {$IF DEFINED(D2F_DEBUG)}
1766     if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
1767     {$ENDIF}
1768     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1769     // one of those will never change
1770     x := xptr^+minx;
1771     y := yptr^+miny;
1772     while (wklen > 0) do
1773     begin
1774       {$IF DEFINED(D2F_DEBUG)}
1775       if dbgShowTraceLog then e_LogWritefln('  htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1776       {$ENDIF}
1777       // new tile?
1778       if (ga <> lastGA) then
1779       begin
1780         lastGA := ga;
1781         ccidx := mGrid[lastGA];
1782         // convert coords to map (to avoid ajdusting coords inside the loop)
1783         if hopt then x := xptr^+minx else y := yptr^+miny;
1784         while (ccidx <> -1) do
1785         begin
1786           cc := @mCells[ccidx];
1787           for f := 0 to GridCellBucketSize-1 do
1788           begin
1789             if (cc.bodies[f] = -1) then break;
1790             px := @mProxies[cc.bodies[f]];
1791             ptag := px.mTag;
1792             if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
1793                // constant coord should be inside
1794                ((hopt and (y >= px.y0) and (y <= px.y1)) or
1795                 ((not hopt) and (x >= px.x0) and (x <= px.x1))) then
1796             begin
1797               px.mQueryMark := lq; // mark as processed
1798               // inside the proxy?
1799               if (hopt and (x > px.x0) and (x < px.x1)) or
1800                  ((not hopt) and (y > px.y0) and (y < px.y1)) then
1801               begin
1802                 // setup prev[xy]
1803                 if assigned(cb) then
1804                 begin
1805                   if cb(px.mObj, ptag, x, y, x, y) then
1806                   begin
1807                     result := px.mObj;
1808                     ex := x;
1809                     ey := y;
1810                     mInQuery := false;
1811                     exit;
1812                   end;
1813                 end
1814                 else
1815                 begin
1816                   distSq := distanceSq(ax0, ay0, x, y);
1817                   {$IF DEFINED(D2F_DEBUG)}
1818                   if dbgShowTraceLog then e_LogWritefln('  EMBEDDED hhit(%d): a=(%d,%d), h=(%d,%d), distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, distSq, lastDistSq]);
1819                   {$ENDIF}
1820                   if (distSq < lastDistSq) then
1821                   begin
1822                     ex := x;
1823                     ey := y;
1824                     result := px.mObj;
1825                     mInQuery := false;
1826                     exit;
1827                   end;
1828                 end;
1829                 continue;
1830               end;
1831               // remember this hitpoint if it is nearer than an old one
1832               // setup prev[xy]
1833               if hopt then
1834               begin
1835                 // horizontal trace
1836                 prevy := y;
1837                 y := yptr^+miny;
1838                 if (stx < 0) then
1839                 begin
1840                   // going left
1841                   if (x < px.x1) then continue; // not on the right edge
1842                   x := px.x1;
1843                   prevx := x+1;
1844                 end
1845                 else
1846                 begin
1847                   // going right
1848                   if (x > px.x0) then continue; // not on the left edge
1849                   x := px.x0;
1850                   prevx := x-1;
1851                 end;
1852               end
1853               else
1854               begin
1855                 // vertical trace
1856                 prevx := x;
1857                 x := xptr^+minx;
1858                 if (stx < 0) then
1859                 begin
1860                   // going up
1861                   if (y < px.y1) then continue; // not on the bottom edge
1862                   y := px.y1;
1863                   prevy := x+1;
1864                 end
1865                 else
1866                 begin
1867                   // going down
1868                   if (y > px.y0) then continue; // not on the top edge
1869                   y := px.y0;
1870                   prevy := y-1;
1871                 end;
1872               end;
1873               if assigned(cb) then
1874               begin
1875                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1876                 begin
1877                   result := px.mObj;
1878                   ex := prevx;
1879                   ey := prevy;
1880                   mInQuery := false;
1881                   exit;
1882                 end;
1883               end
1884               else
1885               begin
1886                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1887                 {$IF DEFINED(D2F_DEBUG)}
1888                 if dbgShowTraceLog then e_LogWritefln('  hhit(%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]);
1889                 {$ENDIF}
1890                 if (distSq < lastDistSq) then
1891                 begin
1892                   wasHit := true;
1893                   lastDistSq := distSq;
1894                   ex := prevx;
1895                   ey := prevy;
1896                   lastObj := px.mObj;
1897                 end;
1898               end;
1899             end;
1900           end;
1901           // next cell
1902           ccidx := cc.next;
1903         end;
1904         if wasHit and not assigned(cb) then begin result := lastObj; mInQuery := false; exit; end;
1905         if assigned(cb) and cb(nil, 0, x, y, x, y) then begin result := lastObj; mInQuery := false; exit; end;
1906       end;
1907       // skip to next tile
1908       if hopt then
1909       begin
1910         if (stx > 0) then
1911         begin
1912           // to the right
1913           wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
1914           {$IF DEFINED(D2F_DEBUG)}
1915           if dbgShowTraceLog then e_LogWritefln('  right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1916           {$ENDIF}
1917           if (wkstep >= wklen) then break;
1918           Inc(xptr^, wkstep);
1919           Inc(ga);
1920         end
1921         else
1922         begin
1923           // to the left
1924           wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
1925           {$IF DEFINED(D2F_DEBUG)}
1926           if dbgShowTraceLog then e_LogWritefln('  left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1927           {$ENDIF}
1928           if (wkstep >= wklen) then break;
1929           Dec(xptr^, wkstep);
1930           Dec(ga);
1931         end;
1932       end
1933       else
1934       begin
1935         if (stx > 0) then
1936         begin
1937           // to the down
1938           wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
1939           {$IF DEFINED(D2F_DEBUG)}
1940           if dbgShowTraceLog then e_LogWritefln('  down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1941           {$ENDIF}
1942           if (wkstep >= wklen) then break;
1943           Inc(yptr^, wkstep);
1944           Inc(ga, mWidth);
1945         end
1946         else
1947         begin
1948           // to the up
1949           wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
1950           {$IF DEFINED(D2F_DEBUG)}
1951           if dbgShowTraceLog then e_LogWritefln('  up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1952           {$ENDIF}
1953           if (wkstep >= wklen) then break;
1954           Dec(yptr^, wkstep);
1955           Dec(ga, mWidth);
1956         end;
1957       end;
1958       Dec(wklen, wkstep);
1959     end;
1960     // we can travel less than one cell
1961     if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
1962     mInQuery := false;
1963     exit;
1964   end;
1965   {$ENDIF}
1966
1967   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1968   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1969   {$ENDIF}
1970
1971   //e_LogWritefln('*********************', []);
1972   ccidx := -1;
1973   //  can omit checks
1974   while (xd <> term) do
1975   begin
1976     // check cell(s)
1977     {$IF DEFINED(D2F_DEBUG)}
1978     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1979     {$ENDIF}
1980     // new tile?
1981     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1982     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1983     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);
1984     {$ENDIF}
1985     if (ga <> lastGA) then
1986     begin
1987       // yes
1988       {$IF DEFINED(D2F_DEBUG)}
1989       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1990       {$ENDIF}
1991       if (ccidx <> -1) then
1992       begin
1993         // signal cell completion
1994         if assigned(cb) then
1995         begin
1996           if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
1997         end
1998         else if wasHit then
1999         begin
2000           result := lastObj;
2001           mInQuery := false;
2002           exit;
2003         end;
2004       end;
2005       lastGA := ga;
2006       ccidx := mGrid[lastGA];
2007     end;
2008     // has something to process in this tile?
2009     if (ccidx <> -1) then
2010     begin
2011       // process cell
2012       curci := ccidx;
2013       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
2014       // convert coords to map (to avoid ajdusting coords inside the loop)
2015       x := xptr^+minx;
2016       y := yptr^+miny;
2017       // process cell list
2018       while (curci <> -1) do
2019       begin
2020         cc := @mCells[curci];
2021         for f := 0 to GridCellBucketSize-1 do
2022         begin
2023           if (cc.bodies[f] = -1) then break;
2024           px := @mProxies[cc.bodies[f]];
2025           ptag := px.mTag;
2026           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2027           begin
2028             // can we process this proxy?
2029             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2030             begin
2031               px.mQueryMark := lq; // mark as processed
2032               if assigned(cb) then
2033               begin
2034                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
2035                 begin
2036                   result := px.mObj;
2037                   ex := prevx;
2038                   ey := prevy;
2039                   mInQuery := false;
2040                   exit;
2041                 end;
2042               end
2043               else
2044               begin
2045                 // remember this hitpoint if it is nearer than an old one
2046                 distSq := distanceSq(ax0, ay0, prevx, prevy);
2047                 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2048                 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);
2049                 {$ENDIF}
2050                 if (distSq < lastDistSq) then
2051                 begin
2052                   wasHit := true;
2053                   lastDistSq := distSq;
2054                   ex := prevx;
2055                   ey := prevy;
2056                   lastObj := px.mObj;
2057                 end;
2058               end;
2059             end
2060             else
2061             begin
2062               // this is possibly interesting proxy, set "has more to check" flag
2063               hasUntried := true;
2064             end;
2065           end;
2066         end;
2067         // next cell
2068         curci := cc.next;
2069       end;
2070       // still has something interesting in this cell?
2071       if not hasUntried then
2072       begin
2073         // nope, don't process this cell anymore; signal cell completion
2074         ccidx := -1;
2075         if assigned(cb) then
2076         begin
2077           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
2078         end
2079         else if wasHit then
2080         begin
2081           result := lastObj;
2082           mInQuery := false;
2083           exit;
2084         end;
2085       end;
2086     end;
2087     if (ccidx = -1) then
2088     begin
2089       // move to cell edge, as we have nothing to trace here anymore
2090       if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2091       if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2092       //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2093       while (xd <> xdist) and (yd <> ydist) do
2094       begin
2095         // step
2096         xd += stx;
2097         if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2098         //e_LogWritefln('  xd=%d; yd=%d', [xd, yd]);
2099         if (xd = term) then break;
2100       end;
2101       //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2102       if (xd = term) then break;
2103     end;
2104     //putPixel(xptr^, yptr^);
2105     // move coords
2106     prevx := xptr^+minx;
2107     prevy := yptr^+miny;
2108     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2109     xd += stx;
2110   end;
2111   // we can travel less than one cell
2112   if wasHit and not assigned(cb) then
2113   begin
2114     result := lastObj;
2115   end
2116   else
2117   begin
2118     ex := ax1; // why not?
2119     ey := ay1; // why not?
2120   end;
2121
2122   mInQuery := false;
2123 end;
2124
2125
2126 // ////////////////////////////////////////////////////////////////////////// //
2127 //FIXME! optimize this with real tile walking
2128 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
2129 const
2130   tsize = mTileSize;
2131 var
2132   wx0, wy0, wx1, wy1: Integer; // window coordinates
2133   stx, sty: Integer; // "steps" for x and y axes
2134   dsx, dsy: Integer; // "lengthes" for x and y axes
2135   dx2, dy2: Integer; // "double lengthes" for x and y axes
2136   xd, yd: Integer; // current coord
2137   e: Integer; // "error" (as in bresenham algo)
2138   rem: Integer;
2139   term: Integer;
2140   xptr, yptr: PInteger;
2141   xfixed: Boolean;
2142   temp: Integer;
2143   ccidx, curci: Integer;
2144   lastGA: Integer = -1;
2145   ga: Integer;
2146   gw, gh, minx, miny, maxx, maxy: Integer;
2147   cc: PGridCell;
2148   px: PBodyProxyRec;
2149   lq: LongWord;
2150   f, ptag: Integer;
2151   x0, y0, x1, y1: Integer;
2152   //swapped: Boolean = false; // true: xd is yd, and vice versa
2153   // horizontal walker
2154   {$IFDEF GRID_USE_ORTHO_ACCEL}
2155   wklen, wkstep: Integer;
2156   //wksign: Integer;
2157   hopt: Boolean;
2158   {$ENDIF}
2159   // skipper
2160   xdist, ydist: Integer;
2161 begin
2162   log := false;
2163   result := Default(ITP);
2164   tagmask := tagmask and TagFullMask;
2165   if (tagmask = 0) or not assigned(cb) then exit;
2166
2167   if (ax0 = ax1) and (ay0 = ay1) then
2168   begin
2169     result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2170     exit;
2171   end;
2172
2173   gw := mWidth;
2174   gh := mHeight;
2175   minx := mMinX;
2176   miny := mMinY;
2177   maxx := gw*tsize-1;
2178   maxy := gh*tsize-1;
2179
2180   x0 := ax0;
2181   y0 := ay0;
2182   x1 := ax1;
2183   y1 := ay1;
2184
2185   // offset query coords to (0,0)-based
2186   Dec(x0, minx);
2187   Dec(y0, miny);
2188   Dec(x1, minx);
2189   Dec(y1, miny);
2190
2191   // clip rectange
2192   wx0 := 0;
2193   wy0 := 0;
2194   wx1 := maxx;
2195   wy1 := maxy;
2196
2197   // horizontal setup
2198   if (x0 < x1) then
2199   begin
2200     // from left to right
2201     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2202     stx := 1; // going right
2203   end
2204   else
2205   begin
2206     // from right to left
2207     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2208     stx := -1; // going left
2209     x0 := -x0;
2210     x1 := -x1;
2211     wx0 := -wx0;
2212     wx1 := -wx1;
2213     swapInt(wx0, wx1);
2214   end;
2215
2216   // vertical setup
2217   if (y0 < y1) then
2218   begin
2219     // from top to bottom
2220     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2221     sty := 1; // going down
2222   end
2223   else
2224   begin
2225     // from bottom to top
2226     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2227     sty := -1; // going up
2228     y0 := -y0;
2229     y1 := -y1;
2230     wy0 := -wy0;
2231     wy1 := -wy1;
2232     swapInt(wy0, wy1);
2233   end;
2234
2235   dsx := x1-x0;
2236   dsy := y1-y0;
2237
2238   if (dsx < dsy) then
2239   begin
2240     //swapped := true;
2241     xptr := @yd;
2242     yptr := @xd;
2243     swapInt(x0, y0);
2244     swapInt(x1, y1);
2245     swapInt(dsx, dsy);
2246     swapInt(wx0, wy0);
2247     swapInt(wx1, wy1);
2248     swapInt(stx, sty);
2249   end
2250   else
2251   begin
2252     xptr := @xd;
2253     yptr := @yd;
2254   end;
2255
2256   dx2 := 2*dsx;
2257   dy2 := 2*dsy;
2258   xd := x0;
2259   yd := y0;
2260   e := 2*dsy-dsx;
2261   term := x1;
2262
2263   xfixed := false;
2264   if (y0 < wy0) then
2265   begin
2266     // clip at top
2267     temp := dx2*(wy0-y0)-dsx;
2268     xd += temp div dy2;
2269     rem := temp mod dy2;
2270     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2271     if (xd+1 >= wx0) then
2272     begin
2273       yd := wy0;
2274       e -= rem+dsx;
2275       if (rem > 0) then begin Inc(xd); e += dy2; end;
2276       xfixed := true;
2277     end;
2278   end;
2279
2280   if (not xfixed) and (x0 < wx0) then
2281   begin
2282     // clip at left
2283     temp := dy2*(wx0-x0);
2284     yd += temp div dx2;
2285     rem := temp mod dx2;
2286     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2287     xd := wx0;
2288     e += rem;
2289     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2290   end;
2291
2292   if (y1 > wy1) then
2293   begin
2294     // clip at bottom
2295     temp := dx2*(wy1-y0)+dsx;
2296     term := x0+temp div dy2;
2297     rem := temp mod dy2;
2298     if (rem = 0) then Dec(term);
2299   end;
2300
2301   if (term > wx1) then term := wx1; // clip at right
2302
2303   Inc(term); // draw last point
2304   //if (term = xd) then exit; // this is the only point, get out of here
2305
2306   if (sty = -1) then yd := -yd;
2307   if (stx = -1) then begin xd := -xd; term := -term; end;
2308   dx2 -= dy2;
2309
2310   // first move, to skip starting point
2311   // DON'T DO THIS! loop will take care of that
2312   if (xd = term) then
2313   begin
2314     result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2315     exit;
2316   end;
2317
2318   (*
2319   // move coords
2320   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2321   xd += stx;
2322   // done?
2323   if (xd = term) then exit;
2324   *)
2325
2326   {$IF DEFINED(D2F_DEBUG)}
2327   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2328   {$ENDIF}
2329   // DON'T DO THIS! loop will take care of that
2330   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2331   //ccidx := mGrid[lastGA];
2332
2333   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2334   mInQuery := true;
2335
2336   // increase query counter
2337   Inc(mLastQuery);
2338   if (mLastQuery = 0) then
2339   begin
2340     // just in case of overflow
2341     mLastQuery := 1;
2342     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2343   end;
2344   lq := mLastQuery;
2345
2346   {$IFDEF GRID_USE_ORTHO_ACCEL}
2347   // if this is strict horizontal/vertical trace, use optimized codepath
2348   if (ax0 = ax1) or (ay0 = ay1) then
2349   begin
2350     // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2351     //   stx < 0: going left, otherwise `stx` is > 0, and we're going right
2352     // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2353     //   stx < 0: going up, otherwise `stx` is > 0, and we're going down
2354     hopt := (ay0 = ay1); // horizontal?
2355     if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
2356     {$IF DEFINED(D2F_DEBUG)}
2357     if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
2358     {$ENDIF}
2359     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2360     while (wklen > 0) do
2361     begin
2362       {$IF DEFINED(D2F_DEBUG)}
2363       if dbgShowTraceLog then e_LogWritefln('  htrace; ga=%d; x=%d, y=%d; ay0=%d', [ga, xptr^+minx, yptr^+miny, ay0]);
2364       {$ENDIF}
2365       // new tile?
2366       if (ga <> lastGA) then
2367       begin
2368         lastGA := ga;
2369         ccidx := mGrid[lastGA];
2370         // convert coords to map (to avoid ajdusting coords inside the loop)
2371         while (ccidx <> -1) do
2372         begin
2373           cc := @mCells[ccidx];
2374           for f := 0 to GridCellBucketSize-1 do
2375           begin
2376             if (cc.bodies[f] = -1) then break;
2377             px := @mProxies[cc.bodies[f]];
2378             ptag := px.mTag;
2379             if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2380             begin
2381               px.mQueryMark := lq; // mark as processed
2382               if assigned(cb) then
2383               begin
2384                 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2385               end
2386               else
2387               begin
2388                 result := px.mObj;
2389                 mInQuery := false;
2390                 exit;
2391               end;
2392             end;
2393           end;
2394           // next cell
2395           ccidx := cc.next;
2396         end;
2397       end;
2398       // skip to next tile
2399       if hopt then
2400       begin
2401         if (stx > 0) then
2402         begin
2403           // to the right
2404           wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
2405           {$IF DEFINED(D2F_DEBUG)}
2406           if dbgShowTraceLog then e_LogWritefln('  right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2407           {$ENDIF}
2408           if (wkstep >= wklen) then break;
2409           Inc(xptr^, wkstep);
2410           Inc(ga);
2411         end
2412         else
2413         begin
2414           // to the left
2415           wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
2416           {$IF DEFINED(D2F_DEBUG)}
2417           if dbgShowTraceLog then e_LogWritefln('  left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2418           {$ENDIF}
2419           if (wkstep >= wklen) then break;
2420           Dec(xptr^, wkstep);
2421           Dec(ga);
2422         end;
2423       end
2424       else
2425       begin
2426         if (stx > 0) then
2427         begin
2428           // to the down
2429           wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
2430           {$IF DEFINED(D2F_DEBUG)}
2431           if dbgShowTraceLog then e_LogWritefln('  down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2432           {$ENDIF}
2433           if (wkstep >= wklen) then break;
2434           Inc(yptr^, wkstep);
2435           Inc(ga, mWidth);
2436         end
2437         else
2438         begin
2439           // to the up
2440           wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
2441           {$IF DEFINED(D2F_DEBUG)}
2442           if dbgShowTraceLog then e_LogWritefln('  up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2443           {$ENDIF}
2444           if (wkstep >= wklen) then break;
2445           Dec(yptr^, wkstep);
2446           Dec(ga, mWidth);
2447         end;
2448       end;
2449       Dec(wklen, wkstep);
2450     end;
2451     mInQuery := false;
2452     exit;
2453   end;
2454   {$ENDIF}
2455
2456   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2457   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2458   {$ENDIF}
2459
2460   ccidx := -1;
2461   //  can omit checks
2462   while (xd <> term) do
2463   begin
2464     // check cell(s)
2465     {$IF DEFINED(D2F_DEBUG)}
2466     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2467     {$ENDIF}
2468     // new tile?
2469     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2470     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2471     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);
2472     {$ENDIF}
2473     if (ga <> lastGA) then
2474     begin
2475       // yes
2476       {$IF DEFINED(D2F_DEBUG)}
2477       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2478       {$ENDIF}
2479       lastGA := ga;
2480       ccidx := mGrid[lastGA];
2481     end;
2482     // has something to process in this tile?
2483     if (ccidx <> -1) then
2484     begin
2485       // process cell
2486       curci := ccidx;
2487       // process cell list
2488       while (curci <> -1) do
2489       begin
2490         cc := @mCells[curci];
2491         for f := 0 to GridCellBucketSize-1 do
2492         begin
2493           if (cc.bodies[f] = -1) then break;
2494           px := @mProxies[cc.bodies[f]];
2495           ptag := px.mTag;
2496           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2497           begin
2498             px.mQueryMark := lq; // mark as processed
2499             if assigned(cb) then
2500             begin
2501               if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2502             end
2503             else
2504             begin
2505               result := px.mObj;
2506               mInQuery := false;
2507               exit;
2508             end;
2509           end;
2510         end;
2511         // next cell
2512         curci := cc.next;
2513       end;
2514       // nothing more interesting in this cell
2515       ccidx := -1;
2516     end;
2517     // move to cell edge, as we have nothing to trace here anymore
2518     if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2519     if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2520     //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2521     while (xd <> xdist) and (yd <> ydist) do
2522     begin
2523       // step
2524       xd += stx;
2525       if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2526       //e_LogWritefln('  xd=%d; yd=%d', [xd, yd]);
2527       if (xd = term) then break;
2528     end;
2529     //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2530     if (xd = term) then break;
2531     //putPixel(xptr^, yptr^);
2532     // move coords
2533     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2534     xd += stx;
2535   end;
2536
2537   mInQuery := false;
2538 end;
2539
2540
2541 // ////////////////////////////////////////////////////////////////////////// //
2542 // trace box with the given velocity; return object hit (if any)
2543 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
2544 function TBodyGridBase.traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
2545 var
2546   gx, gy: Integer;
2547   cidx: Integer;
2548   cc: PGridCell;
2549   px: PBodyProxyRec;
2550   lq: LongWord;
2551   f, ptag: Integer;
2552   minu0: Single = 100000.0;
2553   u0, u1: Single;
2554   hedge: Integer;
2555   cx0, cy0, cx1, cy1: Integer;
2556 begin
2557   result := Default(ITP);
2558   ex := ax0+dx;
2559   ey := ay0+dy;
2560   if (aw < 1) or (ah < 1) then exit;
2561
2562   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2563   mInQuery := true;
2564
2565   cx0 := nmin(ax0, ax0+dx);
2566   cy0 := nmin(ay0, ay0+dy);
2567   cx1 := nmax(ax0+aw-1, ax0+aw-1+dx);
2568   cy1 := nmax(ay0+ah-1, ay0+ah-1+dy);
2569
2570   cx0 -= mMinX; cy0 -= mMinY;
2571   cx1 -= mMinX; cy1 -= mMinY;
2572
2573   if (cx1 < 0) or (cy1 < 0) or (cx0 >= mWidth*mTileSize) or (cy0 >= mHeight*mTileSize) then exit;
2574
2575   if (cx0 < 0) then cx0 := 0;
2576   if (cy0 < 0) then cy0 := 0;
2577   if (cx1 >= mWidth*mTileSize) then cx1 := mWidth*mTileSize-1;
2578   if (cy1 >= mHeight*mTileSize) then cy1 := mHeight*mTileSize-1;
2579   // just in case
2580   if (cx0 > cx1) or (cy0 > cy1) then exit;
2581
2582   // increase query counter
2583   Inc(mLastQuery);
2584   if (mLastQuery = 0) then
2585   begin
2586     // just in case of overflow
2587     mLastQuery := 1;
2588     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2589   end;
2590   lq := mLastQuery;
2591
2592   for gy := cy0 div mTileSize to cy1 div mTileSize do
2593   begin
2594     for gx := cx0 div mTileSize to cx1 div mTileSize do
2595     begin
2596       cidx := mGrid[gy*mWidth+gx];
2597       while (cidx <> -1) do
2598       begin
2599         cc := @mCells[cidx];
2600         for f := 0 to GridCellBucketSize-1 do
2601         begin
2602           if (cc.bodies[f] = -1) then break;
2603           px := @mProxies[cc.bodies[f]];
2604           ptag := px.mTag;
2605           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2606           begin
2607             px.mQueryMark := lq; // mark as processed
2608             if assigned(cb) then
2609             begin
2610               if not cb(px.mObj, ptag) then continue;
2611             end;
2612             if not sweepAABB(ax0, ay0, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0, @hedge, @u1) then
2613             begin
2614               {
2615               if (u1 >= 0) then
2616               begin
2617                 // overlapping
2618                 ex := ax0;
2619                 ey := ay0;
2620                 result := px.mObj;
2621                 mInQuery := false;
2622                 exit;
2623               end;
2624               }
2625               continue;
2626             end;
2627             if (minu0 > u0) then
2628             begin
2629               result := px.mObj;
2630               minu0 := u0;
2631               if (u0 = 0.0) then
2632               begin
2633                 ex := ax0;
2634                 ey := ay0;
2635                 mInQuery := false;
2636                 exit;
2637               end;
2638             end;
2639           end;
2640         end;
2641         // next cell
2642         cidx := cc.next;
2643       end;
2644     end;
2645   end;
2646
2647   if (minu0 <= 1.0) then
2648   begin
2649     ex := ax0+trunc(dx*minu0);
2650     ey := ay0+trunc(dy*minu0);
2651   end;
2652
2653   mInQuery := false;
2654 end;
2655
2656
2657 // ////////////////////////////////////////////////////////////////////////// //
2658 {.$DEFINE D2F_DEBUG_OTR}
2659 function TBodyGridBase.traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
2660 var
2661   ccidx: Integer;
2662   cc: PGridCell;
2663   px: PBodyProxyRec;
2664   ptag: Integer;
2665   minx, miny: Integer;
2666   f, c0, c1: Integer;
2667   x0, y0, x1, y1: Integer;
2668   celly0, celly1: Integer;
2669   dy: Integer;
2670   filled: array[0..mTileSize-1] of Byte;
2671   {$IF DEFINED(D2F_DEBUG_OTR)}
2672   s: AnsiString = '';
2673   {$ENDIF}
2674 begin
2675   result := false;
2676   ex := ax1;
2677   ey := ay1;
2678   if not ((ax0 = ax1) or (ay0 = ay1)) then raise Exception.Create('orthoray is not orthogonal');
2679
2680   tagmask := tagmask and TagFullMask;
2681   if (tagmask = 0) then exit;
2682
2683   if (forEachAtPoint(ax0, ay0, nil, tagmask) = nil) then exit;
2684
2685   minx := mMinX;
2686   miny := mMinY;
2687
2688   // offset query coords to (0,0)-based
2689   x0 := ax0-minx;
2690   y0 := ay0-miny;
2691   x1 := ax1-minx;
2692   y1 := ay1-miny;
2693
2694   if (x0 = x1) then
2695   begin
2696     if (x0 < 0) or (x0 >= mWidth*mTileSize) then exit; // oops
2697     // vertical
2698     if (y0 < y1) then
2699     begin
2700       // down
2701       if (y1 < 0) or (y0 >= mHeight*mTileSize) then exit;
2702       //if (ay0 < 0) then ay0 := 0;
2703       if (y0 < 0) then exit;
2704       if (y1 >= mHeight*mTileSize) then y1 := mHeight*mTileSize-1;
2705       dy := 1;
2706     end
2707     else
2708     begin
2709       // up
2710       if (y0 < 0) or (y1 >= mHeight*mTileSize) then exit;
2711       //if (ay1 < 0) then ay1 := 0;
2712       if (y1 < 0) then exit;
2713       if (y0 >= mHeight*mTileSize) then y0 := mHeight*mTileSize-1;
2714       dy := -1;
2715     end;
2716     // check tile
2717     while true do
2718     begin
2719       ccidx := mGrid[(y0 div mTileSize)*mWidth+(x0 div mTileSize)];
2720       FillChar(filled, sizeof(filled), 0);
2721       celly0 := y0 and (not (mTileSize-1));
2722       celly1 := celly0+mTileSize-1;
2723       while (ccidx <> -1) do
2724       begin
2725         cc := @mCells[ccidx];
2726         for f := 0 to GridCellBucketSize-1 do
2727         begin
2728           if (cc.bodies[f] = -1) then break;
2729           px := @mProxies[cc.bodies[f]];
2730           ptag := px.mTag;
2731           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
2732              (ax0 >= px.x0) and (ax0 <= px.x1) then
2733           begin
2734             // bound c0 and c1 to cell
2735             c0 := nclamp(px.y0-miny, celly0, celly1);
2736             c1 := nclamp(px.y1-miny, celly0, celly1);
2737             // fill the thing
2738             {$IF DEFINED(D2F_DEBUG_OTR)}
2739             e_LogWritefln('**px.y0=%s; px.y1=%s; c0=%s; c1=%s; celly0=%s; celly1=%s; [%s..%s]', [px.y0-miny, px.y1-miny, c0, c1, celly0, celly1, c0-celly0, (c0-celly0)+(c1-c0)]);
2740             {$ENDIF}
2741             //assert(c0 <= c1);
2742             FillChar(filled[c0-celly0], c1-c0+1, 1);
2743           end;
2744         end;
2745         // next cell
2746         ccidx := cc.next;
2747       end;
2748       {$IF DEFINED(D2F_DEBUG_OTR)}
2749       s := formatstrf('  x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0, ay0, ay1, y0, celly0, celly1, dy]);
2750       for f := 0 to High(filled) do if (filled[f] <> 0) then s += '1' else s += '0';
2751       s += ']';
2752       e_LogWriteln(s);
2753       {$ENDIF}
2754       // now go till we hit cell boundary or empty space
2755       if (dy < 0) then
2756       begin
2757         // up
2758         while (y0 >= celly0) and (filled[y0-celly0] <> 0) do
2759         begin
2760           {$IF DEFINED(D2F_DEBUG_OTR)}
2761           e_LogWritefln('   filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
2762           {$ENDIF}
2763           Dec(y0);
2764           Dec(ay0);
2765         end;
2766         {$IF DEFINED(D2F_DEBUG_OTR)}
2767         e_LogWritefln('   span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
2768         {$ENDIF}
2769         if (ay0 <= ay1) then begin ey := ay1; result := false; exit; end;
2770         if (y0 >= celly0) then begin ey := ay0+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result := true; exit; end;
2771       end
2772       else
2773       begin
2774         // down
2775         while (y0 <= celly1) and (filled[y0-celly0] <> 0) do begin Inc(y0); Inc(ay0); end;
2776         if (ay0 >= ay1) then begin ey := ay1; result := false; exit; end;
2777         if (y0 <= celly1) then begin ey := ay0-1; result := true; exit; end;
2778       end;
2779     end;
2780   end
2781   else
2782   begin
2783     // horizontal
2784     assert(false);
2785   end;
2786 end;
2787
2788
2789 end.