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