src/game/g_grid.pas

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