src/game/g_sap.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 {$INCLUDE ../shared/a_modes.inc}
  17 // universal sweep-and-prune broad phase
  18 unit g_sap;
  19
  20 interface
  21
  22 type
  23   TSAPQueryCB = function (obj: TObject; tag: Integer): Boolean is nested; // return `true` to stop
  24
  25 type
  26   TSAPProxy = Integer;
  27
  28   PSAPProxyRec = ^TSAPProxyRec;
  29   TSAPProxyRec = record
  30   private
  31     mX, mY, mWidth, mHeight: Integer; // aabb
  32     mQueryMark: DWord; // was this object visited at this query?
  33     mObj: TObject;
  34     mTag: Integer;
  35     //nextLink: TSAPProxy; // next free or nothing
  36     mIIdx: array [0..1] of Integer; // indicies in corresponding intervals
  37
  38   private
  39     procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  40
  41   public
  42     property x: Integer read mX;
  43     property y: Integer read mY;
  44     property width: Integer read mWidth;
  45     property height: Integer read mHeight;
  46     property obj: TObject read mObj;
  47     property tag: Integer read mTag;
  48     //property grid: TBodyGrid read mGrid;
  49   end;
  50
  51
  52   TSweepAndPrune = class(TObject)
  53   private
  54     type
  55       //PInterval = ^TInterval;
  56       TInterval = record
  57       public
  58         min, max: Integer;
  59         pidx: Integer; // proxy idx
  60
  61       public
  62         function less (var i: TInterval): Boolean; inline;
  63         function intersects (v0, v1: Integer): Boolean; inline;
  64       end;
  65
  66   private
  67     mLastQuery: DWord;
  68     mIntrs: array[0..1] of array of TInterval;
  69     mIntrsUsed: array[0..1] of Integer;
  70     mProxies: array of TSAPProxyRec;
  71     mProxyFree: TSAPProxy; // free
  72     mProxyCount: Integer; // currently used
  73     mProxyMaxCount: Integer;
  74     mUpdateBlocked: Integer; // >0: updates are blocked
  75
  76   private
  77     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TSAPProxy;
  78     procedure freeProxy (body: TSAPProxy);
  79
  80     procedure sortIntervals ();
  81
  82     procedure insert (body: TSAPProxy);
  83     //procedure remove (body: TSAPProxy);
  84
  85   public
  86     constructor Create ();
  87     destructor Destroy (); override;
  88
  89     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TSAPProxy;
  90     //procedure removeBody (aObj: TSAPProxy); // WARNING! this WILL destroy proxy!
  91
  92     //procedure moveBody (body: TSAPProxy; dx, dy: Integer);
  93     //procedure resizeBody (body: TSAPProxy; sx, sy: Integer);
  94     //procedure moveResizeBody (body: TSAPProxy; dx, dy, sx, sy: Integer);
  95
  96     function forEachInAABB (x, y, w, h: Integer; cb: TSAPQueryCB): Boolean;
  97
  98     //function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TSAPProxy;
  99
 100     // call these functions before massive update (it may, or may be not faster)
 101     procedure batchUpdateBegin ();
 102     procedure batchUpdateEnd ();
 103
 104     procedure dumpStats ();
 105   end;
 106
 107
 108 implementation
 109
 110 uses
 111   SysUtils, e_log;
 112
 113
 114 // ////////////////////////////////////////////////////////////////////////// //
 115 procedure TSAPProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 116 begin
 117   mX := aX;
 118   mY := aY;
 119   mWidth := aWidth;
 120   mHeight := aHeight;
 121   mQueryMark := 0;
 122   mObj := aObj;
 123   mTag := aTag;
 124   //nextLink := -1;
 125   mIIdx[0] := -1;
 126   mIIdx[1] := -1;
 127 end;
 128
 129
 130 // ////////////////////////////////////////////////////////////////////////// //
 131 function TSweepAndPrune.TInterval.less (var i: TInterval): Boolean;
 132 var
 133   n: Integer;
 134 begin
 135   n := min-i.min;
 136   if (n <> 0) then begin result := (n < 0); exit; end;
 137   n := max-i.max;
 138   if (n <> 0) then begin result := (n < 0); exit; end;
 139   result := (pidx < i.pidx);
 140 end;
 141
 142
 143 // v0 MUST be <= v1!
 144 function TSweepAndPrune.TInterval.intersects (v0, v1: Integer): Boolean;
 145 begin
 146   result := false;
 147   if (v1 < min) or (v0 > max) then exit;
 148   result := true;
 149 end;
 150
 151
 152 // ////////////////////////////////////////////////////////////////////////// //
 153 constructor TSweepAndPrune.Create ();
 154 var
 155   idx: Integer;
 156 begin
 157   mLastQuery := 0;
 158
 159   // init intervals
 160   for idx := 0 to High(mIntrs) do
 161   begin
 162     SetLength(mIntrs[idx], 8192);
 163     mIntrsUsed[idx] := 0;
 164   end;
 165
 166   // init proxies
 167   SetLength(mProxies, 8192);
 168   for idx := 0 to High(mProxies) do
 169   begin
 170     mProxies[idx].mIIdx[0] := idx+1;
 171     mProxies[idx].mIIdx[1] := -1;
 172   end;
 173   mProxies[High(mProxies)].mIIdx[0] := -1;
 174
 175   mProxyFree := 0;
 176   mProxyCount := 0;
 177   mProxyMaxCount := 0;
 178
 179   mUpdateBlocked := 0;
 180
 181   //e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
 182 end;
 183
 184
 185 destructor TSweepAndPrune.Destroy ();
 186 var
 187   idx: Integer;
 188 begin
 189   mProxies := nil;
 190   for idx := 0 to High(mIntrs) do mIntrs[idx] := nil;
 191   inherited;
 192 end;
 193
 194
 195 procedure TSweepAndPrune.dumpStats ();
 196 begin
 197   e_WriteLog(Format('used intervals: %d; max proxies allocated: %d; proxies used: %d', [mIntrsUsed[0], mProxyMaxCount, mProxyCount]), MSG_NOTIFY);
 198 end;
 199
 200
 201 procedure TSweepAndPrune.batchUpdateBegin ();
 202 begin
 203   Inc(mUpdateBlocked);
 204 end;
 205
 206
 207 procedure TSweepAndPrune.batchUpdateEnd ();
 208 begin
 209   if (mUpdateBlocked > 0) then
 210   begin
 211     Dec(mUpdateBlocked);
 212     if (mUpdateBlocked = 0) then sortIntervals();
 213   end;
 214 end;
 215
 216
 217 function TSweepAndPrune.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TSAPProxy;
 218 var
 219   olen, idx: Integer;
 220   px: PSAPProxyRec;
 221 begin
 222   if (mProxyFree = -1) then
 223   begin
 224     // no free proxies, resize list
 225     olen := Length(mProxies);
 226     SetLength(mProxies, olen+8192); // arbitrary number
 227     for idx := olen to High(mProxies) do mProxies[idx].mIIdx[0] := idx+1;
 228     mProxies[High(mProxies)].mIIdx[0] := -1;
 229     mProxyFree := olen;
 230   end;
 231   // get one from list
 232   result := mProxyFree;
 233   px := @mProxies[result];
 234   mProxyFree := px.mIIdx[0];
 235   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 236   // add to used list
 237   px.mIIdx[0] := -1;
 238   // statistics
 239   Inc(mProxyCount);
 240   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 241 end;
 242
 243 procedure TSweepAndPrune.freeProxy (body: TSAPProxy);
 244 begin
 245   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 246   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 247   // add to free list
 248   mProxies[body].mObj := nil;
 249   mProxies[body].mIIdx[0] := mProxyFree;
 250   mProxies[body].mIIdx[1] := -1;
 251   mProxyFree := body;
 252   Dec(mProxyCount);
 253 end;
 254
 255
 256 procedure TSweepAndPrune.sortIntervals ();
 257   procedure insSort (var arr: array of TInterval; iidx: Integer);
 258   var
 259     i, j: Integer;
 260     x: TInterval;
 261   begin
 262     if (Length(arr) < 2) then exit; // nothing to do
 263     i := 1;
 264     while (i < Length(arr)) do
 265     begin
 266       if (arr[i].less(arr[i-1])) then
 267       begin
 268         x := arr[i];
 269         j := i-1;
 270         while (j >= 0) and (x.less(arr[j])) do
 271         begin
 272           arr[j+1] := arr[j];
 273           mProxies[arr[j+1].pidx].mIIdx[iidx] := j+1;
 274           Dec(j);
 275         end;
 276         mProxies[x.pidx].mIIdx[iidx] := j+1;
 277         arr[j+1] := x;
 278       end;
 279       Inc(i);
 280     end;
 281   end;
 282
 283 begin
 284   insSort(mIntrs[0], 0);
 285   insSort(mIntrs[1], 1);
 286 end;
 287
 288
 289 procedure TSweepAndPrune.insert (body: TSAPProxy);
 290 var
 291   px: PSAPProxyRec;
 292
 293   procedure insIntr (v0, v1, iidx: Integer);
 294   var
 295     i: Integer;
 296   begin
 297     i := mIntrsUsed[iidx];
 298     if (i >= Length(mIntrs[iidx])) then SetLength(mIntrs[iidx], i+8192);
 299     mIntrs[iidx][i].min := v0;
 300     mIntrs[iidx][i].max := v1;
 301     mIntrs[iidx][i].pidx := i;
 302     Inc(mIntrsUsed[iidx]);
 303   end;
 304
 305 begin
 306   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 307   px := @mProxies[body];
 308   insIntr(px.mX, px.mX+px.mWidth-1, 0);
 309   insIntr(px.mY, px.mY+px.mHeight-1, 1);
 310 end;
 311
 312
 313 function TSweepAndPrune.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TSAPProxy;
 314 begin
 315   if (aObj = nil) or (aWidth < 1) or (aHeight < 1) then begin result := -1; exit; end;
 316   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 317   insert(result);
 318 end;
 319
 320
 321 function TSweepAndPrune.forEachInAABB (x, y, w, h: Integer; cb: TSAPQueryCB): Boolean;
 322
 323   function walkInterval (val0, val1, lq, iidx: Integer): Boolean;
 324   var
 325     i, bot, mid, cmp: Integer;
 326     px: PSAPProxyRec;
 327   begin
 328     result := false;
 329     if (mIntrsUsed[iidx] < 1) then exit; // nothing to do
 330     if (mIntrsUsed[iidx] = 1) then
 331     begin
 332       // one element
 333       i := 0;
 334     end
 335     else
 336     begin
 337       // do search
 338       bot := 0;
 339       i := mIntrsUsed[iidx]-1;
 340       while (bot <> i) do
 341       begin
 342         mid := i-(i-bot) div 2;
 343         cmp := val0-mIntrs[iidx][mid].min;
 344         if (cmp = 0) then break;
 345         if (cmp < 0) then i := mid-1 else bot := mid;
 346       end;
 347       //return (cmpfn(lines+i) == 0 ? i : -1);
 348       if (i > 0) and not mIntrs[iidx][i].intersects(val0, val1) and mIntrs[iidx][i-1].intersects(val0, val1) then Dec(i);
 349       if (i+1 < mIntrsUsed[iidx]) and not mIntrs[iidx][i].intersects(val0, val1) and mIntrs[iidx][i+1].intersects(val0, val1) then Inc(i);
 350       while (i > 0) and mIntrs[iidx][i].intersects(val0, val1) do Dec(i);
 351       if (iidx = 0) then
 352       begin
 353         // first pass
 354         while (i < mIntrsUsed[iidx]) and mIntrs[iidx][i].intersects(val0, val1) do
 355         begin
 356           mProxies[mIntrs[iidx][i].pidx].mQueryMark := lq;
 357           Inc(i);
 358         end;
 359       end
 360       else
 361       begin
 362         // second pass
 363         while (i < mIntrsUsed[iidx]) and mIntrs[iidx][i].intersects(val0, val1) do
 364         begin
 365           px := @mProxies[mIntrs[iidx][i].pidx];
 366           if (px.mQueryMark = lq) then
 367           begin
 368             result := cb(px.mObj, px.mTag);
 369             if result then exit;
 370           end;
 371           Inc(i);
 372         end;
 373       end;
 374     end;
 375   end;
 376
 377 var
 378   idx: Integer;
 379 begin
 380   result := false;
 381   if not assigned(cb) then exit; // no callback, not interesting
 382   if (w < 1) or (h < 1) then exit; // nothing to do
 383
 384   // increase query counter
 385   Inc(mLastQuery);
 386   if (mLastQuery = 0) then
 387   begin
 388     // just in case of overflow
 389     mLastQuery := 1;
 390     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 391   end;
 392
 393   (*
 394    * the algorithm is simple:
 395    *   find start for first interval (binary search will do)
 396    *   walk the interval, marking proxies with mLastQuery
 397    *   increment mLastQuery
 398    *   find start for second interval (binary search will do)
 399    *   walk the interval, returning proxies marked with mLastQuery
 400    *)
 401   walkInterval(x, x+w-1, mLastQuery, 0);
 402   result := walkInterval(x, x+w-1, mLastQuery, 1);
 403 end;
 404
 405
 406 end.