src/game/g_grid.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 // universal spatial grid
  17 {$INCLUDE ../shared/a_modes.inc}
  18 unit g_grid;
  19
  20 interface
  21
  22
  23 type
  24   TBodyProxyId = Integer;
  25
  26   generic TBodyGridBase<ITP> = class(TObject)
  27   public
  28     type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
  29     type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
  30
  31     const TagDisabled = $40000000;
  32
  33   private
  34     const
  35       GridDefaultTileSize = 32;
  36       GridCellBucketSize = 8; // WARNING! can't be less than 2!
  37
  38   private
  39     type
  40       PBodyProxyRec = ^TBodyProxyRec;
  41       TBodyProxyRec = record
  42       private
  43         mX, mY, mWidth, mHeight: Integer; // aabb
  44         mQueryMark: LongWord; // was this object visited at this query?
  45         mObj: ITP;
  46         mTag: Integer;
  47         nextLink: TBodyProxyId; // next free or nothing
  48
  49       private
  50         procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
  51       end;
  52
  53       PGridCell = ^TGridCell;
  54       TGridCell = record
  55         bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
  56         next: Integer; // in this cell; index in mCells
  57       end;
  58
  59       TGridInternalCB = function (grida: Integer): Boolean of object; // return `true` to stop
  60
  61   private
  62     mTileSize: Integer;
  63     mMinX, mMinY: Integer; // so grids can start at any origin
  64     mWidth, mHeight: Integer; // in tiles
  65     mGrid: array of Integer; // mWidth*mHeight, index in mCells
  66     mCells: array of TGridCell; // cell pool
  67     mFreeCell: Integer; // first free cell index or -1
  68     mLastQuery: LongWord;
  69     mUsedCells: Integer;
  70     mProxies: array of TBodyProxyRec;
  71     mProxyFree: TBodyProxyId; // free
  72     mProxyCount: Integer; // currently used
  73     mProxyMaxCount: Integer;
  74
  75     mUData: TBodyProxyId; // for inserter/remover
  76     mTagMask: Integer; // for iterator
  77     mItCB: TGridQueryCB; // for iterator
  78
  79   private
  80     function allocCell: Integer;
  81     procedure freeCell (idx: Integer); // `next` is simply overwritten
  82
  83     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
  84     procedure freeProxy (body: TBodyProxyId);
  85
  86     procedure insert (body: TBodyProxyId);
  87     procedure remove (body: TBodyProxyId);
  88
  89     function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB): Boolean;
  90
  91     function inserter (grida: Integer): Boolean;
  92     function remover (grida: Integer): Boolean;
  93
  94     function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
  95     procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
  96
  97   public
  98     constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
  99     destructor Destroy (); override;
 100
 101     function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxyId;
 102     procedure removeBody (aObj: TBodyProxyId); // WARNING! this WILL destroy proxy!
 103
 104     procedure moveBody (body: TBodyProxyId; dx, dy: Integer);
 105     procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
 106     procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 107
 108     function insideGrid (x, y: Integer): Boolean; inline;
 109
 110     //WARNING: can't do recursive queries
 111     // no callback: return `true` on the first hit
 112     function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 113
 114     //WARNING: can't do recursive queries
 115     // no callback: return `true` on the first hit
 116     function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 117
 118     //WARNING: can't do recursive queries
 119     // cb with `(nil)` will be called before processing new tile
 120     // no callback: return `true` on the nearest hit
 121     function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean; overload;
 122     function traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean;
 123
 124     procedure dumpStats ();
 125
 126     //WARNING! no sanity checks!
 127     property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
 128   end;
 129
 130
 131 implementation
 132
 133 uses
 134   SysUtils, e_log;
 135
 136
 137 // ////////////////////////////////////////////////////////////////////////// //
 138 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
 139 begin
 140   mX := aX;
 141   mY := aY;
 142   mWidth := aWidth;
 143   mHeight := aHeight;
 144   mQueryMark := 0;
 145   mObj := aObj;
 146   mTag := aTag;
 147   nextLink := -1;
 148 end;
 149
 150
 151 // ////////////////////////////////////////////////////////////////////////// //
 152 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer; aTileSize: Integer=GridDefaultTileSize);
 153 var
 154   idx: Integer;
 155 begin
 156   if aTileSize < 1 then aTileSize := 1;
 157   if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
 158   if aPixWidth < aTileSize then aPixWidth := aTileSize;
 159   if aPixHeight < aTileSize then aPixHeight := aTileSize;
 160   mTileSize := aTileSize;
 161   mMinX := aMinPixX;
 162   mMinY := aMinPixY;
 163   mWidth := (aPixWidth+aTileSize-1) div aTileSize;
 164   mHeight := (aPixHeight+aTileSize-1) div aTileSize;
 165   SetLength(mGrid, mWidth*mHeight);
 166   SetLength(mCells, mWidth*mHeight);
 167   SetLength(mProxies, 8192);
 168   mFreeCell := 0;
 169   // init free list
 170   for idx := 0 to High(mCells) do
 171   begin
 172     mCells[idx].bodies[0] := -1;
 173     mCells[idx].next := idx+1;
 174   end;
 175   mCells[High(mCells)].next := -1; // last cell
 176   // init grid
 177   for idx := 0 to High(mGrid) do mGrid[idx] := -1;
 178   // init proxies
 179   for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
 180   mProxies[High(mProxies)].nextLink := -1;
 181   mLastQuery := 0;
 182   mUsedCells := 0;
 183   mProxyFree := 0;
 184   mProxyCount := 0;
 185   mProxyMaxCount := 0;
 186   mUData := 0;
 187   mTagMask := -1;
 188   mItCB := nil;
 189   e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 190 end;
 191
 192
 193 destructor TBodyGridBase.Destroy ();
 194 begin
 195   mCells := nil;
 196   mGrid := nil;
 197   mProxies := nil;
 198   inherited;
 199 end;
 200
 201
 202 procedure TBodyGridBase.dumpStats ();
 203 var
 204   idx, mcb, cidx, cnt: Integer;
 205 begin
 206   mcb := 0;
 207   for idx := 0 to High(mGrid) do
 208   begin
 209     cidx := mGrid[idx];
 210     cnt := 0;
 211     while cidx >= 0 do
 212     begin
 213       Inc(cnt);
 214       cidx := mCells[cidx].next;
 215     end;
 216     if (mcb < cnt) then mcb := cnt;
 217   end;
 218   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);
 219 end;
 220
 221
 222 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
 223 begin
 224   // fix coords
 225   Dec(x, mMinX);
 226   Dec(y, mMinY);
 227   result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
 228 end;
 229
 230
 231 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
 232 begin
 233   if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
 234 end;
 235
 236
 237 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
 238 begin
 239   if (pid >= 0) then
 240   begin
 241     if val then
 242     begin
 243       mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
 244     end
 245     else
 246     begin
 247       mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled
 248     end;
 249   end;
 250 end;
 251
 252
 253 function TBodyGridBase.allocCell: Integer;
 254 var
 255   idx: Integer;
 256 begin
 257   if (mFreeCell < 0) then
 258   begin
 259     // no free cells, want more
 260     mFreeCell := Length(mCells);
 261     SetLength(mCells, mFreeCell+32768); // arbitrary number
 262     for idx := mFreeCell to High(mCells) do
 263     begin
 264       mCells[idx].bodies[0] := -1;
 265       mCells[idx].next := idx+1;
 266     end;
 267     mCells[High(mCells)].next := -1; // last cell
 268   end;
 269   result := mFreeCell;
 270   mFreeCell := mCells[result].next;
 271   mCells[result].next := -1;
 272   mCells[result].bodies[0] := -1;
 273   Inc(mUsedCells);
 274   //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
 275 end;
 276
 277
 278 procedure TBodyGridBase.freeCell (idx: Integer);
 279 begin
 280   if (idx >= 0) and (idx < Length(mCells)) then
 281   begin
 282     //if mCells[idx].body = -1 then exit; // the thing that should not be
 283     mCells[idx].bodies[0] := -1;
 284     mCells[idx].next := mFreeCell;
 285     mFreeCell := idx;
 286     Dec(mUsedCells);
 287   end;
 288 end;
 289
 290
 291 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
 292 var
 293   olen, idx: Integer;
 294   px: PBodyProxyRec;
 295 begin
 296   if (mProxyFree = -1) then
 297   begin
 298     // no free proxies, resize list
 299     olen := Length(mProxies);
 300     SetLength(mProxies, olen+8192); // arbitrary number
 301     for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
 302     mProxies[High(mProxies)].nextLink := -1;
 303     mProxyFree := olen;
 304   end;
 305   // get one from list
 306   result := mProxyFree;
 307   px := @mProxies[result];
 308   mProxyFree := px.nextLink;
 309   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 310   // add to used list
 311   px.nextLink := -1;
 312   // statistics
 313   Inc(mProxyCount);
 314   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 315 end;
 316
 317 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
 318 begin
 319   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 320   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 321   // add to free list
 322   mProxies[body].mObj := nil;
 323   mProxies[body].nextLink := mProxyFree;
 324   mProxyFree := body;
 325   Dec(mProxyCount);
 326 end;
 327
 328
 329 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB): Boolean;
 330 var
 331   gx, gy: Integer;
 332   gw, gh, tsize: Integer;
 333 begin
 334   result := false;
 335   if (w < 1) or (h < 1) or not assigned(cb) then exit;
 336   // fix coords
 337   Dec(x, mMinX);
 338   Dec(y, mMinY);
 339   // go on
 340   if (x+w <= 0) or (y+h <= 0) then exit;
 341   gw := mWidth;
 342   gh := mHeight;
 343   tsize := mTileSize;
 344   if (x >= gw*tsize) or (y >= gh*tsize) then exit;
 345   for gy := y div tsize to (y+h-1) div tsize do
 346   begin
 347     if (gy < 0) then continue;
 348     if (gy >= gh) then break;
 349     for gx := x div tsize to (x+w-1) div tsize do
 350     begin
 351       if (gx < 0) then continue;
 352       if (gx >= gw) then break;
 353       result := cb(gy*gw+gx);
 354       if result then exit;
 355     end;
 356   end;
 357 end;
 358
 359
 360 function TBodyGridBase.inserter (grida: Integer): Boolean;
 361 var
 362   cidx: Integer;
 363   pc: Integer;
 364   pi: PGridCell;
 365   f: Integer;
 366 begin
 367   result := false; // never stop
 368   // add body to the given grid cell
 369   pc := mGrid[grida];
 370   if (pc <> -1) then
 371   begin
 372     pi := @mCells[pc];
 373     f := 0;
 374     for f := 0 to High(TGridCell.bodies) do
 375     begin
 376       if (pi.bodies[f] = -1) then
 377       begin
 378         // can add here
 379         pi.bodies[f] := mUData;
 380         if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
 381         exit;
 382       end;
 383     end;
 384   end;
 385   // either no room, or no cell at all
 386   cidx := allocCell();
 387   mCells[cidx].bodies[0] := mUData;
 388   mCells[cidx].bodies[1] := -1;
 389   mCells[cidx].next := pc;
 390   mGrid[grida] := cidx;
 391 end;
 392
 393
 394 procedure TBodyGridBase.insert (body: TBodyProxyId);
 395 var
 396   px: PBodyProxyRec;
 397 begin
 398   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 399   px := @mProxies[body];
 400   mUData := body;
 401   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter);
 402 end;
 403
 404
 405 function TBodyGridBase.remover (grida: Integer): Boolean;
 406 var
 407   f: Integer;
 408   pidx, idx, tmp: Integer;
 409   pc: PGridCell;
 410 begin
 411   result := false; // never stop
 412   // find and remove cell
 413   pidx := -1;
 414   idx := mGrid[grida];
 415   while (idx >= 0) do
 416   begin
 417     tmp := mCells[idx].next;
 418     pc := @mCells[idx];
 419     f := 0;
 420     while (f < High(TGridCell.bodies)) do
 421     begin
 422       if (pc.bodies[f] = mUData) then
 423       begin
 424         // i found her!
 425         if (f = 0) and (pc.bodies[1] = -1) then
 426         begin
 427           // this cell contains no elements, remove it
 428           tmp := mCells[idx].next;
 429           if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
 430           freeCell(idx);
 431         end
 432         else
 433         begin
 434           // remove element from bucket
 435           Inc(f);
 436           while (f < High(TGridCell.bodies)) do
 437           begin
 438             pc.bodies[f-1] := pc.bodies[f];
 439             if (pc.bodies[f] = -1) then break;
 440             Inc(f);
 441           end;
 442           pc.bodies[High(TGridCell.bodies)] := -1; // just in case
 443         end;
 444         exit; // assume that we cannot have one object added to bucket twice
 445       end;
 446       Inc(f);
 447     end;
 448     pidx := idx;
 449     idx := tmp;
 450   end;
 451 end;
 452
 453
 454 // absolutely not tested
 455 procedure TBodyGridBase.remove (body: TBodyProxyId);
 456 var
 457   px: PBodyProxyRec;
 458 begin
 459   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 460   px := @mProxies[body];
 461   mUData := body;
 462   forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover);
 463 end;
 464
 465
 466 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TBodyProxyId;
 467 begin
 468   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 469   insert(result);
 470 end;
 471
 472
 473 procedure TBodyGridBase.removeBody (aObj: TBodyProxyId);
 474 begin
 475   if (aObj < 0) or (aObj > High(mProxies)) then exit; // just in case
 476   remove(aObj);
 477   freeProxy(aObj);
 478 end;
 479
 480
 481 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
 482 var
 483   px: PBodyProxyRec;
 484 begin
 485   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 486   if ((dx = 0) and (dy = 0) and (sx = 0) and (sy = 0)) then exit;
 487   remove(body);
 488   px := @mProxies[body];
 489   Inc(px.mX, dx);
 490   Inc(px.mY, dy);
 491   Inc(px.mWidth, sx);
 492   Inc(px.mHeight, sy);
 493   insert(body);
 494 end;
 495
 496 procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
 497 begin
 498   moveResizeBody(body, dx, dy, 0, 0);
 499 end;
 500
 501 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer);
 502 begin
 503   moveResizeBody(body, 0, 0, sx, sy);
 504 end;
 505
 506
 507 // ////////////////////////////////////////////////////////////////////////// //
 508 // no callback: return `true` on the first hit
 509 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 510 var
 511   f: Integer;
 512   idx, curci: Integer;
 513   cc: PGridCell = nil;
 514   px: PBodyProxyRec;
 515   lq: LongWord;
 516   ptag: Integer;
 517 begin
 518   result := false;
 519   if (tagmask = 0) then exit;
 520
 521   // make coords (0,0)-based
 522   Dec(x, mMinX);
 523   Dec(y, mMinY);
 524   if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
 525
 526   curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
 527   // restore coords
 528   Inc(x, mMinX);
 529   Inc(y, mMinY);
 530
 531   // increase query counter
 532   Inc(mLastQuery);
 533   if (mLastQuery = 0) then
 534   begin
 535     // just in case of overflow
 536     mLastQuery := 1;
 537     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 538   end;
 539   lq := mLastQuery;
 540
 541   while (curci <> -1) do
 542   begin
 543     cc := @mCells[curci];
 544     for f := 0 to High(TGridCell.bodies) do
 545     begin
 546       if (cc.bodies[f] = -1) then break;
 547       px := @mProxies[cc.bodies[f]];
 548       if (px.mQueryMark <> lq) then
 549       begin
 550         ptag := px.mTag;
 551         if ((ptag and TagDisabled) = 0) and ((px.mTag and tagmask) <> 0) then
 552         begin
 553           if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
 554           begin
 555             px.mQueryMark := lq;
 556             if assigned(cb) then result := cb(px.mObj, px.mTag) else result := true;
 557             if result then exit;
 558           end;
 559         end;
 560       end;
 561     end;
 562     curci := cc.next;
 563   end;
 564 end;
 565
 566
 567 // no callback: return `true` on the first hit
 568 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1): Boolean;
 569 var
 570   idx: Integer;
 571   gx, gy: Integer;
 572   curci: Integer;
 573   f: Integer;
 574   cc: PGridCell = nil;
 575   px: PBodyProxyRec;
 576   lq: LongWord;
 577   tsize, gw: Integer;
 578   x0, y0: Integer;
 579   ptag: Integer;
 580 begin
 581   result := false;
 582   if (w < 1) or (h < 1) then exit;
 583
 584   x0 := x;
 585   y0 := y;
 586
 587   // fix coords
 588   Dec(x, mMinX);
 589   Dec(y, mMinY);
 590
 591   gw := mWidth;
 592   tsize := mTileSize;
 593
 594   if (x+w <= 0) or (y+h <= 0) then exit;
 595   if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
 596
 597   // increase query counter
 598   Inc(mLastQuery);
 599   if (mLastQuery = 0) then
 600   begin
 601     // just in case of overflow
 602     mLastQuery := 1;
 603     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 604   end;
 605   //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
 606   lq := mLastQuery;
 607
 608   // go on
 609   for gy := y div tsize to (y+h-1) div tsize do
 610   begin
 611     if (gy < 0) then continue;
 612     if (gy >= mHeight) then break;
 613     for gx := x div tsize to (x+w-1) div tsize do
 614     begin
 615       if (gx < 0) then continue;
 616       if (gx >= gw) then break;
 617       // process cells
 618       curci := mGrid[gy*gw+gx];
 619       while (curci <> -1) do
 620       begin
 621         cc := @mCells[curci];
 622         for f := 0 to High(TGridCell.bodies) do
 623         begin
 624           if (cc.bodies[f] = -1) then break;
 625           px := @mProxies[cc.bodies[f]];
 626           if (px.mQueryMark <> lq) then
 627           begin
 628             ptag := px.mTag;
 629             if ((ptag and TagDisabled) = 0) and ((px.mTag and tagmask) <> 0) then
 630             begin
 631               if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
 632               if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
 633               px.mQueryMark := lq;
 634               if assigned(cb) then result := cb(px.mObj, px.mTag) else result := true;
 635               if result then exit;
 636             end;
 637           end;
 638         end;
 639         curci := cc.next;
 640       end;
 641     end;
 642   end;
 643 end;
 644
 645
 646 // ////////////////////////////////////////////////////////////////////////// //
 647 // no callback: return `true` on the nearest hit
 648 function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean;
 649 var
 650   ex, ey: Integer;
 651 begin
 652   result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
 653 end;
 654
 655
 656 // no callback: return `true` on the nearest hit
 657 function TBodyGridBase.traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): Boolean;
 658 var
 659   i: Integer;
 660   dx, dy: Integer;
 661   xerr: Integer = 0;
 662   yerr: Integer = 0;
 663   d: Integer;
 664   incx, incy: Integer;
 665   x, y: Integer;
 666   maxx, maxy: Integer;
 667   tsize: Integer; // tile size
 668   gw, gh: Integer;
 669   lastGA: Integer = -1;
 670   ga: Integer = -1; // last used grid address
 671   ccidx: Integer = -1;
 672   curci: Integer = -1;
 673   cc: PGridCell = nil;
 674   hasUntried: Boolean;
 675   f: Integer;
 676   px: PBodyProxyRec;
 677   lq: LongWord;
 678   prevX, prevY: Integer;
 679   minx, miny: Integer;
 680   ptag: Integer;
 681   lastDistSq, distSq: Integer;
 682   wasHit: Boolean = false;
 683 begin
 684   result := false;
 685
 686   if (tagmask = 0) then begin ex := x0; ey := y0; exit; end;
 687
 688   // make coords (0,0)-based
 689   minx := mMinX;
 690   miny := mMinY;
 691   Dec(x0, minx);
 692   Dec(y0, miny);
 693   Dec(x1, minx);
 694   Dec(y1, miny);
 695
 696   dx := x1-x0;
 697   dy := y1-y0;
 698
 699   if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
 700   if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
 701
 702   dx := abs(dx);
 703   dy := abs(dy);
 704
 705   if (dx > dy) then d := dx else d := dy;
 706
 707   x := x0;
 708   y := y0;
 709
 710   // increase query counter
 711   Inc(mLastQuery);
 712   if (mLastQuery = 0) then
 713   begin
 714     // just in case of overflow
 715     mLastQuery := 1;
 716     for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
 717   end;
 718   lq := mLastQuery;
 719
 720   tsize := mTileSize;
 721   gw := mWidth;
 722   gh := mHeight;
 723   maxx := gw*tsize-1;
 724   maxy := gh*tsize-1;
 725   lastDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1;
 726
 727   for i := 1 to d do
 728   begin
 729     prevX := x+minx;
 730     prevY := y+miny;
 731     Inc(xerr, dx); if (xerr >= d) then begin Dec(xerr, d); Inc(x, incx); end;
 732     Inc(yerr, dy); if (yerr >= d) then begin Dec(yerr, d); Inc(y, incy); end;
 733
 734     if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
 735     begin
 736       ga := (y div tsize)*gw+(x div tsize);
 737       if (lastGA <> ga) then
 738       begin
 739         // new cell
 740         lastGA := ga;
 741         ccidx := mGrid[lastGA];
 742       end;
 743     end
 744     else
 745     begin
 746       if (ccidx <> -1) then
 747       begin
 748         ccidx := -1;
 749         if assigned(cb) then result := cb(nil, 0, x+minx, y+miny, prevX, prevY) else result := wasHit;
 750         if result then exit;
 751       end;
 752     end;
 753
 754     if (ccidx <> -1) then
 755     begin
 756       curci := ccidx;
 757       hasUntried := false;
 758       Inc(x, minx);
 759       Inc(y, miny);
 760       while (curci <> -1) do
 761       begin
 762         cc := @mCells[curci];
 763         for f := 0 to High(TGridCell.bodies) do
 764         begin
 765           if (cc.bodies[f] = -1) then break;
 766           px := @mProxies[cc.bodies[f]];
 767           if (px.mQueryMark <> lq) then
 768           begin
 769             ptag := px.mTag;
 770             if ((ptag and TagDisabled) = 0) and ((px.mTag and tagmask) <> 0) then
 771             begin
 772               if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
 773               begin
 774                 px.mQueryMark := lq;
 775                 if assigned(cb) then
 776                 begin
 777                   result := cb(px.mObj, px.mTag, x, y, prevX, prevY);
 778                   if result then begin ex := prevX; ey := prevY; exit; end;
 779                 end
 780                 else
 781                 begin
 782                   distSq := (prevX-x)*(prevX-x)+(prevY-y)*(prevY-y);
 783                   if (distSq < lastDistSq) then
 784                   begin
 785                     wasHit := true;
 786                     lastDistSq := distSq;
 787                     ex := prevx;
 788                     ey := prevy;
 789                   end;
 790                 end;
 791               end
 792               else
 793               begin
 794                 hasUntried := true;
 795               end;
 796             end;
 797           end;
 798         end;
 799         curci := cc.next;
 800       end;
 801       if not hasUntried then
 802       begin
 803         // don't process this cell anymore
 804         ccidx := -1;
 805         if assigned(cb) then result := cb(nil, 0, x, y, prevX, prevY) else result := wasHit;
 806         if result then exit; // don't update lasthit: it is done in real checker
 807       end;
 808       Dec(x, minx);
 809       Dec(y, miny);
 810     end;
 811   end;
 812 end;
 813
 814
 815 end.