DEADSOFTWARE

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