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