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