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