src/game/g_grid.pas

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