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