src/game/g_grid.pas

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