1 (* Copyright (C) DooM 2D:Forever Developers
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.
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.
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/>.
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}
23 {.$DEFINE GRID_USE_ORTHO_ACCEL}
35 GridTileSize
= 32; // must be power of two!
38 TBodyProxyId
= Integer;
40 generic TBodyGridBase
<ITP
> = class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
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;
51 GridCellBucketSize
= 8; // WARNING! can't be less than 2!
55 PBodyProxyRec
= ^TBodyProxyRec
;
56 TBodyProxyRec
= record
58 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
59 mQueryMark
: LongWord
; // was this object visited at this query?
61 mTag
: Integer; // `TagDisabled` set: disabled ;-)
62 nextLink
: TBodyProxyId
; // next free or nothing
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;
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
;
93 PGridCell
= ^TGridCell
;
95 bodies
: array [0..GridCellBucketSize
-1] of Integer; // -1: end of list
96 next
: Integer; // in this cell; index in mCells
99 TCellArray
= array of TGridCell
;
101 TGridInternalCB
= function (grida
: Integer; bodyId
: TBodyProxyId
): Boolean of object; // return `true` to stop
104 //mTileSize: Integer;
105 const mTileSize
= GridTileSize
;
106 type TGetProxyFn
= function (pxidx
: Integer): PBodyProxyRec
of object;
109 const tileSize
= mTileSize
;
112 TAtPointEnumerator
= record
115 curidx
, curbki
: Integer;
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
;
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
;
132 mProxies
: array of TBodyProxyRec
;
133 mProxyFree
: TBodyProxyId
; // free
134 mProxyCount
: Integer; // currently used
135 mProxyMaxCount
: Integer;
139 dbgShowTraceLog
: Boolean;
140 {$IF DEFINED(D2F_DEBUG)}
141 dbgRayTraceTileHitCB
: TCellQueryCB
;
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;
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
;
232 procedure forEachBodyCell (body
: TBodyProxyId
; cb
: TCellQueryCB
);
233 function forEachInCell (x
, y
: Integer; cb
: TGridQueryCB
): ITP
;
234 procedure dumpStats ();
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
;
250 // common structure for all line tracers
253 const TileSize
= GridTileSize
;
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
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;
289 property x
: Integer read xd
;
290 property y
: Integer read yd
;
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;
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);
315 setClip(minx
, miny
, maxx
, maxy
);
318 procedure TLineWalker
.setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
327 function TLineWalker
.setup (x0
, y0
, x1
, y1
: Integer): Boolean;
329 sx0
, sy0
, sx1
, sy1
: Single;
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
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
);
348 // check for ortho lines
353 stleft
:= abs(x1
-x0
)+1;
354 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
357 errmax
:= 10; // anything that is greater than zero
359 else if (x0
= x1
) then
363 stleft
:= abs(y1
-y0
)+1;
365 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
367 errmax
:= 10; // anything that is greater than zero
372 if (abs(x1
-x0
) >= abs(y1
-y0
)) then
376 stleft
:= abs(x1
-x0
)+1;
377 errinc
:= abs(y1
-y0
)+1;
383 stleft
:= abs(y1
-y0
)+1;
384 errinc
:= abs(x1
-x0
)+1;
386 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
387 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
395 function TLineWalker
.done (): Boolean; inline; begin result
:= (stleft
<= 0); end;
398 function TLineWalker
.step (): Boolean; inline;
404 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
410 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
413 result
:= (stleft
<= 0);
417 function TLineWalker
.stepToNextTile (): Boolean; inline;
420 xwalk
, ywalk
, wklen
: Integer; // to the respective edges
425 if (stleft
< 2) then begin result
:= true; exit
; end; // max one pixel left, nothing to do
427 // strictly horizontal?
434 ex
:= (xd
and (not (TileSize
-1)))-1;
440 ex
:= (xd
or (TileSize
-1))+1;
443 result
:= (stleft
<= 0);
448 // strictly vertical?
455 ey
:= (yd
and (not (TileSize
-1)))-1;
460 // yd: to bottom edge
461 ey
:= (yd
or (TileSize
-1))+1;
464 result
:= (stleft
<= 0);
474 ex
:= (xd
and (not (TileSize
-1)))-1;
479 ex
:= (xd
or (TileSize
-1))+1;
486 ey
:= (yd
and (not (TileSize
-1)))-1;
491 ey
:= (yd
or (TileSize
-1))+1;
496 while (xd <> ex) and (yd <> ey) do
502 if (err >= 0) then begin err -= errmax; yd += sty; end;
508 if (err >= 0) then begin err -= errmax; xd += stx; end;
511 if (stleft < 1) then begin result := true; exit; end;
515 if (xwalk
<= ywalk
) then wklen
:= xwalk
else wklen
:= ywalk
;
518 // in which dir we want to walk?
520 if (stleft
<= 0) then begin result
:= true; exit
; end;
524 for f
:= 1 to wklen
do
527 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
533 for f
:= 1 to wklen
do
536 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
539 // check for walk completion
540 if (xd
= ex
) or (yd
= ey
) then exit
;
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);
562 function TBodyGridBase
.TBodyProxyRec
.getTag (): Integer; inline;
564 result
:= mTag
and TagFullMask
;
567 procedure TBodyGridBase
.TBodyProxyRec
.setTag (v
: Integer); inline;
569 mTag
:= (mTag
and TagDisabled
) or (v
and TagFullMask
);
572 function TBodyGridBase
.TBodyProxyRec
.getEnabled (): Boolean; inline;
574 result
:= ((mTag
and TagDisabled
) = 0);
577 procedure TBodyGridBase
.TBodyProxyRec
.setEnabled (v
: Boolean); inline;
579 if v
then mTag
:= mTag
and (not TagDisabled
) else mTag
:= mTag
or TagDisabled
;
582 function TBodyGridBase
.TBodyProxyRec
.getX1 (): Integer; inline;
584 result
:= mX
+mWidth
-1;
587 function TBodyGridBase
.TBodyProxyRec
.getY1 (): Integer; inline;
589 result
:= mY
+mHeight
-1;
593 // ////////////////////////////////////////////////////////////////////////// //
594 constructor TBodyGridBase
.TAtPointEnumerator
.Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
603 function TBodyGridBase
.TAtPointEnumerator
.MoveNext (): Boolean; inline;
605 while (curidx
<> -1) do
607 while (curbki
< GridCellBucketSize
) do
610 if (mCells
[curidx
].bodies
[curbki
] = -1) then break
;
614 curidx
:= mCells
[curidx
].next
;
621 function TBodyGridBase
.TAtPointEnumerator
.getCurrent (): PBodyProxyRec
; inline;
623 result
:= getpx(mCells
[curidx
].bodies
[curbki
]);
627 // ////////////////////////////////////////////////////////////////////////// //
628 constructor TBodyGridBase
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
632 dbgShowTraceLog
:= false;
633 {$IF DEFINED(D2F_DEBUG)}
634 dbgRayTraceTileHitCB
:= nil;
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
;
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);
652 for idx
:= 0 to High(mCells
) do
654 mCells
[idx
].bodies
[0] := -1;
655 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
656 mCells
[idx
].next
:= idx
+1;
658 mCells
[High(mCells
)].next
:= -1; // last cell
660 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
662 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
663 mProxies
[High(mProxies
)].nextLink
:= -1;
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
);
673 destructor TBodyGridBase
.Destroy ();
682 // ////////////////////////////////////////////////////////////////////////// //
683 procedure TBodyGridBase
.dumpStats ();
685 idx
, mcb
, ccidx
, cnt
: Integer;
688 for idx
:= 0 to High(mGrid
) do
695 ccidx
:= mCells
[ccidx
].next
;
697 if (mcb
< cnt
) then mcb
:= cnt
;
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
);
703 procedure TBodyGridBase
.forEachBodyCell (body
: TBodyProxyId
; cb
: TCellQueryCB
);
705 g
, f
, ccidx
: Integer;
708 if (body
< 0) or (body
> High(mProxies
)) or not assigned(cb
) then exit
;
709 for g
:= 0 to High(mGrid
) do
712 while (ccidx
<> -1) do
714 cc
:= @mCells
[ccidx
];
715 for f
:= 0 to GridCellBucketSize
-1 do
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
);
727 function TBodyGridBase
.forEachInCell (x
, y
: Integer; cb
: TGridQueryCB
): ITP
;
732 result
:= Default(ITP
);
733 if not assigned(cb
) then exit
;
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
740 cc
:= @mCells
[ccidx
];
741 for f
:= 0 to GridCellBucketSize
-1 do
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;
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;
762 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
);
766 function TBodyGridBase
.getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
768 if (body
>= 0) and (body
< Length(mProxies
)) then
770 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; end;
782 function TBodyGridBase
.getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
784 if (body
>= 0) and (body
< Length(mProxies
)) then
786 with mProxies
[body
] do begin rw
:= mWidth
; rh
:= mHeight
; end;
798 function TBodyGridBase
.getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
800 if (body
>= 0) and (body
< Length(mProxies
)) then
802 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; rw
:= mWidth
; rh
:= mHeight
; end;
817 // ////////////////////////////////////////////////////////////////////////// //
818 function TBodyGridBase
.getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
820 if (pid
>= 0) and (pid
< Length(mProxies
)) then result
:= ((mProxies
[pid
].mTag
and TagDisabled
) = 0) else result
:= false;
824 procedure TBodyGridBase
.setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
826 if (pid
>= 0) and (pid
< Length(mProxies
)) then
830 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
and not TagDisabled
;
834 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
or TagDisabled
;
840 function TBodyGridBase
.getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
842 if (idx
>= 0) and (idx
< Length(mProxies
)) then result
:= @mProxies
[idx
] else result
:= nil;
846 // ////////////////////////////////////////////////////////////////////////// //
847 function TBodyGridBase
.allocCell (): Integer;
852 if (mFreeCell
< 0) then
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
859 mCells
[idx
].bodies
[0] := -1;
860 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
861 mCells
[idx
].next
:= idx
+1;
863 mCells
[High(mCells
)].next
:= -1; // last cell
866 pc
:= @mCells
[result
];
867 mFreeCell
:= pc
.next
;
870 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
874 procedure TBodyGridBase
.freeCell (idx
: Integer);
876 if (idx
>= 0) and (idx
< Length(mCells
)) then
881 bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
890 // ////////////////////////////////////////////////////////////////////////// //
891 function TBodyGridBase
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
896 if (mProxyFree
= -1) then
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;
906 result
:= mProxyFree
;
907 px
:= @mProxies
[result
];
908 mProxyFree
:= px
.nextLink
;
909 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
914 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
917 procedure TBodyGridBase
.freeProxy (body
: TBodyProxyId
);
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?)');
922 mProxies
[body
].mObj
:= nil;
923 mProxies
[body
].nextLink
:= mProxyFree
;
929 // ////////////////////////////////////////////////////////////////////////// //
930 function TBodyGridBase
.forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
937 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
942 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
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
;
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
961 result
:= cb(gy
*gw
+gx
, bodyId
);
968 // ////////////////////////////////////////////////////////////////////////// //
969 function TBodyGridBase
.inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
976 result
:= false; // never stop
977 // add body to the given grid cell
981 {$IF DEFINED(D2F_DEBUG)}
983 while (ccidx
<> -1) do
985 pi
:= @mCells
[ccidx
];
986 for f
:= 0 to GridCellBucketSize
-1 do
988 if (pi
.bodies
[f
] = -1) then break
;
989 if (pi
.bodies
[f
] = bodyId
) then raise Exception
.Create('trying to insert already inserted proxy');
995 while (ccidx
<> -1) do
997 pi
:= @mCells
[ccidx
];
998 // check "has room" flag
999 if (pi
.bodies
[GridCellBucketSize
-1] = -1) then
1002 for f
:= 0 to GridCellBucketSize
-1 do
1004 if (pi
.bodies
[f
] = -1) then
1006 pi
.bodies
[f
] := bodyId
;
1007 if (f
+1 < GridCellBucketSize
) then pi
.bodies
[f
+1] := -1;
1011 raise Exception
.Create('internal error in grid inserter');
1013 // no room, go to next cell in list (if there is any)
1016 // no room in cells, add new cell to list
1018 // either no room, or no cell at all
1019 ccidx
:= allocCell();
1020 pi
:= @mCells
[ccidx
];
1021 pi
.bodies
[0] := bodyId
;
1024 mGrid
[grida
] := ccidx
;
1028 // assume that we cannot have one object added to bucket twice
1029 function TBodyGridBase
.remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
1032 pidx
, ccidx
: Integer;
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
1041 pc
:= @mCells
[ccidx
];
1042 for f
:= 0 to GridCellBucketSize
-1 do
1044 if (pc
.bodies
[f
] = bodyId
) then
1047 if (f
= 0) and (pc
.bodies
[1] = -1) then
1049 // this cell contains no elements, remove it
1050 if (pidx
= -1) then mGrid
[grida
] := pc
.next
else mCells
[pidx
].next
:= pc
.next
;
1054 // remove element from bucket
1055 for c
:= f
to GridCellBucketSize
-2 do
1057 pc
.bodies
[c
] := pc
.bodies
[c
+1];
1058 if (pc
.bodies
[c
] = -1) then break
;
1060 pc
.bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
1070 // ////////////////////////////////////////////////////////////////////////// //
1071 function TBodyGridBase
.insertBody (aObj
: ITP
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
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
);
1080 procedure TBodyGridBase
.removeBody (body
: TBodyProxyId
);
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
);
1092 // ////////////////////////////////////////////////////////////////////////// //
1093 procedure TBodyGridBase
.moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
1096 x0
, y0
, w
, h
: Integer;
1098 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1099 px
:= @mProxies
[body
];
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
);
1107 if (nx
= x0
) and (ny
= y0
) and (nw
= w
) and (nh
= h
) then exit
;
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
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
);
1126 //insertInternal(body);
1127 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1139 //TODO: optimize for horizontal/vertical moves
1140 procedure TBodyGridBase
.moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
1144 ogx0
, ogx1
, ogy0
, ogy1
: Integer; // old grid rect
1145 ngx0
, ngx1
, ngy0
, ngy1
: Integer; // new grid rect
1150 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1151 // check if tile coords was changed
1152 px
:= @mProxies
[body
];
1155 if (nx
= x0
) and (ny
= y0
) then exit
;
1161 // check for heavy work
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
);
1175 if (ogx0
<> ngx0
) or (ogy0
<> ngy0
) or (ogx1
<> ngx1
) or (ogy1
<> ngy1
) then
1177 // crossed tile boundary, do heavy work
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
);
1185 // remove stale marks
1186 if not ((ogy0
>= gh
) or (ogy1
< 0)) and
1187 not ((ogx0
>= gw
) or (ogx1
< 0)) then
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
);
1196 for gx
:= ogx0
to ogx1
do
1198 if (gx
< ngx0
) or (gx
> ngx1
) then
1200 // this column is completely outside of new rect
1201 for gy
:= ogy0
to ogy1
do
1203 {$IF DEFINED(D2F_DEBUG_MOVER)}
1204 e_WriteLog(Format(' remove0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1206 remover(gy
*gw
+gx
, body
);
1212 for gy
:= ogy0
to ogy1
do
1214 if (gy
< ngy0
) or (gy
> ngy1
) then
1216 {$IF DEFINED(D2F_DEBUG_MOVER)}
1217 e_WriteLog(Format(' remove1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1219 remover(gy
*gw
+gx
, body
);
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
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
);
1236 for gx
:= ngx0
to ngx1
do
1238 if (gx
< ogx0
) or (gx
> ogx1
) then
1240 // this column is completely outside of old rect
1241 for gy
:= ngy0
to ngy1
do
1243 {$IF DEFINED(D2F_DEBUG_MOVER)}
1244 e_WriteLog(Format(' insert0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1246 inserter(gy
*gw
+gx
, body
);
1252 for gy
:= ngy0
to ngy1
do
1254 if (gy
< ogy0
) or (gy
> ogy1
) then
1256 {$IF DEFINED(D2F_DEBUG_MOVER)}
1257 e_WriteLog(Format(' insert1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1259 inserter(gy
*gw
+gx
, body
);
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
);
1273 // update coordinates
1279 procedure TBodyGridBase
.resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
1282 x0
, y0
, w
, h
: Integer;
1284 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1285 // check if tile coords was changed
1286 px
:= @mProxies
[body
];
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
);
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
1297 // crossed tile boundary, do heavy work
1298 //removeInternal(body);
1299 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1302 //insertInternal(body);
1303 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1307 // nothing to do with the grid, just fix size
1314 // ////////////////////////////////////////////////////////////////////////// //
1315 function TBodyGridBase
.atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
1317 ccidx
: Integer = -1;
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
);
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
;
1331 idx
, curci
: Integer;
1332 cc
: PGridCell
= nil;
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
);
1346 // make coords (0,0)-based
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
);
1361 // increase query counter
1363 if (mLastQuery
= 0) then
1365 // just in case of overflow
1367 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
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
);
1375 while (curci
<> -1) do
1377 {$IF DEFINED(D2F_DEBUG_XXQ)}
1378 if (assigned(cb
)) then e_WriteLog(Format(' cell #%d', [curci
]), MSG_NOTIFY
);
1380 cc
:= @mCells
[curci
];
1381 for f
:= 0 to GridCellBucketSize
-1 do
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
);
1388 // shit. has to do it this way, so i can change tag in callback
1389 if (px
.mQueryMark
<> lq
) then
1391 px
.mQueryMark
:= lq
;
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
1396 if assigned(cb
) then
1398 if cb(px
.mObj
, ptag
) then
1401 if (exittag
<> nil) then exittag
^ := ptag
;
1408 if (exittag
<> nil) then exittag
^ := ptag
;
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
;
1425 sx
, sy
, ex
, ey
: Integer;
1428 cc
: PGridCell
= nil;
1435 result
:= Default(ITP
);
1436 if (w
< 1) or (h
< 1) then exit
;
1437 tagmask
:= tagmask
and TagFullMask
;
1438 if (tagmask
= 0) then exit
;
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
;
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');
1469 // increase query counter
1471 if (mLastQuery
= 0) then
1473 // just in case of overflow
1475 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1477 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1481 for gy
:= sy
to ey
do
1483 for gx
:= sx
to ex
do
1486 curci
:= mGrid
[gy
*gw
+gx
];
1487 while (curci
<> -1) do
1489 cc
:= @mCells
[curci
];
1490 for f
:= 0 to GridCellBucketSize
-1 do
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
;
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
1504 if cb(px
.mObj
, ptag
) then begin result
:= px
.mObj
; mInQuery
:= false; exit
; end;
1522 // ////////////////////////////////////////////////////////////////////////// //
1523 function TBodyGridBase
.forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; log
: Boolean=false): ITP
;
1531 gw
, gh
, minx
, miny
: Integer;
1535 //px0, py0, px1, py1: Integer;
1538 result
:= Default(ITP
);
1539 tagmask
:= tagmask
and TagFullMask
;
1540 if (tagmask
= 0) or not assigned(cb
) then exit
;
1547 // make query coords (0,0)-based
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');
1559 // increase query counter
1561 if (mLastQuery
= 0) then
1563 // just in case of overflow
1565 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1572 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1574 while (ccidx
<> -1) do
1576 cc
:= @mCells
[ccidx
];
1577 for f
:= 0 to GridCellBucketSize
-1 do
1579 if (cc
.bodies
[f
] = -1) then break
;
1580 px
:= @mProxies
[cc
.bodies
[f
]];
1582 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1584 px
.mQueryMark
:= lq
; // mark as processed
1585 if cb(px
.mObj
, ptag
) then
1596 // done processing cells, move to next tile
1597 until lw
.stepToNextTile();
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
;
1614 minu0
: Single = 100000.0;
1616 cx0
, cy0
, cx1
, cy1
: Integer;
1617 hitpx
: PBodyProxyRec
= nil;
1619 result
:= Default(ITP
);
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;
1639 if (cx0
> cx1
) or (cy0
> cy1
) then exit
;
1641 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
1644 // increase query counter
1646 if (mLastQuery
= 0) then
1648 // just in case of overflow
1650 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1654 for gy
:= cy0
div mTileSize
to cy1
div mTileSize
do
1656 for gx
:= cx0
div mTileSize
to cx1
div mTileSize
do
1658 ccidx
:= mGrid
[gy
*mWidth
+gx
];
1659 while (ccidx
<> -1) do
1661 cc
:= @mCells
[ccidx
];
1662 for f
:= 0 to GridCellBucketSize
-1 do
1664 if (cc
.bodies
[f
] = -1) then break
;
1665 px
:= @mProxies
[cc
.bodies
[f
]];
1667 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1669 px
.mQueryMark
:= lq
; // mark as processed
1670 if assigned(cb
) then
1672 if not cb(px
.mObj
, ptag
) then continue
;
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
1696 if (minu0
<= 1.0) then
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
1703 ex
:= ax0
+trunc(dx
*minu0
);
1704 ey
:= ay0
+trunc(dy
*minu0
);
1712 // ////////////////////////////////////////////////////////////////////////// //
1713 {.$DEFINE D2F_DEBUG_OTR}
1714 function TBodyGridBase
.traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
1720 minx
, miny
: Integer;
1722 x0
, y0
, x1
, y1
: Integer;
1723 celly0
, celly1
: Integer;
1725 filled
: array[0..mTileSize
-1] of Byte;
1726 {$IF DEFINED(D2F_DEBUG_OTR)}
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
;
1743 // offset query coords to (0,0)-based
1751 if (x0
< 0) or (x0
>= mWidth
*mTileSize
) then exit
; // oops
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;
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;
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
1780 cc
:= @mCells
[ccidx
];
1781 for f
:= 0 to GridCellBucketSize
-1 do
1783 if (cc
.bodies
[f
] = -1) then break
;
1784 px
:= @mProxies
[cc
.bodies
[f
]];
1786 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and
1787 (ax0
>= px
.x0
) and (ax0
<= px
.x1
) then
1789 // bound c0 and c1 to cell
1790 c0
:= nclamp(px
.y0
-miny
, celly0
, celly1
);
1791 c1
:= nclamp(px
.y1
-miny
, celly0
, celly1
);
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
)]);
1797 FillChar(filled
[c0
-celly0
], c1
-c0
+1, 1);
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';
1809 // now go till we hit cell boundary or empty space
1813 while (y0
>= celly0
) and (filled
[y0
-celly0
] <> 0) do
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
]);
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
]);
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;
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;
1844 // ////////////////////////////////////////////////////////////////////////// //
1845 function TBodyGridBase
.traceRay (const x0
, y0
, x1
, y1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
1849 result
:= traceRay(ex
, ey
, x0
, y0
, x1
, y1
, cb
, tagmask
);
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
;
1863 gw
, gh
, minx
, miny
: Integer;
1867 px0
, py0
, px1
, py1
: Integer;
1868 lastDistSq
, distSq
, hx
, hy
: Integer;
1869 firstCell
: Boolean = true;
1872 result
:= Default(ITP
);
1873 tagmask
:= tagmask
and TagFullMask
;
1874 if (tagmask
= 0) then exit
;
1881 // make query coords (0,0)-based
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]);
1896 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
1899 // increase query counter
1901 if (mLastQuery
= 0) then
1903 // just in case of overflow
1905 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1911 {$IF DEFINED(D2F_DEBUG)}
1912 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB(cx
+mMinX
, cy
+mMinY
);
1915 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1918 while (ccidx
<> -1) do
1920 cc
:= @mCells
[ccidx
];
1921 for f
:= 0 to GridCellBucketSize
-1 do
1923 if (cc
.bodies
[f
] = -1) then break
;
1924 px
:= @mProxies
[cc
.bodies
[f
]];
1926 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1928 px
.mQueryMark
:= lq
; // mark as processed
1929 if assigned(cb
) then
1931 if not cb(px
.mObj
, ptag
) then continue
;
1933 // get adjusted proxy coords
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]);
1942 if firstCell
and (x0
>= px0
) and (y0
>= py0
) and (x0
<= px1
) and (y0
<= py1
) then
1949 {$IF DEFINED(D2F_DEBUG)}
1950 if assigned(dbgRayTraceTileHitCB
) then e_LogWriteln(' INSIDE!');
1954 // do line-vs-aabb test
1955 if lineAABBIntersects(x0
, y0
, x1
, y1
, px0
, py0
, px1
-px0
+1, py1
-py0
+1, hx
, hy
) then
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]);
1962 if (distSq
< lastDistSq
) then
1964 lastDistSq
:= distSq
;
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;
1980 // move to next tile
1981 until lw
.stepToNextTile();
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
;
1993 result
:= traceRayOld(ex
, ey
, x0
, y0
, x1
, y1
, cb
, tagmask
);
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
;
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)
2009 xptr
, yptr
: PInteger
;
2012 prevx
, prevy
: Integer;
2013 lastDistSq
: Integer;
2014 ccidx
, curci
: Integer;
2015 hasUntried
: Boolean;
2016 lastGA
: Integer = -1;
2019 wasHit
: Boolean = false;
2020 gw
, gh
, minx
, miny
, maxx
, maxy
: Integer;
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;
2034 xdist
, ydist
: Integer;
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
2045 result
:= forEachAtPoint(ax0
, ay0
, nil, tagmask
, @ptag
);
2046 if (result
<> nil) then
2048 if assigned(cb
) and not cb(result
, ptag
, ax0
, ay0
, ax0
, ay0
) then result
:= Default(ITP
);
2053 lastDistSq
:= distanceSq(ax0
, ay0
, ax1
, ay1
)+1;
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
);
2071 // offset query coords to (0,0)-based
2086 // from left to right
2087 if (x0
> wx1
) or (x1
< wx0
) then exit
; // out of screen
2088 stx
:= 1; // going right
2092 // from right to left
2093 if (x1
> wx1
) or (x0
< wx0
) then exit
; // out of screen
2094 stx
:= -1; // going left
2105 // from top to bottom
2106 if (y0
> wy1
) or (y1
< wy0
) then exit
; // out of screen
2107 sty
:= 1; // going down
2111 // from bottom to top
2112 if (y1
> wy1
) or (y0
< wy0
) then exit
; // out of screen
2113 sty
:= -1; // going up
2153 temp
:= dx2
*(wy0
-y0
)-dsx
;
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
2161 //if (rem > 0) then begin Inc(xd); e += dy2; end; //BUGGY
2162 if (xd
< wx0
) then begin xd
+= 1; e
+= dy2
; end; //???
2167 if (not xfixed
) and (x0
< wx0
) then
2170 temp
:= dy2
*(wx0
-x0
);
2172 rem
:= temp
mod dx2
;
2173 if (yd
> wy1
) or (yd
= wy1
) and (rem
>= dsx
) then exit
;
2176 if (rem
>= dsx
) then begin Inc(yd
); e
-= dx2
; end;
2182 temp
:= dx2
*(wy1
-y0
)+dsx
;
2183 term
:= x0
+temp
div dy2
;
2184 rem
:= temp
mod dy2
;
2185 if (rem
= 0) then Dec(term
);
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;
2197 // first move, to skip starting point
2198 // DON'T DO THIS! loop will take care of that
2202 result
:= forEachAtPoint(ax0
, ay0
, nil, tagmask
, @ptag
);
2203 if (result
<> nil) then
2205 if assigned(cb
) then
2207 if cb(result
, ptag
, ax0
, ay0
, ax0
, ay0
) then
2226 prevx
:= xptr
^+minx
;
2227 prevy
:= yptr
^+miny
;
2230 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2233 if (xd = term) then exit;
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)');
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);
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');
2252 // increase query counter
2254 if (mLastQuery
= 0) then
2256 // just in case of overflow
2258 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
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
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
]);
2275 ga
:= (yptr
^ div mTileSize
)*gw
+(xptr
^ div mTileSize
);
2276 // one of those will never change
2279 while (wklen
> 0) do
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
]);
2285 if (ga
<> lastGA
) then
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
2293 cc
:= @mCells
[ccidx
];
2294 for f
:= 0 to GridCellBucketSize
-1 do
2296 if (cc
.bodies
[f
] = -1) then break
;
2297 px
:= @mProxies
[cc
.bodies
[f
]];
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
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
2310 if assigned(cb
) then
2312 if cb(px
.mObj
, ptag
, x
, y
, x
, y
) then
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
]);
2327 if (distSq
< lastDistSq
) then
2338 // remember this hitpoint if it is nearer than an old one
2348 if (x
< px
.x1
) then continue
; // not on the right edge
2355 if (x
> px
.x0
) then continue
; // not on the left edge
2368 if (y
< px
.y1
) then continue
; // not on the bottom edge
2375 if (y
> px
.y0
) then continue
; // not on the top edge
2380 if assigned(cb
) then
2382 if cb(px
.mObj
, ptag
, x
, y
, prevx
, prevy
) then
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
]);
2397 if (distSq
< lastDistSq
) then
2400 lastDistSq
:= distSq
;
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;
2414 // skip to next tile
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
]);
2424 if (wkstep
>= wklen
) then break
;
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
]);
2435 if (wkstep
>= wklen
) then break
;
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
]);
2449 if (wkstep
>= wklen
) then break
;
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
]);
2460 if (wkstep
>= wklen
) then break
;
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;
2474 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2475 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB((xptr
^ div mTileSize
*mTileSize
)+minx
, (yptr
^ div mTileSize
*mTileSize
)+miny
);
2478 //e_LogWritefln('*********************', []);
2481 while (xd
<> term
) do
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)');
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
);
2492 if (ga
<> lastGA
) then
2495 {$IF DEFINED(D2F_DEBUG)}
2496 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB((xptr
^ div mTileSize
*mTileSize
)+minx
, (yptr
^ div mTileSize
*mTileSize
)+miny
);
2498 if (ccidx
<> -1) then
2500 // signal cell completion
2501 if assigned(cb
) then
2503 if cb(nil, 0, xptr
^+minx
, yptr
^+miny
, prevx
, prevy
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2513 ccidx
:= mGrid
[lastGA
];
2515 // has something to process in this tile?
2516 if (ccidx
<> -1) then
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)
2524 // process cell list
2525 while (curci
<> -1) do
2527 cc
:= @mCells
[curci
];
2528 for f
:= 0 to GridCellBucketSize
-1 do
2530 if (cc
.bodies
[f
] = -1) then break
;
2531 px
:= @mProxies
[cc
.bodies
[f
]];
2533 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
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
2538 px
.mQueryMark
:= lq
; // mark as processed
2539 if assigned(cb
) then
2541 if cb(px
.mObj
, ptag
, x
, y
, prevx
, prevy
) then
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
);
2557 if (distSq
< lastDistSq
) then
2560 lastDistSq
:= distSq
;
2569 // this is possibly interesting proxy, set "has more to check" flag
2577 // still has something interesting in this cell?
2578 if not hasUntried
then
2580 // nope, don't process this cell anymore; signal cell completion
2582 if assigned(cb
) then
2584 if cb(nil, 0, x
, y
, prevx
, prevy
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2594 if (ccidx
= -1) then
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
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
;
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
;
2611 //putPixel(xptr^, yptr^);
2613 prevx
:= xptr
^+minx
;
2614 prevy
:= yptr
^+miny
;
2615 if (e
>= 0) then begin yd
+= sty
; e
-= dx2
; end else e
+= dy2
;
2618 // we can travel less than one cell
2619 if wasHit
and not assigned(cb
) then
2625 ex
:= ax1
; // why not?
2626 ey
:= ay1
; // why not?