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