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