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   {.$DEFINE D2F_DEBUG_XXQ}
  21   {.$DEFINE D2F_DEBUG_MOVER}
  22 {$ENDIF}
  23 {$DEFINE GRID_USE_ORTHO_ACCEL}
  24 unit g_grid;
  25
  26 interface
  27
  28
  29 type
  30   TBodyProxyId = Integer;
  31
  32   generic TBodyGridBase<ITP> = class(TObject)
  33   public
  34     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  35     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
  36
  37     type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
  38
  39     const TagDisabled = $40000000;
  40     const TagFullMask = $3fffffff;
  41
  42   private
  43     const
  44       GridDefaultTileSize = 32; // must be power of two!
  45       GridCellBucketSize = 8; // WARNING! can't be less than 2!
  46
  47   public
  48     type
  49       PBodyProxyRec = ^TBodyProxyRec;
  50       TBodyProxyRec = record
  51       private
  52         mX, mY, mWidth, mHeight: Integer; // aabb
  53         mQueryMark: LongWord; // was this object visited at this query?
  54         mObj: ITP;
  55         mTag: Integer; // `TagDisabled` set: disabled ;-)
  56         nextLink: TBodyProxyId; // next free or nothing
  57
  58       private
  59         procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
  60
  61         function getTag (): Integer; inline;
  62         procedure setTag (v: Integer); inline;
  63
  64         function getEnabled (): Boolean; inline;
  65         procedure setEnabled (v: Boolean); inline;
  66
  67       public
  68         property x: Integer read mX;
  69         property y: Integer read mY;
  70         property width: Integer read mWidth;
  71         property height: Integer read mHeight;
  72         property tag: Integer read getTag write setTag;
  73         property enabled: Boolean read getEnabled write setEnabled;
  74         property obj: ITP read mObj;
  75       end;
  76
  77   private
  78     type
  79       PGridCell = ^TGridCell;
  80       TGridCell = record
  81         bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  82         next: Integer; // in this cell; index in mCells
  83       end;
  84
  85       TCellArray = array of TGridCell;
  86
  87       TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
  88
  89   private
  90     //mTileSize: Integer;
  91     const mTileSize = GridDefaultTileSize;
  92     type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
  93
  94   public
  95     const tileSize = mTileSize;
  96
  97     type
  98       TAtPointEnumerator = record
  99       private
 100         mCells: TCellArray;
 101         curidx, curbki: Integer;
 102         getpx: TGetProxyFn;
 103       public
 104         constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
 105         function MoveNext (): Boolean; inline;
 106         function getCurrent (): PBodyProxyRec; inline;
 107         property Current: PBodyProxyRec read getCurrent;
 108       end;
 109
 110   private
 111     mMinX, mMinY: Integer; // so grids can start at any origin
 112     mWidth, mHeight: Integer; // in tiles
 113     mGrid: array of Integer; // mWidth*mHeight, index in mCells
 114     mCells: TCellArray; // cell pool
 115     mFreeCell: Integer; // first free cell index or -1
 116     mLastQuery: LongWord;
 117     mUsedCells: Integer;
 118     mProxies: array of TBodyProxyRec;
 119     mProxyFree: TBodyProxyId; // free
 120     mProxyCount: Integer; // currently used
 121     mProxyMaxCount: Integer;
 122     mInQuery: Boolean;
 123
 124   public
 125     dbgShowTraceLog: Boolean;
 126     {$IF DEFINED(D2F_DEBUG)}
 127     dbgRayTraceTileHitCB: TCellQueryCB;
 128     {$ENDIF}
 129
 130   private
 131     function allocCell (): Integer;
 132     procedure freeCell (idx: Integer); // `next` is simply overwritten
 133
 134     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 135     procedure freeProxy (body: TBodyProxyId);
 136
 137     procedure insertInternal (body: TBodyProxyId);
 138     procedure removeInternal (body: TBodyProxyId);
 139
 140     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 141
 142     function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 143     function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 144
 145     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 146     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 147
 148     function getGridWidthPx (): Integer; inline;
 149     function getGridHeightPx (): Integer; inline;
 150
 151     function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
 152
 153   public
 154     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 155     destructor Destroy (); override;
 156
 157     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 158     procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
 159
 160     procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
 161     procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
 162     procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
 163
 164     function insideGrid (x, y: Integer): Boolean; inline;
 165
 166     // `false` if `body` is surely invalid
 167     function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 168     function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 169     function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 170
 171     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 172     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 173     // no callback: return `true` on the first hit
 174     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
 175
 176     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 177     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 178     // no callback: return object on the first hit or nil
 179     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
 180
 181     function atPoint (x, y: Integer): TAtPointEnumerator;
 182
 183     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 184     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 185     // cb with `(nil)` will be called before processing new tile
 186     // no callback: return object of the nearest hit or nil
 187     // if `inverted` is true, trace will register bodies *exluding* tagmask
 188     //WARNING: don't change tags in callbacks here!
 189     function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
 190     function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
 191
 192     //function traceOrthoRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
 193     //function traceOrthoRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
 194
 195     //WARNING: don't modify grid while any query is in progress (no checks are made!)
 196     //         you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
 197     // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
 198     //WARNING: don't change tags in callbacks here!
 199     function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
 200
 201     // debug
 202     procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 203     function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 204     procedure dumpStats ();
 205
 206   public
 207     //WARNING! no sanity checks!
 208     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 209
 210     property gridX0: Integer read mMinX;
 211     property gridY0: Integer read mMinY;
 212     property gridWidth: Integer read getGridWidthPx; // in pixels
 213     property gridHeight: Integer read getGridHeightPx; // in pixels
 214
 215     property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
 216   end;
 217
 218
 219 // you are not supposed to understand this
 220 // returns `true` if there is an intersection, and enter coords
 221 // enter coords will be equal to (x0, y0) if starting point is inside the box
 222 // if result is `false`, `inx` and `iny` are undefined
 223 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 224
 225 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
 226
 227 procedure swapInt (var a: Integer; var b: Integer); inline;
 228 function minInt (a, b: Integer): Integer; inline;
 229 function maxInt (a, b: Integer): Integer; inline;
 230
 231
 232 implementation
 233
 234 uses
 235   SysUtils, e_log, g_console;
 236
 237
 238 // ////////////////////////////////////////////////////////////////////////// //
 239 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
 240 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
 241 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
 242
 243 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
 244
 245
 246 // ////////////////////////////////////////////////////////////////////////// //
 247 // you are not supposed to understand this
 248 // returns `true` if there is an intersection, and enter coords
 249 // enter coords will be equal to (x0, y0) if starting point is inside the box
 250 // if result is `false`, `inx` and `iny` are undefined
 251 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
 252 var
 253   wx0, wy0, wx1, wy1: Integer; // window coordinates
 254   stx, sty: Integer; // "steps" for x and y axes
 255   dsx, dsy: Integer; // "lengthes" for x and y axes
 256   dx2, dy2: Integer; // "double lengthes" for x and y axes
 257   xd, yd: Integer; // current coord
 258   e: Integer; // "error" (as in bresenham algo)
 259   rem: Integer;
 260   //!term: Integer;
 261   d0, d1: PInteger;
 262   xfixed: Boolean;
 263   temp: Integer;
 264 begin
 265   result := false;
 266   // why not
 267   inx := x0;
 268   iny := y0;
 269   if (bw < 1) or (bh < 1) then exit; // impossible box
 270
 271   if (x0 = x1) and (y0 = y1) then
 272   begin
 273     // check this point
 274     result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
 275     exit;
 276   end;
 277
 278   // check if staring point is inside the box
 279   if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
 280
 281   // clip rectange
 282   wx0 := bx;
 283   wy0 := by;
 284   wx1 := bx+bw-1;
 285   wy1 := by+bh-1;
 286
 287   // horizontal setup
 288   if (x0 < x1) then
 289   begin
 290     // from left to right
 291     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
 292     stx := 1; // going right
 293   end
 294   else
 295   begin
 296     // from right to left
 297     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
 298     stx := -1; // going left
 299     x0 := -x0;
 300     x1 := -x1;
 301     wx0 := -wx0;
 302     wx1 := -wx1;
 303     swapInt(wx0, wx1);
 304   end;
 305
 306   // vertical setup
 307   if (y0 < y1) then
 308   begin
 309     // from top to bottom
 310     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
 311     sty := 1; // going down
 312   end
 313   else
 314   begin
 315     // from bottom to top
 316     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
 317     sty := -1; // going up
 318     y0 := -y0;
 319     y1 := -y1;
 320     wy0 := -wy0;
 321     wy1 := -wy1;
 322     swapInt(wy0, wy1);
 323   end;
 324
 325   dsx := x1-x0;
 326   dsy := y1-y0;
 327
 328   if (dsx < dsy) then
 329   begin
 330     d0 := @yd;
 331     d1 := @xd;
 332     swapInt(x0, y0);
 333     swapInt(x1, y1);
 334     swapInt(dsx, dsy);
 335     swapInt(wx0, wy0);
 336     swapInt(wx1, wy1);
 337     swapInt(stx, sty);
 338   end
 339   else
 340   begin
 341     d0 := @xd;
 342     d1 := @yd;
 343   end;
 344
 345   dx2 := 2*dsx;
 346   dy2 := 2*dsy;
 347   xd := x0;
 348   yd := y0;
 349   e := 2*dsy-dsx;
 350   //!term := x1;
 351
 352   xfixed := false;
 353   if (y0 < wy0) then
 354   begin
 355     // clip at top
 356     temp := dx2*(wy0-y0)-dsx;
 357     xd += temp div dy2;
 358     rem := temp mod dy2;
 359     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
 360     if (xd+1 >= wx0) then
 361     begin
 362       yd := wy0;
 363       e -= rem+dsx;
 364       if (rem > 0) then begin Inc(xd); e += dy2; end;
 365       xfixed := true;
 366     end;
 367   end;
 368
 369   if (not xfixed) and (x0 < wx0) then
 370   begin
 371     // clip at left
 372     temp := dy2*(wx0-x0);
 373     yd += temp div dx2;
 374     rem := temp mod dx2;
 375     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
 376     xd := wx0;
 377     e += rem;
 378     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
 379   end;
 380
 381   (*
 382   if (y1 > wy1) then
 383   begin
 384     // clip at bottom
 385     temp := dx2*(wy1-y0)+dsx;
 386     term := x0+temp div dy2;
 387     rem := temp mod dy2;
 388     if (rem = 0) then Dec(term);
 389   end;
 390
 391   if (term > wx1) then term := wx1; // clip at right
 392
 393   Inc(term); // draw last point
 394   //if (term = xd) then exit; // this is the only point, get out of here
 395   *)
 396
 397   if (sty = -1) then yd := -yd;
 398   if (stx = -1) then begin xd := -xd; {!term := -term;} end;
 399   //!dx2 -= dy2;
 400
 401   inx := d0^;
 402   iny := d1^;
 403   result := true;
 404 end;
 405
 406
 407 // ////////////////////////////////////////////////////////////////////////// //
 408 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 409 begin
 410   mX := aX;
 411   mY := aY;
 412   mWidth := aWidth;
 413   mHeight := aHeight;
 414   mQueryMark := 0;
 415   mObj := aObj;
 416   mTag := aTag;
 417   nextLink := -1;
 418 end;
 419
 420
 421 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
 422 begin
 423   result := mTag and TagFullMask;
 424 end;
 425
 426 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
 427 begin
 428   mTag := (mTag and TagDisabled) or (v and TagFullMask);
 429 end;
 430
 431 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
 432 begin
 433   result := ((mTag and TagDisabled) = 0);
 434 end;
 435
 436 procedure TBodyGridBase.TBodyProxyRec.setEnabled (v: Boolean); inline;
 437 begin
 438   if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled;
 439 end;
 440
 441
 442 // ////////////////////////////////////////////////////////////////////////// //
 443 constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
 444 begin
 445   mCells := acells;
 446   curidx := aidx;
 447   curbki := -1;
 448   getpx := agetpx;
 449 end;
 450
 451
 452 function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline;
 453 begin
 454   while (curidx <> -1) do
 455   begin
 456     while (curbki < GridCellBucketSize) do
 457     begin
 458       Inc(curbki);
 459       if (mCells[curidx].bodies[curbki] = -1) then break;
 460       result := true;
 461       exit;
 462     end;
 463     curidx := mCells[curidx].next;
 464     curbki := -1;
 465   end;
 466   result := false;
 467 end;
 468
 469
 470 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
 471 begin
 472   result := getpx(mCells[curidx].bodies[curbki]);
 473 end;
 474
 475
 476 // ////////////////////////////////////////////////////////////////////////// //
 477 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
 478 var
 479   idx: Integer;
 480 begin
 481   dbgShowTraceLog := false;
 482   {$IF DEFINED(D2F_DEBUG)}
 483   dbgRayTraceTileHitCB := nil;
 484   {$ENDIF}
 485   {
 486   if aTileSize < 1 then aTileSize := 1;
 487   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 488   mTileSize := aTileSize;
 489   }
 490   if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
 491   if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
 492   mMinX := aMinPixX;
 493   mMinY := aMinPixY;
 494   mWidth := (aPixWidth+mTileSize-1) div mTileSize;
 495   mHeight := (aPixHeight+mTileSize-1) div mTileSize;
 496   SetLength(mGrid, mWidth*mHeight);
 497   SetLength(mCells, mWidth*mHeight);
 498   SetLength(mProxies, 8192);
 499   mFreeCell := 0;
 500   // init free list
 501   for idx := 0 to High(mCells) do
 502   begin
 503     mCells[idx].bodies[0] := -1;
 504     mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
 505     mCells[idx].next := idx+1;
 506   end;
 507   mCells[High(mCells)].next := -1; // last cell
 508   // init grid
 509   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 510   // init proxies
 511   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 512   mProxies[High(mProxies)].nextLink := -1;
 513   mLastQuery := 0;
 514   mUsedCells := 0;
 515   mProxyFree := 0;
 516   mProxyCount := 0;
 517   mProxyMaxCount := 0;
 518   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 519 end;
 520
 521
 522 destructor TBodyGridBase.Destroy ();
 523 begin
 524   mCells := nil;
 525   mGrid := nil;
 526   mProxies := nil;
 527   inherited;
 528 end;
 529
 530
 531 // ////////////////////////////////////////////////////////////////////////// //
 532 procedure TBodyGridBase.dumpStats ();
 533 var
 534   idx, mcb, cidx, cnt: Integer;
 535 begin
 536   mcb := 0;
 537   for idx := 0 to High(mGrid) do
 538   begin
 539     cidx := mGrid[idx];
 540     cnt := 0;
 541     while cidx >= 0 do
 542     begin
 543       Inc(cnt);
 544       cidx := mCells[cidx].next;
 545     end;
 546     if (mcb < cnt) then mcb := cnt;
 547   end;
 548   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);
 549 end;
 550
 551
 552 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
 553 var
 554   g, f, cidx: Integer;
 555   cc: PGridCell;
 556 begin
 557   if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
 558   for g := 0 to High(mGrid) do
 559   begin
 560     cidx := mGrid[g];
 561     while (cidx <> -1) do
 562     begin
 563       cc := @mCells[cidx];
 564       for f := 0 to GridCellBucketSize-1 do
 565       begin
 566         if (cc.bodies[f] = -1) then break;
 567         if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
 568       end;
 569       // next cell
 570       cidx := cc.next;
 571     end;
 572   end;
 573 end;
 574
 575
 576 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
 577 var
 578   f, cidx: Integer;
 579   cc: PGridCell;
 580 begin
 581   result := Default(ITP);
 582   if not assigned(cb) then exit;
 583   Dec(x, mMinX);
 584   Dec(y, mMinY);
 585   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
 586   cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 587   while (cidx <> -1) do
 588   begin
 589     cc := @mCells[cidx];
 590     for f := 0 to GridCellBucketSize-1 do
 591     begin
 592       if (cc.bodies[f] = -1) then break;
 593       if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
 594     end;
 595     // next cell
 596     cidx := cc.next;
 597   end;
 598 end;
 599
 600
 601 // ////////////////////////////////////////////////////////////////////////// //
 602 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
 603 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
 604
 605
 606 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 607 begin
 608   // fix coords
 609   Dec(x, mMinX);
 610   Dec(y, mMinY);
 611   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 612 end;
 613
 614
 615 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
 616 begin
 617   if (body >= 0) and (body < Length(mProxies)) then
 618   begin
 619     with mProxies[body] do begin rx := mX; ry := mY; end;
 620     result := true;
 621   end
 622   else
 623   begin
 624     rx := 0;
 625     ry := 0;
 626     result := false;
 627   end;
 628 end;
 629
 630
 631 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
 632 begin
 633   if (body >= 0) and (body < Length(mProxies)) then
 634   begin
 635     with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
 636     result := true;
 637   end
 638   else
 639   begin
 640     rw := 0;
 641     rh := 0;
 642     result := false;
 643   end;
 644 end;
 645
 646
 647 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
 648 begin
 649   if (body >= 0) and (body < Length(mProxies)) then
 650   begin
 651     with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
 652     result := true;
 653   end
 654   else
 655   begin
 656     rx := 0;
 657     ry := 0;
 658     rw := 0;
 659     rh := 0;
 660     result := false;
 661   end;
 662 end;
 663
 664
 665
 666 // ////////////////////////////////////////////////////////////////////////// //
 667 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 668 begin
 669   if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 670 end;
 671
 672
 673 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 674 begin
 675   if (pid >= 0) then
 676   begin
 677     if val then
 678     begin
 679       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 680     end
 681     else
 682     begin
 683       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
 684     end;
 685   end;
 686 end;
 687
 688
 689 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
 690 begin
 691   if (idx >= 0) and (idx < High(mProxies)) then result := @mProxies[idx] else result := nil;
 692 end;
 693
 694
 695 // ////////////////////////////////////////////////////////////////////////// //
 696 function TBodyGridBase.allocCell (): Integer;
 697 var
 698   idx: Integer;
 699   pc: PGridCell;
 700 begin
 701   if (mFreeCell < 0) then
 702   begin
 703     // no free cells, want more
 704     mFreeCell := Length(mCells);
 705     SetLength(mCells, mFreeCell+32768); // arbitrary number
 706     for idx := mFreeCell to High(mCells) do
 707     begin
 708       mCells[idx].bodies[0] := -1;
 709       mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 710       mCells[idx].next := idx+1;
 711     end;
 712     mCells[High(mCells)].next := -1; // last cell
 713   end;
 714   result := mFreeCell;
 715   pc := @mCells[result];
 716   mFreeCell := pc.next;
 717   pc.next := -1;
 718   Inc(mUsedCells);
 719   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 720 end;
 721
 722
 723 procedure TBodyGridBase.freeCell (idx: Integer);
 724 begin
 725   if (idx >= 0) and (idx < Length(mCells)) then
 726   begin
 727     with mCells[idx] do
 728     begin
 729       bodies[0] := -1;
 730       bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
 731       next := mFreeCell;
 732     end;
 733     mFreeCell := idx;
 734     Dec(mUsedCells);
 735   end;
 736 end;
 737
 738
 739 // ////////////////////////////////////////////////////////////////////////// //
 740 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 741 var
 742   olen, idx: Integer;
 743   px: PBodyProxyRec;
 744 begin
 745   if (mProxyFree = -1) then
 746   begin
 747     // no free proxies, resize list
 748     olen := Length(mProxies);
 749     SetLength(mProxies, olen+8192); // arbitrary number
 750     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 751     mProxies[High(mProxies)].nextLink := -1;
 752     mProxyFree := olen;
 753   end;
 754   // get one from list
 755   result := mProxyFree;
 756   px := @mProxies[result];
 757   mProxyFree := px.nextLink;
 758   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 759   // add to used list
 760   px.nextLink := -1;
 761   // statistics
 762   Inc(mProxyCount);
 763   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 764 end;
 765
 766 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 767 begin
 768   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 769   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 770   // add to free list
 771   mProxies[body].mObj := nil;
 772   mProxies[body].nextLink := mProxyFree;
 773   mProxyFree := body;
 774   Dec(mProxyCount);
 775 end;
 776
 777
 778 // ////////////////////////////////////////////////////////////////////////// //
 779 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
 780 const
 781   tsize = mTileSize;
 782 var
 783   gx, gy: Integer;
 784   gw, gh: Integer;
 785 begin
 786   result := false;
 787   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 788   // fix coords
 789   Dec(x, mMinX);
 790   Dec(y, mMinY);
 791   // go on
 792   if (x+w <= 0) or (y+h <= 0) then exit;
 793   gw := mWidth;
 794   gh := mHeight;
 795   //tsize := mTileSize;
 796   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 797   for gy := y div tsize to (y+h-1) div tsize do
 798   begin
 799     if (gy < 0) then continue;
 800     if (gy >= gh) then break;
 801     for gx := x div tsize to (x+w-1) div tsize do
 802     begin
 803       if (gx < 0) then continue;
 804       if (gx >= gw) then break;
 805       result := cb(gy*gw+gx, bodyId);
 806       if result then exit;
 807     end;
 808   end;
 809 end;
 810
 811
 812 // ////////////////////////////////////////////////////////////////////////// //
 813 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
 814 var
 815   cidx: Integer;
 816   pc: Integer;
 817   pi: PGridCell;
 818   f: Integer;
 819 begin
 820   result := false; // never stop
 821   // add body to the given grid cell
 822   pc := mGrid[grida];
 823   if (pc <> -1) then
 824   begin
 825     {$IF DEFINED(D2F_DEBUG)}
 826     cidx := pc;
 827     while (cidx <> -1) do
 828     begin
 829       pi := @mCells[cidx];
 830       for f := 0 to GridCellBucketSize-1 do
 831       begin
 832         if (pi.bodies[f] = -1) then break;
 833         if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
 834       end;
 835       cidx := pi.next;
 836     end;
 837     {$ENDIF}
 838     cidx := pc;
 839     while (cidx <> -1) do
 840     begin
 841       pi := @mCells[cidx];
 842       // check "has room" flag
 843       if (pi.bodies[GridCellBucketSize-1] = -1) then
 844       begin
 845         // can add here
 846         for f := 0 to GridCellBucketSize-1 do
 847         begin
 848           if (pi.bodies[f] = -1) then
 849           begin
 850             pi.bodies[f] := bodyId;
 851             if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
 852             exit;
 853           end;
 854         end;
 855         raise Exception.Create('internal error in grid inserter');
 856       end;
 857       // no room, go to next cell in list (if there is any)
 858       cidx := pi.next;
 859     end;
 860     // no room in cells, add new cell to list
 861   end;
 862   // either no room, or no cell at all
 863   cidx := allocCell();
 864   pi := @mCells[cidx];
 865   pi.bodies[0] := bodyId;
 866   pi.bodies[1] := -1;
 867   pi.next := pc;
 868   mGrid[grida] := cidx;
 869 end;
 870
 871 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
 872 var
 873   px: PBodyProxyRec;
 874 begin
 875   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 876   px := @mProxies[body];
 877   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
 878 end;
 879
 880
 881 // assume that we cannot have one object added to bucket twice
 882 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
 883 var
 884   f, c: Integer;
 885   pidx, cidx: Integer;
 886   pc: PGridCell;
 887 begin
 888   result := false; // never stop
 889   // find and remove cell
 890   pidx := -1; // previous cell index
 891   cidx := mGrid[grida]; // current cell index
 892   while (cidx <> -1) do
 893   begin
 894     pc := @mCells[cidx];
 895     for f := 0 to GridCellBucketSize-1 do
 896     begin
 897       if (pc.bodies[f] = bodyId) then
 898       begin
 899         // i found her!
 900         if (f = 0) and (pc.bodies[1] = -1) then
 901         begin
 902           // this cell contains no elements, remove it
 903           if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
 904           freeCell(cidx);
 905           exit;
 906         end;
 907         // remove element from bucket
 908         for c := f to GridCellBucketSize-2 do
 909         begin
 910           pc.bodies[c] := pc.bodies[c+1];
 911           if (pc.bodies[c] = -1) then break;
 912         end;
 913         pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
 914         exit;
 915       end;
 916     end;
 917     pidx := cidx;
 918     cidx := pc.next;
 919   end;
 920 end;
 921
 922 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
 923 var
 924   px: PBodyProxyRec;
 925 begin
 926   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 927   px := @mProxies[body];
 928   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
 929 end;
 930
 931
 932 // ////////////////////////////////////////////////////////////////////////// //
 933 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
 934 begin
 935   aTag := aTag and TagFullMask;
 936   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 937   insertInternal(result);
 938 end;
 939
 940
 941 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
 942 begin
 943   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 944   removeInternal(body);
 945   freeProxy(body);
 946 end;
 947
 948
 949 // ////////////////////////////////////////////////////////////////////////// //
 950 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
 951 var
 952   px: PBodyProxyRec;
 953   x0, y0, w, h: Integer;
 954 begin
 955   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 956   px := @mProxies[body];
 957   x0 := px.mX;
 958   y0 := px.mY;
 959   w := px.mWidth;
 960   h := px.mHeight;
 961   {$IF DEFINED(D2F_DEBUG_MOVER)}
 962   e_WriteLog(Format('proxy #%d: MOVERESIZE: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d;nw=%d;nh=%d', [body, x0-mMinX, y0-mMinY, w, h, nx-mMinX, ny-mMinY, nw, nh]), MSG_NOTIFY);
 963   {$ENDIF}
 964   if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
 965   // map -> grid
 966   Dec(x0, mMinX);
 967   Dec(y0, mMinY);
 968   Dec(nx, mMinX);
 969   Dec(ny, mMinY);
 970   // did any corner crossed tile boundary?
 971   if (x0 div mTileSize <> nx div mTileSize) or
 972      (y0 div mTileSize <> ny div mTileSize) or
 973      ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
 974      ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
 975   begin
 976     removeInternal(body);
 977     px.mX := nx+mMinX;
 978     px.mY := ny+mMinY;
 979     px.mWidth := nw;
 980     px.mHeight := nh;
 981     insertInternal(body);
 982   end
 983   else
 984   begin
 985     px.mX := nx+mMinX;
 986     px.mY := ny+mMinY;
 987     px.mWidth := nw;
 988     px.mHeight := nh;
 989   end;
 990 end;
 991
 992 //TODO: optimize for horizontal/vertical moves
 993 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
 994 var
 995   px: PBodyProxyRec;
 996   x0, y0: Integer;
 997   ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
 998   ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
 999   gx, gy: Integer;
