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 // universal sweep-and-prune broad phase
  17 {$INCLUDE ../shared/a_modes.inc}
  18 {$DEFINE SAP_CHECKS}
  19 {$DEFINE SAP_ALWAYS_SORT}
  20 {$DEFINE SAP_WALK_DEBUG}
  21 {$DEFINE SAP_INSERT_DEBUG}
  22 unit g_sap;
  23
  24 interface
  25
  26 type
  27   TSAPQueryCB = function (obj: TObject; tag: Integer): Boolean is nested; // return `true` to stop
  28
  29 type
  30   TSAPProxy = Integer;
  31
  32   PSAPProxyRec = ^TSAPProxyRec;
  33   TSAPProxyRec = record
  34   private
  35     mX, mY, mWidth, mHeight: Integer; // aabb
  36     mQueryMark: DWord; // was this object visited at this query?
  37     mObj: TObject;
  38     mTag: Integer;
  39     mIdx: array [Boolean, 0..1] of Integer; // indicies in corresponding intervals
  40
  41   private
  42     procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
  43
  44     function getx1 (): Integer; inline;
  45     function gety1 (): Integer; inline;
  46
  47     function getidx (ismin: Boolean; iidx: Integer): Integer; inline;
  48     procedure setidx (ismin: Boolean; iidx: Integer; v: Integer); inline;
  49
  50     function getnextfree (): Integer;
  51     procedure setnextfree (v: Integer);
  52
  53   public
  54     property x: Integer read mX;
  55     property y: Integer read mY;
  56     property width: Integer read mWidth;
  57     property height: Integer read mHeight;
  58     property x0: Integer read mX;
  59     property y0: Integer read mY;
  60     property x1: Integer read getx1;
  61     property y1: Integer read gety1;
  62     property obj: TObject read mObj;
  63     property tag: Integer read mTag;
  64     property idx[ismin: Boolean; iidx: Integer]: Integer read getidx write setidx;
  65     property nextfree: Integer read getnextfree write setnextfree;
  66   end;
  67
  68
  69   TSweepAndPrune = class(TObject)
  70   private
  71     type
  72       PIntervalRec = ^TIntervalRec;
  73       TIntervalRec = record
  74       public
  75         val: Integer;
  76         mpidx: DWord; // proxy idx; bit 31 is "ismin"
  77
  78       public
  79         function less (var i: TIntervalRec): Boolean; inline;
  80         function inside (v0, v1: Integer): Boolean; inline;
  81
  82         function getismin (): Boolean; inline;
  83         procedure setismin (v: Boolean); inline;
  84
  85         function getpidx (): Integer; inline;
  86         procedure setpidx (v: Integer); inline;
  87
  88         property ismin: Boolean read getismin write setismin;
  89         property pidx: Integer read getpidx write setpidx;
  90       end;
  91
  92       TInterval = record
  93       public
  94         type
  95           TWalkCB = function (pidx: Integer; px: PSAPProxyRec): Boolean is nested; // return `true` to stop
  96
  97       public
  98         intrs: array of TIntervalRec;
  99         used: Integer;
 100         mProxies: array of TSAPProxyRec; // copy of main mProxies
 101         myidx: Integer; // index of this interval
 102
 103       public
 104         procedure setup (aIdx: Integer);
 105         procedure cleanup ();
 106
 107         procedure sort ();
 108         procedure insert (apidx: Integer);
 109
 110         function walk (v0, v1: Integer; cb: TWalkCB): Boolean;
 111
 112         procedure dump ();
 113       end;
 114
 115   private
 116     mLastQuery: DWord;
 117     mIntrs: array[0..1] of TInterval;
 118     mProxies: array of TSAPProxyRec;
 119     mProxyFree: TSAPProxy; // free
 120     mProxyCount: Integer; // currently used
 121     mProxyMaxCount: Integer;
 122     mUpdateBlocked: Integer; // >0: updates are blocked
 123
 124   private
 125     function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TSAPProxy;
 126     procedure freeProxy (body: TSAPProxy);
 127
 128     procedure sortIntervals ();
 129
 130     procedure insert (body: TSAPProxy);
 131     //procedure remove (body: TSAPProxy);
 132
 133   public
 134     constructor Create ();
 135     destructor Destroy (); override;
 136
 137     function insertBody (aObj: TObject; ax, ay, aWidth, aHeight: Integer; aTag: Integer=0): TSAPProxy;
 138     //procedure removeBody (aObj: TSAPProxy); // WARNING! this WILL destroy proxy!
 139
 140     //procedure moveBody (body: TSAPProxy; dx, dy: Integer);
 141     //procedure resizeBody (body: TSAPProxy; sx, sy: Integer);
 142     //procedure moveResizeBody (body: TSAPProxy; dx, dy, sx, sy: Integer);
 143
 144     function forEachInAABB (x, y, w, h: Integer; cb: TSAPQueryCB): Boolean;
 145
 146     //function getProxyForBody (aObj: TObject; x, y, w, h: Integer): TSAPProxy;
 147
 148     // call these functions before massive update (it may, or may be not faster)
 149     procedure batchUpdateBegin ();
 150     procedure batchUpdateEnd ();
 151
 152     procedure dumpStats ();
 153   end;
 154
 155
 156 implementation
 157
 158 uses
 159   SysUtils, e_log;
 160
 161
 162 // ////////////////////////////////////////////////////////////////////////// //
 163 procedure TSAPProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer);
 164 begin
 165   mX := aX;
 166   mY := aY;
 167   mWidth := aWidth;
 168   mHeight := aHeight;
 169   mQueryMark := 0;
 170   mObj := aObj;
 171   mTag := aTag;
 172   mIdx[false, 0] := -1;
 173   mIdx[false, 1] := -1;
 174   mIdx[true, 0] := -1;
 175   mIdx[true, 1] := -1;
 176 end;
 177
 178 function TSAPProxyRec.getx1 (): Integer; begin result := mX+mWidth-1; end;
 179 function TSAPProxyRec.gety1 (): Integer; begin result := mY+mHeight-1; end;
 180
 181 function TSAPProxyRec.getidx (ismin: Boolean; iidx: Integer): Integer; begin result := mIdx[ismin, iidx]; end;
 182 procedure TSAPProxyRec.setidx (ismin: Boolean; iidx: Integer; v: Integer); begin mIdx[ismin, iidx] := v; end;
 183
 184 function TSAPProxyRec.getnextfree (): Integer; begin result := mIdx[false, 0]; end;
 185 procedure TSAPProxyRec.setnextfree (v: Integer); begin mIdx[false, 0] := v; end;
 186
 187
 188 // ////////////////////////////////////////////////////////////////////////// //
 189 function TSweepAndPrune.TIntervalRec.getismin (): Boolean; begin result := ((mpidx and $80000000) <> 0); end;
 190 procedure TSweepAndPrune.TIntervalRec.setismin (v: Boolean); begin if (v) then mpidx := mpidx or $80000000 else mpidx := mpidx and $7fffffff; end;
 191
 192 function TSweepAndPrune.TIntervalRec.getpidx (): Integer; begin result := Integer(mpidx and $7fffffff); end;
 193 procedure TSweepAndPrune.TIntervalRec.setpidx (v: Integer); begin mpidx := (v and $7fffffff) or (mpidx and $80000000); end;
 194
 195
 196 function TSweepAndPrune.TIntervalRec.less (var i: TIntervalRec): Boolean;
 197 var
 198   n: Integer;
 199 begin
 200   n := val-i.val;
 201   if (n <> 0) then result := (n < 0) else result := (pidx < i.pidx);
 202 end;
 203
 204
 205 // v0 MUST be <= v1!
 206 function TSweepAndPrune.TIntervalRec.inside (v0, v1: Integer): Boolean;
 207 begin
 208   result := (val >= v0) and (val <= v1);
 209 end;
 210
 211
 212 // ////////////////////////////////////////////////////////////////////////// //
 213 procedure TSweepAndPrune.TInterval.setup (aIdx: Integer);
 214 begin
 215   SetLength(intrs, 8192*2);
 216   used := 0;
 217   mProxies := nil;
 218   myidx := aIdx;
 219 end;
 220
 221
 222 procedure TSweepAndPrune.TInterval.cleanup ();
 223 begin
 224   intrs := nil;
 225   mProxies := nil;
 226 end;
 227
 228
 229 procedure TSweepAndPrune.TInterval.sort ();
 230 var
 231   len, i, j: Integer;
 232   x: TIntervalRec;
 233   arr: array of TIntervalRec;
 234   pxa: array of TSAPProxyRec;
 235   iidx: Integer;
 236 begin
 237   len := used;
 238   if (len = 0) then exit;
 239   arr := intrs;
 240   pxa := mProxies;
 241   iidx := myidx;
 242   {$IFDEF SAP_CHECKS}
 243   for i := 0 to len-1 do
 244   begin
 245     if (pxa[arr[i].pidx].idx[arr[i].ismin, iidx] <> i) then
 246     begin
 247       e_WriteLog(Format('FUCKUP: interval %d; i=%d; val=%d; ismin=%d; got=%d', [iidx, i, arr[i].val, Integer(arr[i].ismin), pxa[arr[i].pidx].idx[arr[i].ismin, iidx]]), MSG_NOTIFY);
 248       dump();
 249       raise Exception.Create('sorting fuckup (5)');
 250     end;
 251   end;
 252   {$ENDIF}
 253   if (len > 1) then
 254   begin
 255     i := 1;
 256     while (i < len) do
 257     begin
 258       if (arr[i].less(arr[i-1])) then
 259       begin
 260         x := arr[i];
 261         j := i-1;
 262         while (j >= 0) and (x.less(arr[j])) do
 263         begin
 264           arr[j+1] := arr[j];
 265           pxa[arr[j+1].pidx].idx[arr[j+1].ismin, iidx] := j+1;
 266           Dec(j);
 267         end;
 268         pxa[x.pidx].idx[x.ismin, iidx] := j+1;
 269         arr[j+1] := x;
 270       end;
 271       Inc(i);
 272     end;
 273   end;
 274   // check
 275   {$IFDEF SAP_CHECKS}
 276   for i := 0 to len-1 do
 277   begin
 278     if (i <> 0) then
 279     begin
 280       if arr[i].less(arr[i-1]) then begin dump(); raise Exception.Create('sorting fuckup (2)'); end;
 281       if (arr[i-1].val > arr[i].val) then begin dump(); raise Exception.Create('sorting fuckup (3)'); end;
 282     end;
 283     if (pxa[arr[i].pidx].idx[arr[i].ismin, iidx] <> i) then begin dump(); raise Exception.Create('sorting fuckup (4)'); end;
 284   end;
 285   {$ENDIF}
 286 end;
 287
 288
 289 procedure TSweepAndPrune.TInterval.insert (apidx: Integer);
 290 var
 291   v0, v1, i: Integer;
 292   pi: PIntervalRec;
 293   px: PSAPProxyRec;
 294 begin
 295   px := @mProxies[apidx];
 296   // get min/max
 297   if (myidx = 0) then
 298   begin
 299     v0 := px.x0;
 300     v1 := px.x1;
 301   end
 302   else
 303   begin
 304     v0 := px.y0;
 305     v1 := px.y1;
 306   end;
 307   // append min
 308   i := used;
 309   if (i+2 >= Length(intrs)) then SetLength(intrs, i+8192*2);
 310   {$IFDEF SAP_INSERT_DEBUG}
 311   e_WriteLog(Format('inserting proxy %d into interval %d; v0=%d; i=%d', [apidx, myidx, v0, i]), MSG_NOTIFY);
 312   {$ENDIF}
 313   pi := @intrs[i];
 314   pi.val := v0;
 315   pi.pidx := apidx;
 316   pi.ismin := true;
 317   px.idx[true, myidx] := i;
 318   // append max
 319   Inc(i);
 320   {$IFDEF SAP_INSERT_DEBUG}
 321   e_WriteLog(Format('inserting proxy %d into interval %d; v1=%d; i=%d', [apidx, myidx, v1, i]), MSG_NOTIFY);
 322   {$ENDIF}
 323   pi := @intrs[i];
 324   pi.val := v1;
 325   pi.pidx := apidx;
 326   pi.ismin := false;
 327   px.idx[false, myidx] := i;
 328   // done
 329   Inc(used, 2);
 330   {$IFDEF SAP_CHECKS}
 331   if (used <> i+1) then raise Exception.Create('something is VERY wrong in SAP');
 332   {$ENDIF}
 333 end;
 334
 335
 336 function TSweepAndPrune.TInterval.walk (v0, v1: Integer; cb: TWalkCB): Boolean;
 337 var
 338   len: Integer;
 339   i, bot, mid, cmp: Integer;
 340   px: PSAPProxyRec;
 341   arr: array of TIntervalRec;
 342   pxa: array of TSAPProxyRec;
 343 begin
 344   result := false;
 345   if not assigned(cb) or (v0 > v1) then exit; // alas
 346   len := used;
 347   if (len < 1) then exit; // nothing to do
 348   arr := intrs;
 349   pxa := mProxies;
 350
 351   {$IFDEF SAP_WALK_DEBUG}
 352   e_WriteLog(Format('walking interval #%d; v0=%d; v1=%d; len=%d', [myidx, v0, v1, len]), MSG_NOTIFY);
 353   {$ENDIF}
 354
 355   if (len = 1) then
 356   begin
 357     // one element
 358     i := 0;
 359   end
 360   else
 361   begin
 362     // do search
 363     bot := 0;
 364     i := len-1;
 365     while (bot <> i) do
 366     begin
 367       mid := i-(i-bot) div 2;
 368       cmp := v0-arr[mid].val;
 369       if (cmp = 0) then break;
 370       if (cmp < 0) then i := mid-1 else bot := mid;
 371     end;
 372     //return (cmpfn(lines+i) == 0 ? i : -1);
 373     {$IFDEF SAP_WALK_DEBUG}
 374     e_WriteLog(Format('  binsearch interval #%d; i=%d; len=%d; isect=%d', [myidx, i, len, Integer(arr[i].inside(v0, v1))]), MSG_NOTIFY);
 375     {$ENDIF}
 376     if not arr[i].inside(v0, v1) then
 377     begin
 378       {$IFDEF SAP_WALK_DEBUG}e_WriteLog('    bin: not good', MSG_NOTIFY);{$ENDIF}
 379            if (i > 0) and arr[i-1].inside(v0, v1) then begin Dec(i); {$IFDEF SAP_WALK_DEBUG}e_WriteLog('    bin: up', MSG_NOTIFY);{$ENDIF} end
 380       else if (i+1 < len) and arr[i+1].inside(v0, v1) then begin Inc(i); {$IFDEF SAP_WALK_DEBUG}e_WriteLog('    bin: down', MSG_NOTIFY);{$ENDIF} end
 381       else begin {$IFDEF SAP_WALK_DEBUG}e_WriteLog('    bin: wtf?!', MSG_NOTIFY);{$ENDIF} end;
 382     end;
 383     // find first interval
 384     while (i > 0) and arr[i-1].inside(v0, v1) do Dec(i);
 385   end;
 386
 387   {$IFDEF SAP_WALK_DEBUG}
 388   if (i >= 0) and (i < len) and arr[i].inside(v0, v1) then
 389     e_WriteLog(Format('  start interval #%d; i=%d; v0=%d; v1=%d; len=%d; val=%d; ismin=%d', [myidx, i, v0, v1, len, arr[i].val, Integer(arr[i].ismin)]), MSG_NOTIFY);
 390   {$ENDIF}
 391
 392   // walk
 393   while (i >= 0) and (i < len) and arr[i].inside(v0, v1) do
 394   begin
 395     px := @pxa[arr[i].pidx];
 396     result := cb(arr[i].pidx, px);
 397     if result then break;
 398     Inc(i);
 399   end;
 400
 401   {$IFDEF SAP_WALK_DEBUG}
 402   Dec(i);
 403   if (i >= 0) and (i < len) then
 404     e_WriteLog(Format('  end interval #%d; i=%d; v0=%d; v1=%d; len=%d; val=%d; ismin=%d', [myidx, i, v0, v1, len, arr[i].val, Integer(arr[i].ismin)]), MSG_NOTIFY);
 405   {$ENDIF}
 406 end;
 407
 408
 409 procedure TSweepAndPrune.TInterval.dump ();
 410 var
 411   idx: Integer;
 412   pi: PIntervalRec;
 413 begin
 414   e_WriteLog(Format('interval #%d; len=%d', [myidx, used]), MSG_NOTIFY);
 415   for idx := 0 to used-1 do
 416   begin
 417     pi := @intrs[idx];
 418     e_WriteLog(Format('  pi #%d; val=%d; ismin=%d; pidx=%d; px0=%d; py0=%d; px1=%d; py1=%d', [idx, pi.val, Integer(pi.ismin), pi.pidx, mProxies[pi.pidx].x0, mProxies[pi.pidx].y0, mProxies[pi.pidx].x1, mProxies[pi.pidx].y1]), MSG_NOTIFY);
 419   end;
 420 end;
 421
 422
 423 // ////////////////////////////////////////////////////////////////////////// //
 424 constructor TSweepAndPrune.Create ();
 425 var
 426   idx: Integer;
 427 begin
 428   mLastQuery := 0;
 429
 430   // init proxies
 431   SetLength(mProxies, 8192);
 432   for idx := 0 to High(mProxies) do
 433   begin
 434     mProxies[idx].idx[true, 0] := idx+1;
 435     mProxies[idx].idx[true, 1] := -1;
 436     mProxies[idx].idx[false, 0] := -1;
 437     mProxies[idx].idx[false, 1] := -1;
 438   end;
 439   mProxies[High(mProxies)].idx[true, 0] := -1;
 440
 441   // init intervals
 442   for idx := 0 to High(mIntrs) do
 443   begin
 444     mIntrs[idx].setup(idx);
 445     mIntrs[idx].mProxies := mProxies;
 446   end;
 447
 448   mProxyFree := 0;
 449   mProxyCount := 0;
 450   mProxyMaxCount := 0;
 451
 452   mUpdateBlocked := 0;
 453 end;
 454
 455
 456 destructor TSweepAndPrune.Destroy ();
 457 var
 458   idx: Integer;
 459 begin
 460   for idx := 0 to High(mIntrs) do mIntrs[idx].cleanup();
 461   mProxies := nil;
 462   inherited;
 463 end;
 464
 465
 466 procedure TSweepAndPrune.dumpStats ();
 467 begin
 468   e_WriteLog(Format('used intervals: [%d;%d]; max proxies allocated: %d; proxies used: %d', [mIntrs[0].used, mIntrs[1].used, mProxyMaxCount, mProxyCount]), MSG_NOTIFY);
 469   mIntrs[0].dump();
 470   mIntrs[1].dump();
 471 end;
 472
 473
 474 procedure TSweepAndPrune.batchUpdateBegin ();
 475 begin
 476   Inc(mUpdateBlocked);
 477 end;
 478
 479
 480 procedure TSweepAndPrune.batchUpdateEnd ();
 481 begin
 482   if (mUpdateBlocked > 0) then
 483   begin
 484     Dec(mUpdateBlocked);
 485     if (mUpdateBlocked = 0) then sortIntervals();
 486   end;
 487 end;
 488
 489
 490 function TSweepAndPrune.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: TObject; aTag: Integer): TSAPProxy;
 491 var
 492   olen, idx: Integer;
 493   px: PSAPProxyRec;
 494 begin
 495   if (mProxyFree = -1) then
 496   begin
 497     // no free proxies, resize list
 498     olen := Length(mProxies);
 499     SetLength(mProxies, olen+8192); // arbitrary number
 500     for idx := olen to High(mProxies) do mProxies[idx].idx[true, 0] := idx+1;
 501     mProxies[High(mProxies)].idx[true, 0] := -1;
 502     mProxyFree := olen;
 503     // fix intervals cache
 504     for idx := 0 to High(mIntrs) do mIntrs[idx].mProxies := mProxies;
 505   end;
 506   // get one from list
 507   result := mProxyFree;
 508   px := @mProxies[result];
 509   mProxyFree := px.idx[true, 0];
 510   px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
 511   // add to used list
 512   px.idx[true, 0] := idx+1;
 513   px.idx[true, 1] := -1;
 514   px.idx[false, 0] := -1;
 515   px.idx[false, 1] := -1;
 516   // statistics
 517   Inc(mProxyCount);
 518   if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
 519 end;
 520
 521
 522 procedure TSweepAndPrune.freeProxy (body: TSAPProxy);
 523 var
 524   px: PSAPProxyRec;
 525 begin
 526   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 527   if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
 528   // add to free list
 529   px := @mProxies[body];
 530   px.mObj := nil;
 531   px.idx[true, 0] := mProxyFree;
 532   px.idx[true, 1] := -1;
 533   px.idx[false, 0] := -1;
 534   px.idx[false, 1] := -1;
 535   mProxyFree := body;
 536   Dec(mProxyCount);
 537 end;
 538
 539
 540 procedure TSweepAndPrune.sortIntervals ();
 541 begin
 542   mIntrs[0].sort();
 543   mIntrs[1].sort();
 544 end;
 545
 546
 547 procedure TSweepAndPrune.insert (body: TSAPProxy);
 548 begin
 549   if (body < 0) or (body > High(mProxies)) then exit; // just in case
 550   mIntrs[0].insert(body);
 551   mIntrs[1].insert(body);
 552   {$IFDEF SAP_ALWAYS_SORT}
 553   sortIntervals();
 554   {$ELSE}
 555   if (mUpdateBlocked = 0) then sortIntervals();
 556   {$ENDIF}
 557 end;
 558
 559
 560 function TSweepAndPrune.insertBody (aObj: TObject; aX, aY, aWidth, aHeight: Integer; aTag: Integer=0): TSAPProxy;
 561 begin
 562   if (aObj = nil) or (aWidth < 1) or (aHeight < 1) then begin result := -1; exit; end;
 563   result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
 564   insert(result);
 565 end;
 566
 567
 568 function TSweepAndPrune.forEachInAABB (x, y, w, h: Integer; cb: TSAPQueryCB): Boolean;
 569 var
 570   lq: Integer;
 571
 572   function walker0 (pidx: Integer; px: PSAPProxyRec): Boolean;
 573   begin
 574     result := false; // don't stop
 575     {$IFDEF SAP_WALK_DEBUG}
 576     e_WriteLog(Format('    walker0: pidx=%d; x0=%d; y0=%d; x1=%d; y1=%d; lq=%d', [pidx, px.x0, px.y0, px.x1, px.y1, lq]), MSG_NOTIFY);
 577     {$ENDIF}
 578     px.mQueryMark := lq;
 579   end;
 580
 581   function walker1 (pidx: Integer; px: PSAPProxyRec): Boolean;
 582   begin
 583     {$IFDEF SAP_WALK_DEBUG}
 584     e_WriteLog(Format('    walker1: pidx=%d; x0=%d; y0=%d; x1=%d; y1=%d; lq=%d', [pidx, px.x0, px.y0, px.x1, px.y1, px.mQueryMark]), MSG_NOTIFY);
 585     {$ENDIF}
 586     if (px.mQueryMark = lq) then
 587     begin
 588       result := cb(px.mObj, px.mTag);
 589       {$IFDEF SAP_WALK_DEBUG}
 590       e_WriteLog(Format('      CB walker1: pidx=%d; x0=%d; y0=%d; x1=%d; y1=%d; lq=%d; res=%d', [pidx, px.x0, px.y0, px.x1, px.y1, px.mQueryMark, Integer(result)]), MSG_NOTIFY);
 591       {$ENDIF}
 592     end
 593     else
 594     begin
 595       result := false; // don't stop
 596     end;
 597   end;
 598
 599 var
 600   idx: Integer;
 601 begin
 602   result := false;
 603   if not assigned(cb) then exit; // no callback, not interesting
 604   if (w < 1) or (h < 1) then exit; // nothing to do
 605
 606   // increase query counter
 607   Inc(mLastQuery);
 608   if (mLastQuery = 0) then
 609   begin
 610     // just in case of overflow
 611     mLastQuery := 1;
 612     for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
 613   end;
 614
 615   (*
 616    * the algorithm is simple:
 617    *   find start for first interval (binary search will do)
 618    *   walk the interval, marking proxies with mLastQuery
 619    *   find start for second interval (binary search will do)
 620    *   walk the interval, returning proxies marked with mLastQuery
 621    *)
 622   lq := mLastQuery;
 623   mIntrs[0].walk(x, x+w-1, walker0);
 624   result := mIntrs[1].walk(y, y+h-1, walker1);
 625 end;
 626
 627
 628 end.