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