1000   gw, gh: Integer;
1001   pw, ph: Integer;
1002 begin
1003   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1004   // check if tile coords was changed
1005   px := @mProxies[body];
1006   x0 := px.mX;
1007   y0 := px.mY;
1008   if (nx = x0) and (ny = y0) then exit;
1009   // map -> grid
1010   Dec(x0, mMinX);
1011   Dec(y0, mMinY);
1012   Dec(nx, mMinX);
1013   Dec(ny, mMinY);
1014   // check for heavy work
1015   pw := px.mWidth;
1016   ph := px.mHeight;
1017   ogx0 := x0 div mTileSize;
1018   ogy0 := y0 div mTileSize;
1019   ngx0 := nx div mTileSize;
1020   ngy0 := ny div mTileSize;
1021   ogx1 := (x0+pw-1) div mTileSize;
1022   ogy1 := (y0+ph-1) div mTileSize;
1023   ngx1 := (nx+pw-1) div mTileSize;
1024   ngy1 := (ny+ph-1) div mTileSize;
1025   {$IF DEFINED(D2F_DEBUG_MOVER)}
1026   e_WriteLog(Format('proxy #%d: checkmove: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1027   {$ENDIF}
1028   if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1029   begin
1030     // crossed tile boundary, do heavy work
1031     gw := mWidth;
1032     gh := mHeight;
1033     // cycle with old rect, remove body where it is necessary
1034     // optimized for horizontal moves
1035     {$IF DEFINED(D2F_DEBUG_MOVER)}
1036     e_WriteLog(Format('proxy #%d: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1037     {$ENDIF}
1038     // remove stale marks
1039     if not ((ogy0 >= gh) or (ogy1 < 0)) and
1040        not ((ogx0 >= gw) or (ogx1 < 0)) then
1041     begin
1042       if (ogx0 < 0) then ogx0 := 0;
1043       if (ogy0 < 0) then ogy0 := 0;
1044       if (ogx1 > gw-1) then ogx1 := gw-1;
1045       if (ogy1 > gh-1) then ogy1 := gh-1;
1046       {$IF DEFINED(D2F_DEBUG_MOVER)}
1047       e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1048       {$ENDIF}
1049       for gx := ogx0 to ogx1 do
1050       begin
1051         if (gx < ngx0) or (gx > ngx1) then
1052         begin
1053           // this column is completely outside of new rect
1054           for gy := ogy0 to ogy1 do
1055           begin
1056             {$IF DEFINED(D2F_DEBUG_MOVER)}
1057             e_WriteLog(Format('  remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1058             {$ENDIF}
1059             remover(gy*gw+gx, body);
1060           end;
1061         end
1062         else
1063         begin
1064           // heavy checks
1065           for gy := ogy0 to ogy1 do
1066           begin
1067             if (gy < ngy0) or (gy > ngy1) then
1068             begin
1069               {$IF DEFINED(D2F_DEBUG_MOVER)}
1070               e_WriteLog(Format('  remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1071               {$ENDIF}
1072               remover(gy*gw+gx, body);
1073             end;
1074           end;
1075         end;
1076       end;
1077     end;
1078     // cycle with new rect, add body where it is necessary
1079     if not ((ngy0 >= gh) or (ngy1 < 0)) and
1080        not ((ngx0 >= gw) or (ngx1 < 0)) then
1081     begin
1082       if (ngx0 < 0) then ngx0 := 0;
1083       if (ngy0 < 0) then ngy0 := 0;
1084       if (ngx1 > gw-1) then ngx1 := gw-1;
1085       if (ngy1 > gh-1) then ngy1 := gh-1;
1086       {$IF DEFINED(D2F_DEBUG_MOVER)}
1087       e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1088       {$ENDIF}
1089       for gx := ngx0 to ngx1 do
1090       begin
1091         if (gx < ogx0) or (gx > ogx1) then
1092         begin
1093           // this column is completely outside of old rect
1094           for gy := ngy0 to ngy1 do
1095           begin
1096             {$IF DEFINED(D2F_DEBUG_MOVER)}
1097             e_WriteLog(Format('  insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1098             {$ENDIF}
1099             inserter(gy*gw+gx, body);
1100           end;
1101         end
1102         else
1103         begin
1104           // heavy checks
1105           for gy := ngy0 to ngy1 do
1106           begin
1107             if (gy < ogy0) or (gy > ogy1) then
1108             begin
1109               {$IF DEFINED(D2F_DEBUG_MOVER)}
1110               e_WriteLog(Format('  insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1111               {$ENDIF}
1112               inserter(gy*gw+gx, body);
1113             end;
1114           end;
1115         end;
1116       end;
1117     end;
1118     // done
1119   end
1120   else
1121   begin
1122     {$IF DEFINED(D2F_DEBUG_MOVER)}
1123     e_WriteLog(Format('proxy #%d: GRID OK: xg=%d;yg=%d;w=%d;h=%d;nx=%d;ny=%d og:(%d,%d)-(%d,%d); ng:(%d,%d)-(%d,%d)', [body, x0, y0, pw, ph, nx, ny, ogx0, ogy0, ogx1, ogy1, ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1124     {$ENDIF}
1125   end;
1126   // update coordinates
1127   px.mX := nx+mMinX;
1128   px.mY := ny+mMinY;
1129 end;
1130
1131 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1132 var
1133   px: PBodyProxyRec;
1134   x0, y0, w, h: Integer;
1135 begin
1136   if (body < 0) or (body > High(mProxies)) then exit; // just in case
1137   // check if tile coords was changed
1138   px := @mProxies[body];
1139   x0 := px.mX-mMinX;
1140   y0 := px.mY-mMinY;
1141   w := px.mWidth;
1142   h := px.mHeight;
1143   {$IF DEFINED(D2F_DEBUG_MOVER)}
1144   e_WriteLog(Format('proxy #%d: RESIZE: xg=%d;yg=%d;w=%d;h=%d;nw=%d;nh=%d', [body, x0, y0, w, h, nw, nh]), MSG_NOTIFY);
1145   {$ENDIF}
1146   if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1147      ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1148   begin
1149     // crossed tile boundary, do heavy work
1150     removeInternal(body);
1151     px.mWidth := nw;
1152     px.mHeight := nh;
1153     insertInternal(body);
1154   end
1155   else
1156   begin
1157     // nothing to do with the grid, just fix size
1158     px.mWidth := nw;
1159     px.mHeight := nh;
1160   end;
1161 end;
1162
1163
1164 // ////////////////////////////////////////////////////////////////////////// //
1165 function TBodyGridBase.atPoint (x, y: Integer): TAtPointEnumerator;
1166 var
1167   cidx: Integer = -1;
1168 begin
1169   Dec(x, mMinX);
1170   Dec(y, mMinY);
1171   if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1172   result := TAtPointEnumerator.Create(mCells, cidx, getProxyById);
1173 end;
1174
1175
1176 // ////////////////////////////////////////////////////////////////////////// //
1177 // no callback: return `true` on the first hit
1178 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1179 var
1180   f: Integer;
1181   idx, curci: Integer;
1182   cc: PGridCell = nil;
1183   px: PBodyProxyRec;
1184   lq: LongWord;
1185   ptag: Integer;
1186 begin
1187   result := Default(ITP);
1188   if (exittag <> nil) then exittag^ := 0;
1189   tagmask := tagmask and TagFullMask;
1190   if (tagmask = 0) then exit;
1191
1192   {$IF DEFINED(D2F_DEBUG_XXQ)}
1193   if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1194   {$ENDIF}
1195
1196   // make coords (0,0)-based
1197   Dec(x, mMinX);
1198   Dec(y, mMinY);
1199   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1200
1201   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1202
1203   {$IF DEFINED(D2F_DEBUG_XXQ)}
1204   if (assigned(cb)) then e_WriteLog(Format('1: grid pointquery: (%d,%d) (%d,%d) %d', [x, y, (x div mTileSize), (y div mTileSize), curci]), MSG_NOTIFY);
1205   {$ENDIF}
1206
1207   // restore coords
1208   Inc(x, mMinX);
1209   Inc(y, mMinY);
1210
1211   // increase query counter
1212   Inc(mLastQuery);
1213   if (mLastQuery = 0) then
1214   begin
1215     // just in case of overflow
1216     mLastQuery := 1;
1217     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1218   end;
1219   lq := mLastQuery;
1220
1221   {$IF DEFINED(D2F_DEBUG_XXQ)}
1222   if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1223   {$ENDIF}
1224
1225   while (curci <> -1) do
1226   begin
1227     {$IF DEFINED(D2F_DEBUG_XXQ)}
1228     if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1229     {$ENDIF}
1230     cc := @mCells[curci];
1231     for f := 0 to GridCellBucketSize-1 do
1232     begin
1233       if (cc.bodies[f] = -1) then break;
1234       px := @mProxies[cc.bodies[f]];
1235       {$IF DEFINED(D2F_DEBUG_XXQ)}
1236       if (assigned(cb)) then e_WriteLog(Format('  proxy #%d; qm:%u; tag:%08x; tagflag:%d  %u', [cc.bodies[f], px.mQueryMark, px.mTag, (px.mTag and tagmask), LongWord(px.mObj)]), MSG_NOTIFY);
1237       {$ENDIF}
1238       // shit. has to do it this way, so i can change tag in callback
1239       if (px.mQueryMark <> lq) then
1240       begin
1241         px.mQueryMark := lq;
1242         ptag := px.mTag;
1243         if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1244            (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1245         begin
1246           if assigned(cb) then
1247           begin
1248             if cb(px.mObj, ptag) then
1249             begin
1250               result := px.mObj;
1251               if (exittag <> nil) then exittag^ := ptag;
1252               exit;
1253             end;
1254           end
1255           else
1256           begin
1257             result := px.mObj;
1258             if (exittag <> nil) then exittag^ := ptag;
1259             exit;
1260           end;
1261         end;
1262       end;
1263     end;
1264     curci := cc.next;
1265   end;
1266 end;
1267
1268
1269 // ////////////////////////////////////////////////////////////////////////// //
1270 // no callback: return `true` on the first hit
1271 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1272 const
1273   tsize = mTileSize;
1274 var
1275   idx: Integer;
1276   gx, gy: Integer;
1277   curci: Integer;
1278   f: Integer;
1279   cc: PGridCell = nil;
1280   px: PBodyProxyRec;
1281   lq: LongWord;
1282   gw: Integer;
1283   x0, y0: Integer;
1284   ptag: Integer;
1285 begin
1286   result := Default(ITP);
1287   if (w < 1) or (h < 1) then exit;
1288   tagmask := tagmask and TagFullMask;
1289   if (tagmask = 0) then exit;
1290
1291   x0 := x;
1292   y0 := y;
1293
1294   // fix coords
1295   Dec(x, mMinX);
1296   Dec(y, mMinY);
1297
1298   gw := mWidth;
1299   //tsize := mTileSize;
1300
1301   if (x+w <= 0) or (y+h <= 0) then exit;
1302   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1303
1304   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1305   mInQuery := true;
1306
1307   // increase query counter
1308   Inc(mLastQuery);
1309   if (mLastQuery = 0) then
1310   begin
1311     // just in case of overflow
1312     mLastQuery := 1;
1313     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1314   end;
1315   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1316   lq := mLastQuery;
1317
1318   // go on
1319   for gy := y div tsize to (y+h-1) div tsize do
1320   begin
1321     if (gy < 0) then continue;
1322     if (gy >= mHeight) then break;
1323     for gx := x div tsize to (x+w-1) div tsize do
1324     begin
1325       if (gx < 0) then continue;
1326       if (gx >= gw) then break;
1327       // process cells
1328       curci := mGrid[gy*gw+gx];
1329       while (curci <> -1) do
1330       begin
1331         cc := @mCells[curci];
1332         for f := 0 to GridCellBucketSize-1 do
1333         begin
1334           if (cc.bodies[f] = -1) then break;
1335           px := @mProxies[cc.bodies[f]];
1336           // shit. has to do it this way, so i can change tag in callback
1337           if (px.mQueryMark = lq) then continue;
1338           px.mQueryMark := lq;
1339           ptag := px.mTag;
1340           if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1341           if ((ptag and tagmask) = 0) then continue;
1342           if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1343           if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1344           if assigned(cb) then
1345           begin
1346             if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
1347           end
1348           else
1349           begin
1350             result := px.mObj;
1351             mInQuery := false;
1352             exit;
1353           end;
1354         end;
1355         curci := cc.next;
1356       end;
1357     end;
1358   end;
1359
1360   mInQuery := false;
1361 end;
1362
1363
1364 // ////////////////////////////////////////////////////////////////////////// //
1365 // no callback: return `true` on the nearest hit
1366 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1367 var
1368   ex, ey: Integer;
1369 begin
1370   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1371 end;
1372
1373
1374 // no callback: return `true` on the nearest hit
1375 // you are not supposed to understand this
1376 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1377 const
1378   tsize = mTileSize;
1379 var
1380   wx0, wy0, wx1, wy1: Integer; // window coordinates
1381   stx, sty: Integer; // "steps" for x and y axes
1382   dsx, dsy: Integer; // "lengthes" for x and y axes
1383   dx2, dy2: Integer; // "double lengthes" for x and y axes
1384   xd, yd: Integer; // current coord
1385   e: Integer; // "error" (as in bresenham algo)
1386   rem: Integer;
1387   term: Integer;
1388   xptr, yptr: PInteger;
1389   xfixed: Boolean;
1390   temp: Integer;
1391   prevx, prevy: Integer;
1392   lastDistSq: Integer;
1393   ccidx, curci: Integer;
1394   hasUntried: Boolean;
1395   lastGA: Integer = -1;
1396   ga, x, y: Integer;
1397   lastObj: ITP;
1398   wasHit: Boolean = false;
1399   gw, gh, minx, miny, maxx, maxy: Integer;
1400   cc: PGridCell;
1401   px: PBodyProxyRec;
1402   lq: LongWord;
1403   f, ptag, distSq: Integer;
1404   x0, y0, x1, y1: Integer;
1405   //swapped: Boolean = false; // true: xd is yd, and vice versa
1406   // horizontal walker
1407   {$IFDEF GRID_USE_ORTHO_ACCEL}
1408   wklen, wkstep: Integer;
1409   //wksign: Integer;
1410   hopt: Boolean;
1411   {$ENDIF}
1412   // skipper
1413   xdist, ydist: Integer;
1414 begin
1415   result := Default(ITP);
1416   lastObj := Default(ITP);
1417   tagmask := tagmask and TagFullMask;
1418   ex := ax1; // why not?
1419   ey := ay1; // why not?
1420   if (tagmask = 0) then exit;
1421
1422   if (ax0 = ax1) and (ay0 = ay1) then
1423   begin
1424     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1425     if (result <> nil) then
1426     begin
1427       if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
1428     end;
1429     exit;
1430   end;
1431
1432   lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1433
1434   gw := mWidth;
1435   gh := mHeight;
1436   minx := mMinX;
1437   miny := mMinY;
1438   maxx := gw*tsize-1;
1439   maxy := gh*tsize-1;
1440
1441   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1442   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);
1443   {$ENDIF}
1444
1445   x0 := ax0;
1446   y0 := ay0;
1447   x1 := ax1;
1448   y1 := ay1;
1449
1450   // offset query coords to (0,0)-based
1451   Dec(x0, minx);
1452   Dec(y0, miny);
1453   Dec(x1, minx);
1454   Dec(y1, miny);
1455
1456   // clip rectange
1457   wx0 := 0;
1458   wy0 := 0;
1459   wx1 := maxx;
1460   wy1 := maxy;
1461
1462   // horizontal setup
1463   if (x0 < x1) then
1464   begin
1465     // from left to right
1466     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1467     stx := 1; // going right
1468   end
1469   else
1470   begin
1471     // from right to left
1472     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1473     stx := -1; // going left
1474     x0 := -x0;
1475     x1 := -x1;
1476     wx0 := -wx0;
1477     wx1 := -wx1;
1478     swapInt(wx0, wx1);
1479   end;
1480
1481   // vertical setup
1482   if (y0 < y1) then
1483   begin
1484     // from top to bottom
1485     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1486     sty := 1; // going down
1487   end
1488   else
1489   begin
1490     // from bottom to top
1491     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1492     sty := -1; // going up
1493     y0 := -y0;
1494     y1 := -y1;
1495     wy0 := -wy0;
1496     wy1 := -wy1;
1497     swapInt(wy0, wy1);
1498   end;
1499
1500   dsx := x1-x0;
1501   dsy := y1-y0;
1502
1503   if (dsx < dsy) then
1504   begin
1505     //swapped := true;
1506     xptr := @yd;
1507     yptr := @xd;
1508     swapInt(x0, y0);
1509     swapInt(x1, y1);
1510     swapInt(dsx, dsy);
1511     swapInt(wx0, wy0);
1512     swapInt(wx1, wy1);
1513     swapInt(stx, sty);
1514   end
1515   else
1516   begin
1517     xptr := @xd;
1518     yptr := @yd;
1519   end;
1520
1521   dx2 := 2*dsx;
1522   dy2 := 2*dsy;
1523   xd := x0;
1524   yd := y0;
1525   e := 2*dsy-dsx;
1526   term := x1;
1527
1528   xfixed := false;
1529   if (y0 < wy0) then
1530   begin
1531     // clip at top
1532     temp := dx2*(wy0-y0)-dsx;
1533     xd += temp div dy2;
1534     rem := temp mod dy2;
1535     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1536     if (xd+1 >= wx0) then
1537     begin
1538       yd := wy0;
1539       e -= rem+dsx;
1540       if (rem > 0) then begin Inc(xd); e += dy2; end;
1541       xfixed := true;
1542     end;
1543   end;
1544
1545   if (not xfixed) and (x0 < wx0) then
1546   begin
1547     // clip at left
1548     temp := dy2*(wx0-x0);
1549     yd += temp div dx2;
1550     rem := temp mod dx2;
1551     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1552     xd := wx0;
1553     e += rem;
1554     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1555   end;
1556
1557   if (y1 > wy1) then
1558   begin
1559     // clip at bottom
1560     temp := dx2*(wy1-y0)+dsx;
1561     term := x0+temp div dy2;
1562     rem := temp mod dy2;
1563     if (rem = 0) then Dec(term);
1564   end;
1565
1566   if (term > wx1) then term := wx1; // clip at right
1567
1568   Inc(term); // draw last point
1569   //if (term = xd) then exit; // this is the only point, get out of here
1570
1571   if (sty = -1) then yd := -yd;
1572   if (stx = -1) then begin xd := -xd; term := -term; end;
1573   dx2 -= dy2;
1574
1575   // first move, to skip starting point
1576   // DON'T DO THIS! loop will take care of that
1577   if (xd = term) then
1578   begin
1579     //FIXME!
1580     result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1581     if (result <> nil) then
1582     begin
1583       if assigned(cb) then
1584       begin
1585         if cb(result, ptag, ax0, ay0, ax0, ay0) then
1586         begin
1587           ex := ax0;
1588           ey := ay0;
1589         end
1590         else
1591         begin
1592           result := nil;
1593         end;
1594       end
1595       else
1596       begin
1597         ex := ax0;
1598         ey := ay0;
1599       end;
1600     end;
1601     exit;
1602   end;
1603
1604   prevx := xptr^+minx;
1605   prevy := yptr^+miny;
1606   (*
1607   // move coords
1608   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1609   xd += stx;
1610   // done?
1611   if (xd = term) then exit;
1612   *)
1613
1614   {$IF DEFINED(D2F_DEBUG)}
1615   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1616   {$ENDIF}
1617   // DON'T DO THIS! loop will take care of that
1618   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1619   //ccidx := mGrid[lastGA];
1620
1621   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1622   //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1623   {$ENDIF}
1624
1625   //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1626
1627   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1628   mInQuery := true;
1629
1630   // increase query counter
1631   Inc(mLastQuery);
1632   if (mLastQuery = 0) then
1633   begin
1634     // just in case of overflow
1635     mLastQuery := 1;
1636     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1637   end;
1638   lq := mLastQuery;
1639
1640   {$IFDEF GRID_USE_ORTHO_ACCEL}
1641   // if this is strict horizontal/vertical trace, use optimized codepath
1642   if (ax0 = ax1) or (ay0 = ay1) then
1643   begin
1644     // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
1645     //   stx < 0: going left, otherwise `stx` is > 0, and we're going right
1646     // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
1647     //   stx < 0: going up, otherwise `stx` is > 0, and we're going down
1648     hopt := (ay0 = ay1); // horizontal?
1649     if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
1650     {$IF DEFINED(D2F_DEBUG)}
1651     if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
1652     {$ENDIF}
1653     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1654     // one of those will never change
1655     x := xptr^+minx;
1656     y := yptr^+miny;
1657     //prevx := x;
1658     //prevy := y;
1659     {$IF DEFINED(D2F_DEBUG)}
1660     if hopt then
1661     begin
1662       if (y <> ay0) then raise Exception.Create('htrace fatal internal error');
1663     end
1664     else
1665     begin
1666       if (x <> ax0) then raise Exception.Create('vtrace fatal internal error');
1667     end;
1668     {$ENDIF}
1669     while (wklen > 0) do
1670     begin
1671       {$IF DEFINED(D2F_DEBUG)}
1672       if dbgShowTraceLog then e_LogWritefln('  htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1673       {$ENDIF}
1674       // new tile?
1675       if (ga <> lastGA) then
1676       begin
1677         lastGA := ga;
1678         ccidx := mGrid[lastGA];
1679         // convert coords to map (to avoid ajdusting coords inside the loop)
1680         if hopt then x := xptr^+minx else y := yptr^+miny;
1681         while (ccidx <> -1) do
1682         begin
1683           cc := @mCells[ccidx];
1684           for f := 0 to GridCellBucketSize-1 do
1685           begin
1686             if (cc.bodies[f] = -1) then break;
1687             px := @mProxies[cc.bodies[f]];
1688             ptag := px.mTag;
1689             if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
1690                // constant coord should be inside
1691                ((hopt and (y >= px.mY) and (y < px.mY+px.mHeight)) or
1692                 ((not hopt) and (x >= px.mX) and (x < px.mX+px.mWidth))) then
1693             begin
1694               px.mQueryMark := lq; // mark as processed
1695               // inside the proxy?
1696               if (hopt and (x > px.mX) and (x < px.mX+px.mWidth-1)) or
1697                  ((not hopt) and (y > px.mY) and (y < px.mY+px.mHeight-1)) then
1698               begin
1699                 // setup prev[xy]
1700                 if assigned(cb) then
1701                 begin
1702                   if cb(px.mObj, ptag, x, y, x, y) then
1703                   begin
1704                     result := px.mObj;
1705                     ex := x;
1706                     ey := y;
1707                     mInQuery := false;
1708                     exit;
1709                   end;
1710                 end
1711                 else
1712                 begin
1713                   distSq := distanceSq(ax0, ay0, x, y);
1714                   {$IF DEFINED(D2F_DEBUG)}
1715                   if dbgShowTraceLog then e_LogWritefln('  EMBEDDED hhit(%d): a=(%d,%d), h=(%d,%d), distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, distSq, lastDistSq]);
1716                   {$ENDIF}
1717                   if (distSq < lastDistSq) then
1718                   begin
1719                     ex := x;
1720                     ey := y;
1721                     result := px.mObj;
1722                     mInQuery := false;
1723                     exit;
1724                   end;
1725                 end;
1726                 continue;
1727               end;
1728               // remember this hitpoint if it is nearer than an old one
1729               // setup prev[xy]
1730               if hopt then
1731               begin
1732                 // horizontal trace
1733                 prevy := y;
1734                 y := yptr^+miny;
1735                 if (stx < 0) then
1736                 begin
1737                   // going left
1738                   if (x < px.mX+px.mWidth-1) then continue; // not on the right edge
1739                   prevx := px.mX+px.mWidth;
1740                   x := prevx-1;
1741                 end
1742                 else
1743                 begin
1744                   // going right
1745                   if (x > px.mX) then continue; // not on the left edge
1746                   prevx := px.mX-1;
1747                   x := prevx+1;
1748                 end;
1749               end
1750               else
1751               begin
1752                 // vertical trace
1753                 prevx := x;
1754                 x := xptr^+minx;
1755                 if (stx < 0) then
1756                 begin
1757                   // going up
1758                   if (y < px.mY+px.mHeight-1) then continue; // not on the bottom edge
1759                   prevy := px.mY+px.mHeight;
1760                   y := prevy-1;
1761                 end
1762                 else
1763                 begin
1764                   // going down
1765                   if (y > px.mY) then continue; // not on the top edge
1766                   prevy := px.mY-1;
1767                   y := prevy+1;
1768                 end;
1769               end;
1770               if assigned(cb) then
1771               begin
1772                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1773                 begin
1774                   result := px.mObj;
1775                   ex := prevx;
1776                   ey := prevy;
1777                   mInQuery := false;
1778                   exit;
1779                 end;
1780               end
1781               else
1782               begin
1783                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1784                 {$IF DEFINED(D2F_DEBUG)}
1785                 if dbgShowTraceLog then e_LogWritefln('  hhit(%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]);
1786                 {$ENDIF}
1787                 if (distSq < lastDistSq) then
1788                 begin
1789                   wasHit := true;
1790                   lastDistSq := distSq;
1791                   ex := prevx;
1792                   ey := prevy;
1793                   lastObj := px.mObj;
1794                 end;
1795               end;
1796             end;
1797           end;
1798           // next cell
1799           ccidx := cc.next;
1800         end;
1801         if wasHit and not assigned(cb) then begin result := lastObj; mInQuery := false; exit; end;
1802         if assigned(cb) and cb(nil, 0, x, y, x, y) then begin result := lastObj; mInQuery := false; exit; end;
1803       end;
1804       // skip to next tile
1805       if hopt then
1806       begin
1807         if (stx > 0) then
1808         begin
1809           // to the right
1810           wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
1811           {$IF DEFINED(D2F_DEBUG)}
1812           if dbgShowTraceLog then e_LogWritefln('  right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1813           {$ENDIF}
1814           if (wkstep >= wklen) then break;
1815           Inc(xptr^, wkstep);
1816           Inc(ga);
1817         end
1818         else
1819         begin
1820           // to the left
1821           wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
1822           {$IF DEFINED(D2F_DEBUG)}
1823           if dbgShowTraceLog then e_LogWritefln('  left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1824           {$ENDIF}
1825           if (wkstep >= wklen) then break;
1826           Dec(xptr^, wkstep);
1827           Dec(ga);
1828         end;
1829       end
1830       else
1831       begin
1832         if (stx > 0) then
1833         begin
1834           // to the down
1835           wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
1836           {$IF DEFINED(D2F_DEBUG)}
1837           if dbgShowTraceLog then e_LogWritefln('  down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1838           {$ENDIF}
1839           if (wkstep >= wklen) then break;
1840           Inc(yptr^, wkstep);
1841           Inc(ga, mHeight);
1842         end
1843         else
1844         begin
1845           // to the up
1846           wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
1847           {$IF DEFINED(D2F_DEBUG)}
1848           if dbgShowTraceLog then e_LogWritefln('  up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1849           {$ENDIF}
1850           if (wkstep >= wklen) then break;
1851           Dec(yptr^, wkstep);
1852           Dec(ga, mHeight);
1853         end;
1854       end;
1855       Dec(wklen, wkstep);
1856     end;
1857     // we can travel less than one cell
1858     if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
1859     mInQuery := false;
1860     exit;
1861   end;
1862   {$ENDIF}
1863
1864   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1865   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1866   {$ENDIF}
1867
1868   //e_LogWritefln('*********************', []);
1869   ccidx := -1;
1870   //  can omit checks
1871   while (xd <> term) do
1872   begin
1873     // check cell(s)
1874     {$IF DEFINED(D2F_DEBUG)}
1875     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1876     {$ENDIF}
1877     // new tile?
1878     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1879     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1880     if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' xd=%d; term=%d; gx=%d; gy=%d; ga=%d; lastga=%d', [xd, term, xptr^, yptr^, ga, lastGA]), MSG_NOTIFY);
1881     {$ENDIF}
1882     if (ga <> lastGA) then
1883     begin
1884       // yes
1885       {$IF DEFINED(D2F_DEBUG)}
1886       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1887       {$ENDIF}
1888       if (ccidx <> -1) then
1889       begin
1890         // signal cell completion
1891         if assigned(cb) then
1892         begin
1893           if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
1894         end
1895         else if wasHit then
1896         begin
1897           result := lastObj;
1898           mInQuery := false;
1899           exit;
1900         end;
1901       end;
1902       lastGA := ga;
1903       ccidx := mGrid[lastGA];
1904     end;
1905     // has something to process in this tile?
1906     if (ccidx <> -1) then
1907     begin
1908       // process cell
1909       curci := ccidx;
1910       hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1911       // convert coords to map (to avoid ajdusting coords inside the loop)
1912       x := xptr^+minx;
1913       y := yptr^+miny;
1914       // process cell list
1915       while (curci <> -1) do
1916       begin
1917         cc := @mCells[curci];
1918         for f := 0 to GridCellBucketSize-1 do
1919         begin
1920           if (cc.bodies[f] = -1) then break;
1921           px := @mProxies[cc.bodies[f]];
1922           ptag := px.mTag;
1923           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1924           begin
1925             // can we process this proxy?
1926             if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1927             begin
1928               px.mQueryMark := lq; // mark as processed
1929               if assigned(cb) then
1930               begin
1931                 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1932                 begin
1933                   result := px.mObj;
1934                   ex := prevx;
1935                   ey := prevy;
1936                   mInQuery := false;
1937                   exit;
1938                 end;
1939               end
1940               else
1941               begin
1942                 // remember this hitpoint if it is nearer than an old one
1943                 distSq := distanceSq(ax0, ay0, prevx, prevy);
1944                 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1945                 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);
1946                 {$ENDIF}
1947                 if (distSq < lastDistSq) then
1948                 begin
1949                   wasHit := true;
1950                   lastDistSq := distSq;
1951                   ex := prevx;
1952                   ey := prevy;
1953                   lastObj := px.mObj;
1954                 end;
1955               end;
1956             end
1957             else
1958             begin
1959               // this is possibly interesting proxy, set "has more to check" flag
1960               hasUntried := true;
1961             end;
1962           end;
1963         end;
1964         // next cell
1965         curci := cc.next;
1966       end;
1967       // still has something interesting in this cell?
1968       if not hasUntried then
1969       begin
1970         // nope, don't process this cell anymore; signal cell completion
1971         ccidx := -1;
1972         if assigned(cb) then
1973         begin
1974           if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
1975         end
1976         else if wasHit then
1977         begin
1978           result := lastObj;
1979           mInQuery := false;
1980           exit;
1981         end;
1982       end;
1983     end;
1984     if (ccidx = -1) then
1985     begin
1986       // move to cell edge, as we have nothing to trace here anymore
1987       if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
1988       if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
1989       //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
1990       while (xd <> xdist) and (yd <> ydist) do
1991       begin
1992         // step
1993         xd += stx;
1994         if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1995         //e_LogWritefln('  xd=%d; yd=%d', [xd, yd]);
1996         if (xd = term) then break;
1997       end;
1998       //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
1999       if (xd = term) then break;
2000     end;
2001     //putPixel(xptr^, yptr^);
2002     // move coords
2003     prevx := xptr^+minx;
2004     prevy := yptr^+miny;
2005     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2006     xd += stx;
2007   end;
2008   // we can travel less than one cell
2009   if wasHit and not assigned(cb) then
2010   begin
2011     result := lastObj;
2012   end
2013   else
2014   begin
2015     ex := ax1; // why not?
2016     ey := ay1; // why not?
2017   end;
2018
2019   mInQuery := false;
2020 end;
2021
2022
2023 // ////////////////////////////////////////////////////////////////////////// //
2024 //FIXME! optimize this with real tile walking
2025 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
2026 const
2027   tsize = mTileSize;
2028 var
2029   wx0, wy0, wx1, wy1: Integer; // window coordinates
2030   stx, sty: Integer; // "steps" for x and y axes
2031   dsx, dsy: Integer; // "lengthes" for x and y axes
2032   dx2, dy2: Integer; // "double lengthes" for x and y axes
2033   xd, yd: Integer; // current coord
2034   e: Integer; // "error" (as in bresenham algo)
2035   rem: Integer;
2036   term: Integer;
2037   xptr, yptr: PInteger;
2038   xfixed: Boolean;
2039   temp: Integer;
2040   ccidx, curci: Integer;
2041   lastGA: Integer = -1;
2042   ga, x, y: Integer;
2043   gw, gh, minx, miny, maxx, maxy: Integer;
2044   cc: PGridCell;
2045   px: PBodyProxyRec;
2046   lq: LongWord;
2047   f, ptag: Integer;
2048   x0, y0, x1, y1: Integer;
2049   //swapped: Boolean = false; // true: xd is yd, and vice versa
2050   // horizontal walker
2051   {$IFDEF GRID_USE_ORTHO_ACCEL}
2052   wklen, wkstep: Integer;
2053   //wksign: Integer;
2054   hopt: Boolean;
2055   {$ENDIF}
2056   // skipper
2057   xdist, ydist: Integer;
2058 begin
2059   log := false;
2060   result := Default(ITP);
2061   tagmask := tagmask and TagFullMask;
2062   if (tagmask = 0) or not assigned(cb) then exit;
2063
2064   if (ax0 = ax1) and (ay0 = ay1) then
2065   begin
2066     result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2067     exit;
2068   end;
2069
2070   gw := mWidth;
2071   gh := mHeight;
2072   minx := mMinX;
2073   miny := mMinY;
2074   maxx := gw*tsize-1;
2075   maxy := gh*tsize-1;
2076
2077   x0 := ax0;
2078   y0 := ay0;
2079   x1 := ax1;
2080   y1 := ay1;
2081
2082   // offset query coords to (0,0)-based
2083   Dec(x0, minx);
2084   Dec(y0, miny);
2085   Dec(x1, minx);
2086   Dec(y1, miny);
2087
2088   // clip rectange
2089   wx0 := 0;
2090   wy0 := 0;
2091   wx1 := maxx;
2092   wy1 := maxy;
2093
2094   // horizontal setup
2095   if (x0 < x1) then
2096   begin
2097     // from left to right
2098     if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2099     stx := 1; // going right
2100   end
2101   else
2102   begin
2103     // from right to left
2104     if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2105     stx := -1; // going left
2106     x0 := -x0;
2107     x1 := -x1;
2108     wx0 := -wx0;
2109     wx1 := -wx1;
2110     swapInt(wx0, wx1);
2111   end;
2112
2113   // vertical setup
2114   if (y0 < y1) then
2115   begin
2116     // from top to bottom
2117     if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2118     sty := 1; // going down
2119   end
2120   else
2121   begin
2122     // from bottom to top
2123     if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2124     sty := -1; // going up
2125     y0 := -y0;
2126     y1 := -y1;
2127     wy0 := -wy0;
2128     wy1 := -wy1;
2129     swapInt(wy0, wy1);
2130   end;
2131
2132   dsx := x1-x0;
2133   dsy := y1-y0;
2134
2135   if (dsx < dsy) then
2136   begin
2137     //swapped := true;
2138     xptr := @yd;
2139     yptr := @xd;
2140     swapInt(x0, y0);
2141     swapInt(x1, y1);
2142     swapInt(dsx, dsy);
2143     swapInt(wx0, wy0);
2144     swapInt(wx1, wy1);
2145     swapInt(stx, sty);
2146   end
2147   else
2148   begin
2149     xptr := @xd;
2150     yptr := @yd;
2151   end;
2152
2153   dx2 := 2*dsx;
2154   dy2 := 2*dsy;
2155   xd := x0;
2156   yd := y0;
2157   e := 2*dsy-dsx;
2158   term := x1;
2159
2160   xfixed := false;
2161   if (y0 < wy0) then
2162   begin
2163     // clip at top
2164     temp := dx2*(wy0-y0)-dsx;
2165     xd += temp div dy2;
2166     rem := temp mod dy2;
2167     if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2168     if (xd+1 >= wx0) then
2169     begin
2170       yd := wy0;
2171       e -= rem+dsx;
2172       if (rem > 0) then begin Inc(xd); e += dy2; end;
2173       xfixed := true;
2174     end;
2175   end;
2176
2177   if (not xfixed) and (x0 < wx0) then
2178   begin
2179     // clip at left
2180     temp := dy2*(wx0-x0);
2181     yd += temp div dx2;
2182     rem := temp mod dx2;
2183     if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2184     xd := wx0;
2185     e += rem;
2186     if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2187   end;
2188
2189   if (y1 > wy1) then
2190   begin
2191     // clip at bottom
2192     temp := dx2*(wy1-y0)+dsx;
2193     term := x0+temp div dy2;
2194     rem := temp mod dy2;
2195     if (rem = 0) then Dec(term);
2196   end;
2197
2198   if (term > wx1) then term := wx1; // clip at right
2199
2200   Inc(term); // draw last point
2201   //if (term = xd) then exit; // this is the only point, get out of here
2202
2203   if (sty = -1) then yd := -yd;
2204   if (stx = -1) then begin xd := -xd; term := -term; end;
2205   dx2 -= dy2;
2206
2207   // first move, to skip starting point
2208   // DON'T DO THIS! loop will take care of that
2209   if (xd = term) then
2210   begin
2211     result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2212     exit;
2213   end;
2214
2215   (*
2216   // move coords
2217   if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2218   xd += stx;
2219   // done?
2220   if (xd = term) then exit;
2221   *)
2222
2223   {$IF DEFINED(D2F_DEBUG)}
2224   if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2225   {$ENDIF}
2226   // DON'T DO THIS! loop will take care of that
2227   //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2228   //ccidx := mGrid[lastGA];
2229
2230   if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2231   mInQuery := true;
2232
2233   // increase query counter
2234   Inc(mLastQuery);
2235   if (mLastQuery = 0) then
2236   begin
2237     // just in case of overflow
2238     mLastQuery := 1;
2239     for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2240   end;
2241   lq := mLastQuery;
2242
2243   {$IFDEF GRID_USE_ORTHO_ACCEL}
2244   // if this is strict horizontal/vertical trace, use optimized codepath
2245   if (ax0 = ax1) or (ay0 = ay1) then
2246   begin
2247     // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2248     //   stx < 0: going left, otherwise `stx` is > 0, and we're going right
2249     // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2250     //   stx < 0: going up, otherwise `stx` is > 0, and we're going down
2251     hopt := (ay0 = ay1); // horizontal?
2252     if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
2253     {$IF DEFINED(D2F_DEBUG)}
2254     if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
2255     {$ENDIF}
2256     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2257     // one of those will never change
2258     x := xptr^+minx;
2259     y := yptr^+miny;
2260     {$IF DEFINED(D2F_DEBUG)}
2261     if hopt then
2262     begin
2263       if (y <> ay0) then raise Exception.Create('htrace fatal internal error');
2264     end
2265     else
2266     begin
2267       if (x <> ax0) then raise Exception.Create('vtrace fatal internal error');
2268     end;
2269     {$ENDIF}
2270     while (wklen > 0) do
2271     begin
2272       {$IF DEFINED(D2F_DEBUG)}
2273       if dbgShowTraceLog then e_LogWritefln('  htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
2274       {$ENDIF}
2275       // new tile?
2276       if (ga <> lastGA) then
2277       begin
2278         lastGA := ga;
2279         ccidx := mGrid[lastGA];
2280         // convert coords to map (to avoid ajdusting coords inside the loop)
2281         if hopt then x := xptr^+minx else y := yptr^+miny;
2282         while (ccidx <> -1) do
2283         begin
2284           cc := @mCells[ccidx];
2285           for f := 0 to GridCellBucketSize-1 do
2286           begin
2287             if (cc.bodies[f] = -1) then break;
2288             px := @mProxies[cc.bodies[f]];
2289             ptag := px.mTag;
2290             if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2291             begin
2292               px.mQueryMark := lq; // mark as processed
2293               if assigned(cb) then
2294               begin
2295                 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2296               end
2297               else
2298               begin
2299                 result := px.mObj;
2300                 mInQuery := false;
2301                 exit;
2302               end;
2303             end;
2304           end;
2305           // next cell
2306           ccidx := cc.next;
2307         end;
2308       end;
2309       // skip to next tile
2310       if hopt then
2311       begin
2312         if (stx > 0) then
2313         begin
2314           // to the right
2315           wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
2316           {$IF DEFINED(D2F_DEBUG)}
2317           if dbgShowTraceLog then e_LogWritefln('  right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2318           {$ENDIF}
2319           if (wkstep >= wklen) then break;
2320           Inc(xptr^, wkstep);
2321           Inc(ga);
2322         end
2323         else
2324         begin
2325           // to the left
2326           wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
2327           {$IF DEFINED(D2F_DEBUG)}
2328           if dbgShowTraceLog then e_LogWritefln('  left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2329           {$ENDIF}
2330           if (wkstep >= wklen) then break;
2331           Dec(xptr^, wkstep);
2332           Dec(ga);
2333         end;
2334       end
2335       else
2336       begin
2337         if (stx > 0) then
2338         begin
2339           // to the down
2340           wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
2341           {$IF DEFINED(D2F_DEBUG)}
2342           if dbgShowTraceLog then e_LogWritefln('  down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2343           {$ENDIF}
2344           if (wkstep >= wklen) then break;
2345           Inc(yptr^, wkstep);
2346           Inc(ga, mHeight);
2347         end
2348         else
2349         begin
2350           // to the up
2351           wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
2352           {$IF DEFINED(D2F_DEBUG)}
2353           if dbgShowTraceLog then e_LogWritefln('  up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2354           {$ENDIF}
2355           if (wkstep >= wklen) then break;
2356           Dec(yptr^, wkstep);
2357           Dec(ga, mHeight);
2358         end;
2359       end;
2360       Dec(wklen, wkstep);
2361     end;
2362     mInQuery := false;
2363     exit;
2364   end;
2365   {$ENDIF}
2366
2367   {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2368   if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2369   {$ENDIF}
2370
2371   ccidx := -1;
2372   //  can omit checks
2373   while (xd <> term) do
2374   begin
2375     // check cell(s)
2376     {$IF DEFINED(D2F_DEBUG)}
2377     if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2378     {$ENDIF}
2379     // new tile?
2380     ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2381     {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2382     if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' xd=%d; term=%d; gx=%d; gy=%d; ga=%d; lastga=%d', [xd, term, xptr^, yptr^, ga, lastGA]), MSG_NOTIFY);
2383     {$ENDIF}
2384     if (ga <> lastGA) then
2385     begin
2386       // yes
2387       {$IF DEFINED(D2F_DEBUG)}
2388       if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2389       {$ENDIF}
2390       lastGA := ga;
2391       ccidx := mGrid[lastGA];
2392     end;
2393     // has something to process in this tile?
2394     if (ccidx <> -1) then
2395     begin
2396       // process cell
2397       curci := ccidx;
2398       // convert coords to map (to avoid ajdusting coords inside the loop)
2399       x := xptr^+minx;
2400       y := yptr^+miny;
2401       // process cell list
2402       while (curci <> -1) do
2403       begin
2404         cc := @mCells[curci];
2405         for f := 0 to GridCellBucketSize-1 do
2406         begin
2407           if (cc.bodies[f] = -1) then break;
2408           px := @mProxies[cc.bodies[f]];
2409           ptag := px.mTag;
2410           if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2411           begin
2412             px.mQueryMark := lq; // mark as processed
2413             if assigned(cb) then
2414             begin
2415               if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2416             end
2417             else
2418             begin
2419               result := px.mObj;
2420               mInQuery := false;
2421               exit;
2422             end;
2423           end;
2424         end;
2425         // next cell
2426         curci := cc.next;
2427       end;
2428       // nothing more interesting in this cell
2429       ccidx := -1;
2430     end;
2431     // move to cell edge, as we have nothing to trace here anymore
2432     if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2433     if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2434     //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2435     while (xd <> xdist) and (yd <> ydist) do
2436     begin
2437       // step
2438       xd += stx;
2439       if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2440       //e_LogWritefln('  xd=%d; yd=%d', [xd, yd]);
2441       if (xd = term) then break;
2442     end;
2443     //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2444     if (xd = term) then break;
2445     //putPixel(xptr^, yptr^);
2446     // move coords
2447     if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2448     xd += stx;
2449   end;
2450
2451   mInQuery := false;
2452 end;
2453
2454
2455 end.