DEADSOFTWARE

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