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