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