DEADSOFTWARE

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