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