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