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