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, wkpos: Integer;
1291 begin
1292   result := Default(ITP);
1293   lastObj := Default(ITP);
1294   tagmask := tagmask and TagFullMask;
1295   ex := ax1; // why not?
1296   ey := ay1; // why not?
1297   if (tagmask = 0) then exit;
1298
1299   if (ax0 = ax1) and (ay0 = ay1) then
1300   begin
1301     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1302     if (result <> nil) then
1303     begin
1304       if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
1305     end;
1306     exit;
1307   end;
1308
1309   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1310
1311   gw := mWidth;
1312   gh := mHeight;
1313   minx := mMinX;
1314   miny := mMinY;
1315   maxx := gw*tsize-1;
1316   maxy := gh*tsize-1;
1317
1318   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1319   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);
1320   {$ENDIF}
1321
1322   x0 := ax0;
1323   y0 := ay0;
1324   x1 := ax1;
1325   y1 := ay1;
1326
1327   // offset query coords to (0,0)-based
1328   Dec(x0, minx);
1329   Dec(y0, miny);
1330   Dec(x1, minx);
1331   Dec(y1, miny);
1332
1333   // clip rectange
1334   wx0 := 0;
1335   wy0 := 0;
1336   wx1 := maxx;
1337   wy1 := maxy;
1338
1339   // horizontal setup
1340   if (x0 < x1) then
1341   begin
1342     // from left to right
1343     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1344     stx := 1; // going right
1345   end
1346   else
1347   begin
1348     // from right to left
1349     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1350     stx := -1; // going left
1351     x0 := -x0;
1352     x1 := -x1;
1353     wx0 := -wx0;
1354     wx1 := -wx1;
1355     swapInt(wx0, wx1);
1356   end;
1357
1358   // vertical setup
1359   if (y0 < y1) then
1360   begin
1361     // from top to bottom
1362     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1363     sty := 1; // going down
1364   end
1365   else
1366   begin
1367     // from bottom to top
1368     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1369     sty := -1; // going up
1370     y0 := -y0;
1371     y1 := -y1;
1372     wy0 := -wy0;
1373     wy1 := -wy1;
1374     swapInt(wy0, wy1);
1375   end;
1376
1377   dsx := x1-x0;
1378   dsy := y1-y0;
1379
1380   if (dsx < dsy) then
1381   begin
1382     xptr := @yd;
1383     yptr := @xd;
1384     swapInt(x0, y0);
1385     swapInt(x1, y1);
1386     swapInt(dsx, dsy);
1387     swapInt(wx0, wy0);
1388     swapInt(wx1, wy1);
1389     swapInt(stx, sty);
1390   end
1391   else
1392   begin
1393     xptr := @xd;
1394     yptr := @yd;
1395   end;
1396
1397   dx2 := 2*dsx;
1398   dy2 := 2*dsy;
1399   xd := x0;
1400   yd := y0;
1401   e := 2*dsy-dsx;
1402   term := x1;
1403
1404   xfixed := false;
1405   if (y0 < wy0) then
1406   begin
1407     // clip at top
1408     temp := dx2*(wy0-y0)-dsx;
1409     xd += temp div dy2;
1410     rem := temp mod dy2;
1411     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1412     if (xd+1 >= wx0) then
1413     begin
1414       yd := wy0;
1415       e -= rem+dsx;
1416       if (rem > 0) then begin Inc(xd); e += dy2; end;
1417       xfixed := true;
1418     end;
1419   end;
1420
1421   if (not xfixed) and (x0 < wx0) then
1422   begin
1423     // clip at left
1424     temp := dy2*(wx0-x0);
1425     yd += temp div dx2;
1426     rem := temp mod dx2;
1427     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1428     xd := wx0;
1429     e += rem;
1430     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1431   end;
1432
1433   if (y1 > wy1) then
1434   begin
1435     // clip at bottom
1436     temp := dx2*(wy1-y0)+dsx;
1437     term := x0+temp div dy2;
1438     rem := temp mod dy2;
1439     if (rem = 0) then Dec(term);
1440   end;
1441
1442   if (term > wx1) then term := wx1; // clip at right
1443
1444   Inc(term); // draw last point
1445   //if (term = xd) then exit; // this is the only point, get out of here
1446
1447   if (sty = -1) then yd := -yd;
1448   if (stx = -1) then begin xd := -xd; term := -term; end;
1449   dx2 -= dy2;
1450
1451   // first move, to skip starting point
1452   // DON'T DO THIS! loop will take care of that
1453   if (xd = term) then
1454   begin
1455     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1456     if (result <> nil) then
1457     begin
1458       if assigned(cb) then
1459       begin
1460         if cb(result, ptag, ax0, ay0, ax0, ay0) then
1461         begin
1462           ex := ax0;
1463           ey := ay0;
1464         end
1465         else
1466         begin
1467           result := nil;
1468         end;
1469       end
1470       else
1471       begin
1472         ex := ax0;
1473         ey := ay0;
1474       end;
1475     end;
1476     exit;
1477   end;
1478
1479   prevx := xptr^+minx;
1480   prevy := yptr^+miny;
1481   (*
1482   // move coords
1483   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1484   xd += stx;
1485   // done?
1486   if (xd = term) then exit;
1487   *)
1488
1489   {$IF DEFINED(D2F_DEBUG)}
1490   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1491   {$ENDIF}
1492   // DON'T DO THIS! loop will take care of that
1493   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1494   //ccidx := mGrid[lastGA];
1495
1496   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1497   //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1498   {$ENDIF}
1499
1500   //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1501
1502   // increase query counter
1503   Inc(mLastQuery);
1504   if (mLastQuery = 0) then
1505   begin
1506     // just in case of overflow
1507     mLastQuery := 1;
1508     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1509   end;
1510   lq := mLastQuery;
1511
1512   // if this is strict horizontal/vertical trace, use optimized codepath
1513   if (ay0 = ay1) then
1514   begin
1515     //if dbgShowTraceLog then e_LogWritefln('!!!', []);
1516     // horizontal trace
1517     // for horizontal traces, we'll walk the whole tiles, calculating mindist once for each proxy in cell
1518     // one step:
1519     // while (xd <> term) do
1520     //   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1521     //   xd += stx;
1522     if (stx < 0) then wklen := -(term-xd) else wklen := term-xd;
1523     {$IF DEFINED(D2F_DEBUG)}
1524     if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
1525     {$ENDIF}
1526     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1527     y := yptr^+miny; // it will never change
1528     {$IF DEFINED(D2F_DEBUG)}
1529     if (y <> ay0) then raise Exception.Create('htrace fatal internal error');
1530     {$ENDIF}
1531     while (wklen > 0) do
1532     begin
1533       {$IF DEFINED(D2F_DEBUG)}
1534       if dbgShowTraceLog then e_LogWritefln('  htrace; ga=%d; x=%d; y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1535       {$ENDIF}
1536       // new tile?
1537       if (ga <> lastGA) then
1538       begin
1539         lastGA := ga;
1540         ccidx := mGrid[lastGA];
1541         // convert coords to map (to avoid ajdusting coords inside the loop)
1542         x := xptr^+minx;
1543         while (ccidx <> -1) do
1544         begin
1545           cc := @mCells[ccidx];
1546           for f := 0 to GridCellBucketSize-1 do
1547           begin
1548             if (cc.bodies[f] = -1) then break;
1549             px := @mProxies[cc.bodies[f]];
1550             ptag := px.mTag;
1551             if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
1552                (y >= px.mY) and (y < px.mY+px.mHeight) then // y should be inside
1553             begin
1554               px.mQueryMark := lq; // mark as processed
1555               // inside the proxy; something that should not be
1556               if (x > px.mX) and (x < px.mX+px.mWidth-1) then
1557               begin
1558                 //raise Exception.Create('abosultely impossible embedding in htrace');
1559                 if assigned(cb) then
1560                 begin
1561                   if cb(px.mObj, ptag, x, y, x, y) then
1562                   begin
1563                     result := lastObj;
1564                     ex := prevx;
1565                     ey := prevy;
1566                     exit;
1567                   end;
1568                 end
1569                 else
1570                 begin
1571                   distSq := distanceSq(ax0, ay0, x, y);
1572                   {$IF DEFINED(D2F_DEBUG)}
1573                   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]);
1574                   {$ENDIF}
1575                   if (distSq < lastDistSq) then
1576                   begin
1577                     ex := x;
1578                     ey := y;
1579                     result := px.mObj;
1580                     exit;
1581                   end;
1582                 end;
1583                 continue;
1584               end;
1585               // remember this hitpoint if it is nearer than an old one
1586               if (stx < 0) then wkpos := px.mX+px.mWidth else wkpos := px.mX-1;
1587               if assigned(cb) then
1588               begin
1589                 if (stx < 0) then x := wkpos+1 else x := wkpos-1;
1590                 if cb(px.mObj, ptag, x, y, wkpos, y) then
1591                 begin
1592                   result := lastObj;
1593                   ex := prevx;
1594                   ey := prevy;
1595                   exit;
1596                 end;
1597               end
1598               else
1599               begin
1600                 distSq := distanceSq(ax0, ay0, wkpos, y);
1601                 {$IF DEFINED(D2F_DEBUG)}
1602                 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, wkpos, y, distSq, lastDistSq]);
1603                 {$ENDIF}
1604                 if (distSq < lastDistSq) then
1605                 begin
1606                   wasHit := true;
1607                   lastDistSq := distSq;
1608                   ex := wkpos;
1609                   ey := y;
1610                   lastObj := px.mObj;
1611                 end;
1612               end;
1613             end;
1614           end;
1615           // next cell
1616           ccidx := cc.next;
1617         end;
1618         if wasHit and not assigned(cb) then begin result := lastObj; exit; end;
1619       end;
1620       // skip to next tile
1621       if (ax0 < ax1) then
1622       begin
1623         // to the right
1624         wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
1625         {$IF DEFINED(D2F_DEBUG)}
1626         if dbgShowTraceLog then e_LogWritefln('  right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1627         {$ENDIF}
1628         if (wkstep >= wklen) then break;
1629         Inc(xptr^, wkstep);
1630         Inc(ga);
1631       end
1632       else
1633       begin
1634         // to the left
1635         wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
1636         {$IF DEFINED(D2F_DEBUG)}
1637         if dbgShowTraceLog then e_LogWritefln('  left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1638         {$ENDIF}
1639         if (wkstep >= wklen) then break;
1640         Dec(xptr^, wkstep);
1641         Dec(ga);
1642       end;
1643     end;
1644     // we can travel less than one cell
1645     if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
1646     exit;
1647   end;
1648
1649   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1650   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1651   {$ENDIF}
1652
1653   ccidx := -1;
1654   //  can omit checks
1655   while (xd <> term) do
1656   begin
1657     // check cell(s)
1658     {$IF DEFINED(D2F_DEBUG)}
1659     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1660     {$ENDIF}
1661     // new tile?
1662     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1663     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1664     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);
1665     {$ENDIF}
1666     if (ga <> lastGA) then
1667     begin
1668       // yes
1669       {$IF DEFINED(D2F_DEBUG)}
1670       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1671       {$ENDIF}
1672       if (ccidx <> -1) then
1673       begin
1674         // signal cell completion
1675         if assigned(cb) then
1676         begin
1677           if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; exit; end;
1678         end
1679         else if wasHit then
1680         begin
1681           result := lastObj;
1682           exit;
1683         end;
1684       end;
1685       lastGA := ga;
1686       ccidx := mGrid[lastGA];
1687     end;
1688     // has something to process in this tile?
1689     if (ccidx <> -1) then
1690     begin
1691       // process cell
1692       curci := ccidx;
1693       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1694       // convert coords to map (to avoid ajdusting coords inside the loop)
1695       x := xptr^+minx;
1696       y := yptr^+miny;
1697       // process cell list
1698       while (curci <> -1) do
1699       begin
1700         cc := @mCells[curci];
1701         for f := 0 to GridCellBucketSize-1 do
1702         begin
1703           if (cc.bodies[f] = -1) then break;
1704           px := @mProxies[cc.bodies[f]];
1705           ptag := px.mTag;
1706           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1707           begin
1708             // can we process this proxy?
1709             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1710             begin
1711               px.mQueryMark := lq; // mark as processed
1712               if assigned(cb) then
1713               begin
1714                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1715                 begin
1716                   result := lastObj;
1717                   ex := prevx;
1718                   ey := prevy;
1719                   exit;
1720                 end;
1721                 (*
1722                   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1723                   distSq := distanceSq(ax0, ay0, prevx, prevy);
1724                   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);
1725                   if (distSq < lastDistSq) then
1726                   begin
1727                     wasHit := true;
1728                     lastDistSq := distSq;
1729                     ex := prevx;
1730                     ey := prevy;
1731                     lastObj := px.mObj;
1732                   end;
1733                   {$ENDIF}
1734                 *)
1735               end
1736               else
1737               begin
1738                 // remember this hitpoint if it is nearer than an old one
1739                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1740                 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1741                 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);
1742                 {$ENDIF}
1743                 if (distSq < lastDistSq) then
1744                 begin
1745                   wasHit := true;
1746                   lastDistSq := distSq;
1747                   ex := prevx;
1748                   ey := prevy;
1749                   lastObj := px.mObj;
1750                 end;
1751               end;
1752             end
1753             else
1754             begin
1755               // this is possibly interesting proxy, set "has more to check" flag
1756               hasUntried := true;
1757             end;
1758           end;
1759         end;
1760         // next cell
1761         curci := cc.next;
1762       end;
1763       // still has something interesting in this cell?
1764       if not hasUntried then
1765       begin
1766         // nope, don't process this cell anymore; signal cell completion
1767         ccidx := -1;
1768         if assigned(cb) then
1769         begin
1770           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
1771         end
1772         else if wasHit then
1773         begin
1774           result := lastObj;
1775           exit;
1776         end;
1777       end;
1778     end;
1779     //putPixel(xptr^, yptr^);
1780     // move coords
1781     prevx := xptr^+minx;
1782     prevy := yptr^+miny;
1783     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1784     xd += stx;
1785   end;
1786   // we can travel less than one cell
1787   if wasHit and not assigned(cb) then
1788   begin
1789     result := lastObj;
1790   end
1791   else
1792   begin
1793     ex := ax1; // why not?
1794     ey := ay1; // why not?
1795   end;
1796 end;
1797
1798
1799 // ////////////////////////////////////////////////////////////////////////// //
1800 //FIXME! optimize this with real tile walking
1801 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1802 const
1803   tsize = mTileSize;
1804 var
1805   i: Integer;
1806   dx, dy, d: Integer;
1807   xerr, yerr: Integer;
1808   incx, incy: Integer;
1809   stepx, stepy: Integer;
1810   x, y: Integer;
1811   maxx, maxy: Integer;
1812   gw, gh: Integer;
1813   ccidx: Integer;
1814   curci: Integer;
1815   cc: PGridCell;
1816   px: PBodyProxyRec;
1817   lq: LongWord;
1818   minx, miny: Integer;
1819   ptag: Integer;
1820   lastWasInGrid: Boolean;
1821   tbcross: Boolean;
1822   f: Integer;
1823   //tedist: Integer;
1824 begin
1825   log := false;
1826   result := Default(ITP);
1827   tagmask := tagmask and TagFullMask;
1828   if (tagmask = 0) or not assigned(cb) then exit;
1829
1830   minx := mMinX;
1831   miny := mMinY;
1832
1833   dx := x1-x0;
1834   dy := y1-y0;
1835
1836   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1837   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1838
1839   if (incx = 0) and (incy = 0) then exit; // just incase
1840
1841   dx := abs(dx);
1842   dy := abs(dy);
1843
1844   if (dx > dy) then d := dx else d := dy;
1845
1846   // `x` and `y` will be in grid coords
1847   x := x0-minx;
1848   y := y0-miny;
1849
1850   // increase query counter
1851   Inc(mLastQuery);
1852   if (mLastQuery = 0) then
1853   begin
1854     // just in case of overflow
1855     mLastQuery := 1;
1856     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1857   end;
1858   lq := mLastQuery;
1859
1860   // cache various things
1861   //tsize := mTileSize;
1862   gw := mWidth;
1863   gh := mHeight;
1864   maxx := gw*tsize-1;
1865   maxy := gh*tsize-1;
1866
1867   // setup distance and flags
1868   lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1869
1870   // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1871   if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1872
1873   // it is slightly faster this way
1874   xerr := -d;
1875   yerr := -d;
1876
1877   if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1878
1879   // now trace
1880   i := 0;
1881   while (i < d) do
1882   begin
1883     Inc(i);
1884     // do one step
1885     xerr += dx;
1886     yerr += dy;
1887     // invariant: one of those always changed
1888     {$IF DEFINED(D2F_DEBUG)}
1889     if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1890     {$ENDIF}
1891     if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1892     if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1893     // invariant: we always doing a step
1894     {$IF DEFINED(D2F_DEBUG)}
1895     if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1896     {$ENDIF}
1897     begin
1898       // check for crossing tile/grid boundary
1899       if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1900       begin
1901         // we're still in grid
1902         lastWasInGrid := true;
1903         // check for tile edge crossing
1904              if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1905         else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1906         else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1907         else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1908         else tbcross := false;
1909         // crossed tile edge?
1910         if tbcross then
1911         begin
1912           // setup new cell index
1913           ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1914           if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1915         end
1916         else
1917         if (ccidx = -1) then
1918         begin
1919           // we have nothing interesting here anymore, jump directly to tile edge
1920           (*
1921           if (incx = 0) then
1922           begin
1923             // vertical line
1924             if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1925             if (tedist > 1) then
1926             begin
1927               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);
1928               y += incy*tedist;
1929               Inc(i, tedist);
1930               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);
1931             end;
1932           end
1933           else if (incy = 0) then
1934           begin
1935             // horizontal line
1936             if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1937             if (tedist > 1) then
1938             begin
1939               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);
1940               x += incx*tedist;
1941               Inc(i, tedist);
1942               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);
1943             end;
1944           end;
1945           *)
1946           (*
1947            else if (
1948           // get minimal distance to tile edges
1949           if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1950           {$IF DEFINED(D2F_DEBUG)}
1951           if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1952           {$ENDIF}
1953           if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1954           {$IF DEFINED(D2F_DEBUG)}
1955           if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1956           {$ENDIF}
1957           if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1958           // do jump
1959           if (tedist > 1) then
1960           begin
1961             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);
1962             xerr += dx*tedist;
1963             yerr += dy*tedist;
1964             if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1965             if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1966             Inc(i, tedist);
1967             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);
1968           end;
1969           *)
1970         end;
1971       end
1972       else
1973       begin
1974         // out of grid
1975         if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1976       end;
1977     end;
1978
1979     // has something to process in the current cell?
1980     if (ccidx <> -1) then
1981     begin
1982       // process cell
1983       curci := ccidx;
1984       // convert coords to map (to avoid ajdusting coords inside the loop)
1985       //Inc(x, minx);
1986       //Inc(y, miny);
1987       // process cell list
1988       while (curci <> -1) do
1989       begin
1990         cc := @mCells[curci];
1991         for f := 0 to GridCellBucketSize-1 do
1992         begin
1993           if (cc.bodies[f] = -1) then break;
1994           px := @mProxies[cc.bodies[f]];
1995           ptag := px.mTag;
1996           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1997           begin
1998             px.mQueryMark := lq; // mark as processed
1999             if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
2000           end;
2001         end;
2002         // next cell
2003         curci := cc.next;
2004       end;
2005       ccidx := -1; // don't process this anymore
2006       // convert coords to grid
2007       //Dec(x, minx);
2008       //Dec(y, miny);
2009     end;
2010   end;
2011 end;
2012
2013
2014 // ////////////////////////////////////////////////////////////////////////// //
2015 (*
2016 function TBodyGridBase.traceRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
2017 var
2018   ex, ey: Integer;
2019 begin
2020   result := traceRayWhileIn(ex, ey, x0, y0, x1, y1, tagmask);
2021 end;
2022
2023
2024 // FUCKIN' PASTA!
2025 function TBodyGridBase.traceRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
2026 const
2027   tsize = mTileSize;
2028 var
2029   wx0, wy0, wx1, wy1: Integer; // window coordinates
2030   stx, sty: Integer; // "steps" for x and y axes
2031   dsx, dsy: Integer; // "lengthes" for x and y axes
2032   dx2, dy2: Integer; // "double lengthes" for x and y axes
2033   xd, yd: Integer; // current coord
2034   e: Integer; // "error" (as in bresenham algo)
2035   rem: Integer;
2036   term: Integer;
2037   xptr, yptr: PInteger;
2038   xfixed: Boolean;
2039   temp: Integer;
2040   prevx, prevy: Integer;
2041   lastDistSq: Integer;
2042   ccidx, curci: Integer;
2043   hasUntried: Boolean;
2044   lastGA: Integer = -1;
2045   ga, x, y: Integer;
2046   lastObj: ITP;
2047   wasHit: Boolean = false;
2048   gw, gh, minx, miny, maxx, maxy: Integer;
2049   cc: PGridCell;
2050   px: PBodyProxyRec;
2051   lq: LongWord;
2052   f, ptag, distSq: Integer;
2053   x0, y0, x1, y1: Integer;
2054   inx, iny: Integer;
2055 begin
2056   result := Default(ITP);
2057   lastObj := Default(ITP);
2058   tagmask := tagmask and TagFullMask;
2059   ex := ax1; // why not?
2060   ey := ay1; // why not?
2061   if (tagmask = 0) then exit;
2062
2063   if (ax0 = ax1) and (ay0 = ay1) then exit; // doesn't matter
2064
2065   // we should start inside
2066   if (forEachAtPoint(ax0, ay0, nil, tagmask, @ptag) = nil) then
2067   begin
2068     ex := ax0; // why not?
2069     ey := ay0; // why not?
2070     exit;
2071   end;
2072
2073   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
2074
2075   gw := mWidth;
2076   gh := mHeight;
2077   minx := mMinX;
2078   miny := mMinY;
2079   maxx := gw*tsize-1;
2080   maxy := gh*tsize-1;
2081
2082   x0 := ax0;
2083   y0 := ay0;
2084   x1 := ax1;
2085   y1 := ay1;
2086
2087   // offset query coords to (0,0)-based
2088   Dec(x0, minx);
2089   Dec(y0, miny);
2090   Dec(x1, minx);
2091   Dec(y1, miny);
2092
2093   // clip rectange
2094   wx0 := 0;
2095   wy0 := 0;
2096   wx1 := maxx;
2097   wy1 := maxy;
2098
2099   // horizontal setup
2100   if (x0 < x1) then
2101   begin
2102     // from left to right
2103     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2104     stx := 1; // going right
2105   end
2106   else
2107   begin
2108     // from right to left
2109     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2110     stx := -1; // going left
2111     x0 := -x0;
2112     x1 := -x1;
2113     wx0 := -wx0;
2114     wx1 := -wx1;
2115     swapInt(wx0, wx1);
2116   end;
2117
2118   // vertical setup
2119   if (y0 < y1) then
2120   begin
2121     // from top to bottom
2122     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2123     sty := 1; // going down
2124   end
2125   else
2126   begin
2127     // from bottom to top
2128     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2129     sty := -1; // going up
2130     y0 := -y0;
2131     y1 := -y1;
2132     wy0 := -wy0;
2133     wy1 := -wy1;
2134     swapInt(wy0, wy1);
2135   end;
2136
2137   dsx := x1-x0;
2138   dsy := y1-y0;
2139
2140   if (dsx < dsy) then
2141   begin
2142     xptr := @yd;
2143     yptr := @xd;
2144     swapInt(x0, y0);
2145     swapInt(x1, y1);
2146     swapInt(dsx, dsy);
2147     swapInt(wx0, wy0);
2148     swapInt(wx1, wy1);
2149     swapInt(stx, sty);
2150   end
2151   else
2152   begin
2153     xptr := @xd;
2154     yptr := @yd;
2155   end;
2156
2157   dx2 := 2*dsx;
2158   dy2 := 2*dsy;
2159   xd := x0;
2160   yd := y0;
2161   e := 2*dsy-dsx;
2162   term := x1;
2163
2164   xfixed := false;
2165   if (y0 < wy0) then
2166   begin
2167     // clip at top
2168     temp := dx2*(wy0-y0)-dsx;
2169     xd += temp div dy2;
2170     rem := temp mod dy2;
2171     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2172     if (xd+1 >= wx0) then
2173     begin
2174       yd := wy0;
2175       e -= rem+dsx;
2176       if (rem > 0) then begin Inc(xd); e += dy2; end;
2177       xfixed := true;
2178     end;
2179   end;
2180
2181   if (not xfixed) and (x0 < wx0) then
2182   begin
2183     // clip at left
2184     temp := dy2*(wx0-x0);
2185     yd += temp div dx2;
2186     rem := temp mod dx2;
2187     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2188     xd := wx0;
2189     e += rem;
2190     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2191   end;
2192
2193   if (y1 > wy1) then
2194   begin
2195     // clip at bottom
2196     temp := dx2*(wy1-y0)+dsx;
2197     term := x0+temp div dy2;
2198     rem := temp mod dy2;
2199     if (rem = 0) then Dec(term);
2200   end;
2201
2202   if (term > wx1) then term := wx1; // clip at right
2203
2204   Inc(term); // draw last point
2205   //if (term = xd) then exit; // this is the only point, get out of here
2206
2207   if (sty = -1) then yd := -yd;
2208   if (stx = -1) then begin xd := -xd; term := -term; end;
2209   dx2 -= dy2;
2210
2211   // first move, to skip starting point
2212   // DON'T DO THIS! loop will take care of that
2213   if (xd = term) then
2214   begin
2215     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2216     if (result <> nil) and ((ptag and tagmask) <> 0) then result := nil;
2217     exit;
2218   end;
2219
2220   prevx := xptr^+minx;
2221   prevy := yptr^+miny;
2222
2223   // increase query counter
2224   Inc(mLastQuery);
2225   if (mLastQuery = 0) then
2226   begin
2227     // just in case of overflow
2228     mLastQuery := 1;
2229     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2230   end;
2231   lq := mLastQuery;
2232
2233   ccidx := -1;
2234   // draw it; can omit checks
2235   while (xd <> term) do
2236   begin
2237     // check cell(s)
2238     // new tile?
2239     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2240     if (ga <> lastGA) then
2241     begin
2242       // yes
2243       lastGA := ga;
2244       ccidx := mGrid[lastGA];
2245       // no objects in cell == exit
2246       if (ccidx = -1) then exit;
2247     end;
2248     // has something to process in this tile?
2249     if (ccidx <> -1) then
2250     begin
2251       // process cell
2252       curci := ccidx;
2253       // convert coords to map (to avoid ajdusting coords inside the loop)
2254       x := xptr^+minx;
2255       y := yptr^+miny;
2256       wasHit := false;
2257       // process cell list
2258       while (curci <> -1) do
2259       begin
2260         cc := @mCells[curci];
2261         for f := 0 to GridCellBucketSize-1 do
2262         begin
2263           if (cc.bodies[f] = -1) then break;
2264           px := @mProxies[cc.bodies[f]];
2265           ptag := px.mTag;
2266           if ((ptag and TagDisabled) = 0) and (px.mQueryMark <> lq) then
2267           begin
2268 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
2269             // can we process this proxy?
2270             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2271             begin
2272               px.mQueryMark := lq; // mark as processed
2273               if ((ptag and tagmask) = 0) then
2274               begin
2275                 result := px.mObj;
2276                 ex := x;
2277                 ey := y;
2278                 exit;
2279               end;
2280               // march out of the panel/cell
2281               while (xd <> term) do
2282               begin
2283                 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2284                 xd += stx;
2285                 // new cell?
2286                 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2287                 if (ga <> lastGA) then break;
2288                 // out of panel?
2289                 if not ((x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight)) then break;
2290               end;
2291             end;
2292           end;
2293         end;
2294         // next cell
2295         curci := cc.next;
2296       end;
2297       // still has something interesting in this cell?
2298       if not hasUntried then
2299       begin
2300         // nope, don't process this cell anymore; signal cell completion
2301         ccidx := -1;
2302         if assigned(cb) then
2303         begin
2304           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
2305         end
2306         else if wasHit then
2307         begin
2308           result := lastObj;
2309           exit;
2310         end;
2311       end;
2312     end;
2313     //putPixel(xptr^, yptr^);
2314     // move coords
2315     prevx := xptr^+minx;
2316     prevy := yptr^+miny;
2317     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2318     xd += stx;
2319   end;
2320   // we can travel less than one cell
2321   if wasHit and not assigned(cb) then
2322   begin
2323     result := lastObj;
2324   end
2325   else
2326   begin
2327     ex := ax1; // why not?
2328     ey := ay1; // why not?
2329   end;
2330 end;
2331 *)
2332
2333
2334 end.