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