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