DEADSOFTWARE

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