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}
29 GridTileSize
= 32; // must be power of two!
32 TBodyProxyId
= Integer;
34 generic TBodyGridBase
<ITP
> = class(TObject
)
36 type TGridQueryCB
= function (obj
: ITP
; tag
: Integer): Boolean is nested
; // return `true` to stop
37 type TGridRayQueryCB
= function (obj
: ITP
; tag
: Integer; x
, y
, prevx
, prevy
: Integer): Boolean is nested
; // return `true` to stop
38 type TCellQueryCB
= procedure (x
, y
: Integer) is nested
; // top-left cell corner coords
40 const TagDisabled
= $40000000;
41 const TagFullMask
= $3fffffff;
45 GridCellBucketSize
= 8; // WARNING! can't be less than 2!
49 PBodyProxyRec
= ^TBodyProxyRec
;
50 TBodyProxyRec
= record
52 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
53 mQueryMark
: LongWord
; // was this object visited at this query?
55 mTag
: Integer; // `TagDisabled` set: disabled ;-)
56 nextLink
: TBodyProxyId
; // next free or nothing
59 procedure setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
61 function getTag (): Integer; inline;
62 procedure setTag (v
: Integer); inline;
64 function getEnabled (): Boolean; inline;
65 procedure setEnabled (v
: Boolean); inline;
67 function getX1 (): Integer; inline;
68 function getY1 (): Integer; inline;
71 property x
: Integer read mX
;
72 property y
: Integer read mY
;
73 property width
: Integer read mWidth
;
74 property height
: Integer read mHeight
;
75 property tag
: Integer read getTag write setTag
;
76 property enabled
: Boolean read getEnabled write setEnabled
;
77 property obj
: ITP read mObj
;
79 property x0
: Integer read mX
;
80 property y0
: Integer read mY
;
81 property x1
: Integer read getX1
;
82 property y1
: Integer read getY1
;
87 PGridCell
= ^TGridCell
;
89 bodies
: array [0..GridCellBucketSize
-1] of Integer; // -1: end of list
90 next
: Integer; // in this cell; index in mCells
93 TCellArray
= array of TGridCell
;
95 TGridInternalCB
= function (grida
: Integer; bodyId
: TBodyProxyId
): Boolean of object; // return `true` to stop
99 const mTileSize
= GridTileSize
;
100 type TGetProxyFn
= function (pxidx
: Integer): PBodyProxyRec
of object;
103 const tileSize
= mTileSize
;
106 TAtPointEnumerator
= record
109 curidx
, curbki
: Integer;
112 constructor Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
113 function MoveNext (): Boolean; inline;
114 function getCurrent (): PBodyProxyRec
; inline;
115 property Current
: PBodyProxyRec read getCurrent
;
119 mMinX
, mMinY
: Integer; // so grids can start at any origin
120 mWidth
, mHeight
: Integer; // in tiles
121 mGrid
: array of Integer; // mWidth*mHeight, index in mCells
122 mCells
: TCellArray
; // cell pool
123 mFreeCell
: Integer; // first free cell index or -1
124 mLastQuery
: LongWord
;
126 mProxies
: array of TBodyProxyRec
;
127 mProxyFree
: TBodyProxyId
; // free
128 mProxyCount
: Integer; // currently used
129 mProxyMaxCount
: Integer;
133 dbgShowTraceLog
: Boolean;
134 {$IF DEFINED(D2F_DEBUG)}
135 dbgRayTraceTileHitCB
: TCellQueryCB
;
139 function allocCell (): Integer;
140 procedure freeCell (idx
: Integer); // `next` is simply overwritten
142 function allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
143 procedure freeProxy (body
: TBodyProxyId
);
145 function forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
147 function inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
148 function remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
150 function getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
151 procedure setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
153 function getGridWidthPx (): Integer; inline;
154 function getGridHeightPx (): Integer; inline;
156 function getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
159 constructor Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
160 destructor Destroy (); override;
162 function insertBody (aObj
: ITP
; ax
, ay
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
163 procedure removeBody (body
: TBodyProxyId
); // WARNING! this WILL destroy proxy!
165 procedure moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
166 procedure resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
167 procedure moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
169 function insideGrid (x
, y
: Integer): Boolean; inline;
171 // `false` if `body` is surely invalid
172 function getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
173 function getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
174 function getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
176 //WARNING: don't modify grid while any query is in progress (no checks are made!)
177 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
178 // no callback: return `true` on the first hit
179 function forEachInAABB (x
, y
, w
, h
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; allowDisabled
: Boolean=false): ITP
;
181 //WARNING: don't modify grid while any query is in progress (no checks are made!)
182 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
183 // no callback: return object on the first hit or nil
184 function forEachAtPoint (x
, y
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; exittag
: PInteger
=nil): ITP
;
186 function atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
188 //WARNING: don't modify grid while any query is in progress (no checks are made!)
189 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
190 // cb with `(nil)` will be called before processing new tile
191 // no callback: return object of the nearest hit or nil
192 // if `inverted` is true, trace will register bodies *exluding* tagmask
193 //WARNING: don't change tags in callbacks here!
194 function traceRayOld (const x0
, y0
, x1
, y1
: Integer; cb
: TGridRayQueryCB
; tagmask
: Integer=-1): ITP
; overload
;
195 function traceRayOld (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridRayQueryCB
; tagmask
: Integer=-1): ITP
;
197 //WARNING: don't modify grid while any query is in progress (no checks are made!)
198 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
199 // cb with `(nil)` will be called before processing new tile
200 // no callback: return object of the nearest hit or nil
201 // if `inverted` is true, trace will register bodies *exluding* tagmask
202 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
203 //WARNING: don't change tags in callbacks here!
204 function traceRay (const x0
, y0
, x1
, y1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
; overload
;
205 function traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
207 // return `false` if we're still inside at the end
208 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
209 // `true`: endpoint will point at the last "inside" pixel
210 // `false`: endpoint will be (ax1, ay1)
211 //WARNING: don't change tags in callbacks here!
212 function traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
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 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
217 //WARNING: don't change tags in callbacks here!
218 function forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; log
: Boolean=false): ITP
;
220 // trace box with the given velocity; return object hit (if any)
221 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
222 //WARNING: don't change tags in callbacks here!
223 function traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
226 procedure forEachBodyCell (body
: TBodyProxyId
; cb
: TCellQueryCB
);
227 function forEachInCell (x
, y
: Integer; cb
: TGridQueryCB
): ITP
;
228 procedure dumpStats ();
231 //WARNING! no sanity checks!
232 property proxyEnabled
[pid
: TBodyProxyId
]: Boolean read getProxyEnabled write setProxyEnabled
;
234 property gridX0
: Integer read mMinX
;
235 property gridY0
: Integer read mMinY
;
236 property gridWidth
: Integer read getGridWidthPx
; // in pixels
237 property gridHeight
: Integer read getGridHeightPx
; // in pixels
239 property proxy
[idx
: TBodyProxyId
]: PBodyProxyRec read getProxyById
;
244 // common structure for all line tracers
247 const TileSize
= GridTileSize
;
250 wx0
, wy0
, wx1
, wy1
: Integer; // window coordinates
251 stx
, sty
: Integer; // "steps" for x and y axes
252 dx2
, dy2
: Integer; // "double lengthes" for x and y axes
253 xd
, yd
: Integer; // current coord
254 e
: Integer; // "error" (as in bresenham algo)
255 term
: Integer; // end for xd (xd = term: done)
256 //xptr, yptr: PInteger;
257 xyswapped
: Boolean; // true: xd is y
260 // call `setyp` after this
261 constructor Create (minx
, miny
, maxx
, maxy
: Integer);
263 procedure setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
265 // this will use `w[xy][01]` to clip coords
266 // return `false` if the whole line was clipped away
267 // on `true`, you should process first point, and go on
268 function setup (x0
, y0
, x1
, y1
: Integer): Boolean;
270 // call this *after* doing a step
271 // WARNING! if you will do a step when this returns `true`, you will fall into limbo
272 function done (): Boolean; inline;
274 // as you will prolly call `done()` after doing a step anyway, this will do it for you
275 // move to next point, return `true` when the line is complete (i.e. you should stop)
276 function step (): Boolean; inline;
278 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
279 function stepToNextTile (): Boolean; inline;
281 // hack for line-vs-aabb; NOT PROPERLY TESTED!
282 procedure getPrevXY (out ox
, oy
: Integer); inline;
285 function x (): Integer; inline;
286 function y (): Integer; inline;
288 procedure getXY (out ox
, oy
: Integer); inline;
290 // move directions; always [-1..1] (can be zero!)
291 function dx (): Integer; inline;
292 function dy (): Integer; inline;
296 // you are not supposed to understand this
297 // returns `true` if there is an intersection, and enter coords
298 // enter coords will be equal to (x0, y0) if starting point is inside the box
299 // if result is `false`, `inx` and `iny` are undefined
300 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer; out inx
, iny
: Integer): Boolean;
302 // sweep two AABB's to see if and when they are overlapping
303 // returns `true` if collision was detected (but boxes doesn't overlap)
304 // u1 and u1 has no sense if no collision was detected
305 // u0 = normalized time of first collision (i.e. collision starts at myMove*u0)
306 // u1 = normalized time of second collision (i.e. collision stops after myMove*u1)
307 // hitedge for `it`: 0: top; 1: right; 2: bottom; 3: left
308 // enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision)
309 function sweepAABB (mex0
, mey0
, mew
, meh
: Integer; medx
, medy
: Integer; itx0
, ity0
, itw
, ith
: Integer;
310 u0
: PSingle
=nil; hitedge
: PInteger
=nil; u1
: PSingle
=nil): Boolean;
312 function distanceSq (x0
, y0
, x1
, y1
: Integer): Integer; inline;
314 procedure swapInt (var a
: Integer; var b
: Integer); inline;
315 //function minInt (a, b: Integer): Integer; inline;
316 //function maxInt (a, b: Integer): Integer; inline;
322 SysUtils
, e_log
, g_console
, utils
;
325 // ////////////////////////////////////////////////////////////////////////// //
326 procedure swapInt (var a
: Integer; var b
: Integer); inline; var t
: Integer; begin t
:= a
; a
:= b
; b
:= t
; end;
327 //procedure swapInt (var a: Integer; var b: Integer); inline; begin a := a xor b; b := b xor a; a := a xor b; end;
328 //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
329 //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
331 function distanceSq (x0
, y0
, x1
, y1
: Integer): Integer; inline; begin result
:= (x1
-x0
)*(x1
-x0
)+(y1
-y0
)*(y1
-y0
); end;
334 // ////////////////////////////////////////////////////////////////////////// //
335 constructor TLineWalker
.Create (minx
, miny
, maxx
, maxy
: Integer);
337 setClip(minx
, miny
, maxx
, maxy
);
340 procedure TLineWalker
.setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
349 function TLineWalker
.done (): Boolean; inline; begin result
:= (xd
= term
); end;
351 function TLineWalker
.step (): Boolean; inline;
353 if (e
>= 0) then begin yd
+= sty
; e
-= dx2
; end else e
+= dy2
;
355 result
:= (xd
= term
);
358 function TLineWalker
.stepToNextTile (): Boolean; inline;
361 xwalk
, ywalk
, wklen
: Integer; // to the respective edges
362 lstx
, lsty
, lterm
: Integer;
363 le
, ldx2
, ldy2
: Integer;
382 xd
:= (lxd
and (not (TileSize
-1)))-1;
383 result
:= (lxd
<= lterm
);
389 xd
:= (lxd
or (TileSize
-1))+1;
390 result
:= (lxd
>= lterm
);
396 //assert(lstx <> 0); // invariant
406 ex
:= (lxd
and (not (TileSize
-1)))-1;
411 ex
:= (lxd
or (TileSize
-1))+1;
418 ey
:= (lyd
and (not (TileSize
-1)))-1;
423 ey
:= (lyd
or (TileSize
-1))+1;
429 // in which dir we want to walk?
430 if (xwalk
<= ywalk
) then wklen
:= xwalk
else wklen
:= ywalk
;
435 if (lxd
<= lterm
) then begin xd
:= lxd
; result
:= true; exit
; end;
440 if (lxd
>= lterm
) then begin xd
:= lxd
; result
:= true; exit
; end;
443 for f
:= 1 to wklen
do if (le
>= 0) then begin lyd
+= lsty
; le
-= ldx2
; end else le
+= ldy2
;
444 if (lxd
= ex
) or (lyd
= ey
) then break
;
445 xwalk
-= wklen
; if (xwalk
= 0) then xwalk
:= TileSize
;
446 ywalk
-= wklen
; if (ywalk
= 0) then ywalk
:= TileSize
;
448 //assert((xd div TileSize <> lxd div TileSize) or (yd div TileSize <> lyd div TileSize));
455 procedure TLineWalker
.getPrevXY (out ox
, oy
: Integer); inline;
457 //writeln('e=', e, '; dx2=', dx2, '; dy2=', dy2);
460 if (e
>= 0) then ox
:= yd
-sty
else ox
:= yd
;
465 if (e
>= 0) then oy
:= yd
-sty
else oy
:= yd
;
470 function TLineWalker
.x (): Integer; inline; begin if xyswapped
then result
:= yd
else result
:= xd
; end;
471 function TLineWalker
.y (): Integer; inline; begin if xyswapped
then result
:= xd
else result
:= yd
; end;
472 procedure TLineWalker
.getXY (out ox
, oy
: Integer); inline; begin if xyswapped
then begin ox
:= yd
; oy
:= xd
; end else begin ox
:= xd
; oy
:= yd
; end; end;
474 function TLineWalker
.dx (): Integer; inline; begin if xyswapped
then result
:= stx
else result
:= sty
; end;
475 function TLineWalker
.dy (): Integer; inline; begin if xyswapped
then result
:= sty
else result
:= stx
; end;
477 function TLineWalker
.setup (x0
, y0
, x1
, y1
: Integer): Boolean;
478 procedure swapInt (var a
: Integer; var b
: Integer); inline; begin a
:= a
xor b
; b
:= b
xor a
; a
:= a
xor b
; end;
480 dsx
, dsy
: Integer; // "lengthes" for x and y axes
491 // from left to right
492 if (x0
> wx1
) or (x1
< wx0
) then exit
; // out of screen
493 stx
:= 1; // going right
497 // from right to left
498 if (x1
> wx1
) or (x0
< wx0
) then exit
; // out of screen
499 stx
:= -1; // going left
510 // from top to bottom
511 if (y0
> wy1
) or (y1
< wy0
) then exit
; // out of screen
512 sty
:= 1; // going down
516 // from bottom to top
517 if (y1
> wy1
) or (y0
< wy0
) then exit
; // out of screen
518 sty
:= -1; // going up
558 temp
:= dx2
*(wy0
-y0
)-dsx
;
561 if (xd
> wx1
) then exit
; // x is moved out of clipping rect, nothing to do
562 if (xd
+1 >= wx0
) then
566 //if (rem > 0) then begin Inc(xd); e += dy2; end; //BUGGY
567 if (xd
< wx0
) then begin xd
+= 1; e
+= dy2
; end; //???
572 if (not xfixed
) and (x0
< wx0
) then
575 temp
:= dy2
*(wx0
-x0
);
578 if (yd
> wy1
) or (yd
= wy1
) and (rem
>= dsx
) then exit
;
581 if (rem
>= dsx
) then begin Inc(yd
); e
-= dx2
; end;
587 temp
:= dx2
*(wy1
-y0
)+dsx
;
588 term
:= x0
+temp
div dy2
;
590 if (rem
= 0) then Dec(term
);
593 if (term
> wx1
) then term
:= wx1
; // clip at right
595 Inc(term
); // draw last point (it is ok to inc here, as `term` sign will be changed later
596 //if (term = xd) then exit; // this is the only point, get out of here
598 if (sty
= -1) then yd
:= -yd
;
599 if (stx
= -1) then begin xd
:= -xd
; term
:= -term
; end;
606 // ////////////////////////////////////////////////////////////////////////// //
607 // you are not supposed to understand this
608 // returns `true` if there is an intersection, and enter coords
609 // enter coords will be equal to (x0, y0) if starting point is inside the box
610 // if result is `false`, `inx` and `iny` are undefined
611 function lineAABBIntersects (x0
, y0
, x1
, y1
: Integer; bx
, by
, bw
, bh
: Integer; out inx
, iny
: Integer): Boolean;
613 wx0
, wy0
, wx1
, wy1
: Integer; // window coordinates
614 stx
, sty
: Integer; // "steps" for x and y axes
615 dsx
, dsy
: Integer; // "lengthes" for x and y axes
616 dx2
, dy2
: Integer; // "double lengthes" for x and y axes
617 xd
, yd
: Integer; // current coord
618 e
: Integer; // "error" (as in bresenham algo)
629 if (bw
< 1) or (bh
< 1) then exit
; // impossible box
631 if (x0
= x1
) and (y0
= y1
) then
634 result
:= (x0
>= bx
) and (y0
>= by
) and (x0
< bx
+bw
) and (y0
< by
+bh
);
638 // check if staring point is inside the box
639 if (x0
>= bx
) and (y0
>= by
) and (x0
< bx
+bw
) and (y0
< by
+bh
) then begin result
:= true; exit
; end;
650 // from left to right
651 if (x0
> wx1
) or (x1
< wx0
) then exit
; // out of screen
652 stx
:= 1; // going right
656 // from right to left
657 if (x1
> wx1
) or (x0
< wx0
) then exit
; // out of screen
658 stx
:= -1; // going left
669 // from top to bottom
670 if (y0
> wy1
) or (y1
< wy0
) then exit
; // out of screen
671 sty
:= 1; // going down
675 // from bottom to top
676 if (y1
> wy1
) or (y0
< wy0
) then exit
; // out of screen
677 sty
:= -1; // going up
716 temp
:= dx2
*(wy0
-y0
)-dsx
;
719 if (xd
> wx1
) then exit
; // x is moved out of clipping rect, nothing to do
720 if (xd
+1 >= wx0
) then
724 //if (rem > 0) then begin Inc(xd); e += dy2; end; //BUGGY
725 if (xd
< wx0
) then begin xd
+= 1; e
+= dy2
; end; //???
730 if (not xfixed
) and (x0
< wx0
) then
733 temp
:= dy2
*(wx0
-x0
);
736 if (yd
> wy1
) or (yd
= wy1
) and (rem
>= dsx
) then exit
;
739 if (rem
>= dsx
) then begin Inc(yd
); e
-= dx2
; end;
746 temp := dx2*(wy1-y0)+dsx;
747 term := x0+temp div dy2;
749 if (rem = 0) then Dec(term);
752 if (term > wx1) then term := wx1; // clip at right
754 Inc(term); // draw last point
755 //if (term = xd) then exit; // this is the only point, get out of here
758 if (sty
= -1) then yd
:= -yd
;
759 if (stx
= -1) then begin xd
:= -xd
; {!term := -term;} end;
768 // ////////////////////////////////////////////////////////////////////////// //
769 function sweepAABB (mex0
, mey0
, mew
, meh
: Integer; medx
, medy
: Integer; itx0
, ity0
, itw
, ith
: Integer;
770 u0
: PSingle
=nil; hitedge
: PInteger
=nil; u1
: PSingle
=nil): Boolean;
774 function axisOverlap (me0
, me1
, it0
, it1
, d
, he0
, he1
: Integer): Boolean; inline;
782 if (d
>= 0) then exit
; // oops, no hit
784 if (t
> tin
) then begin tin
:= t
; hitedge
^ := he1
; end;
786 else if (it1
< me0
) then
788 if (d
<= 0) then exit
; // oops, no hit
790 if (t
> tin
) then begin tin
:= t
; hitedge
^ := he0
; end;
793 if (d
< 0) and (it1
> me0
) then
796 if (t
< tout
) then tout
:= t
;
798 else if (d
> 0) and (me1
> it0
) then
801 if (t
< tout
) then tout
:= t
;
808 mex1
, mey1
, itx1
, ity1
, vx
, vy
: Integer;
812 if (u0
<> nil) then u0
^ := -1.0;
813 if (u1
<> nil) then u1
^ := -1.0;
814 if (hitedge
= nil) then hitedge
:= @htt
else hitedge
^ := -1;
816 if (mew
< 1) or (meh
< 1) or (itw
< 1) or (ith
< 1) then exit
;
823 // check if they are overlapping right now (SAT)
824 //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end;
826 if (medx
= 0) and (medy
= 0) then exit
; // both boxes are sationary
828 // treat b as stationary, so invert v to get relative velocity
835 if not axisOverlap(mex0
, mex1
, itx0
, itx1
, vx
, 1, 3) then exit
;
836 if not axisOverlap(mey0
, mey1
, ity0
, ity1
, vy
, 2, 0) then exit
;
838 if (u0
<> nil) then u0
^ := tin
;
839 if (u1
<> nil) then u1
^ := tout
;
841 if (tin
<= tout
) and (tin
>= 0.0) and (tin
<= 1.0) then
848 // ////////////////////////////////////////////////////////////////////////// //
849 procedure TBodyGridBase
.TBodyProxyRec
.setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
862 function TBodyGridBase
.TBodyProxyRec
.getTag (): Integer; inline;
864 result
:= mTag
and TagFullMask
;
867 procedure TBodyGridBase
.TBodyProxyRec
.setTag (v
: Integer); inline;
869 mTag
:= (mTag
and TagDisabled
) or (v
and TagFullMask
);
872 function TBodyGridBase
.TBodyProxyRec
.getEnabled (): Boolean; inline;
874 result
:= ((mTag
and TagDisabled
) = 0);
877 procedure TBodyGridBase
.TBodyProxyRec
.setEnabled (v
: Boolean); inline;
879 if v
then mTag
:= mTag
and (not TagDisabled
) else mTag
:= mTag
or TagDisabled
;
882 function TBodyGridBase
.TBodyProxyRec
.getX1 (): Integer; inline;
884 result
:= mX
+mWidth
-1;
887 function TBodyGridBase
.TBodyProxyRec
.getY1 (): Integer; inline;
889 result
:= mY
+mHeight
-1;
893 // ////////////////////////////////////////////////////////////////////////// //
894 constructor TBodyGridBase
.TAtPointEnumerator
.Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
903 function TBodyGridBase
.TAtPointEnumerator
.MoveNext (): Boolean; inline;
905 while (curidx
<> -1) do
907 while (curbki
< GridCellBucketSize
) do
910 if (mCells
[curidx
].bodies
[curbki
] = -1) then break
;
914 curidx
:= mCells
[curidx
].next
;
921 function TBodyGridBase
.TAtPointEnumerator
.getCurrent (): PBodyProxyRec
; inline;
923 result
:= getpx(mCells
[curidx
].bodies
[curbki
]);
927 // ////////////////////////////////////////////////////////////////////////// //
928 constructor TBodyGridBase
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
932 dbgShowTraceLog
:= false;
933 {$IF DEFINED(D2F_DEBUG)}
934 dbgRayTraceTileHitCB
:= nil;
937 if aTileSize < 1 then aTileSize := 1;
938 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
939 mTileSize := aTileSize;
941 if (aPixWidth
< mTileSize
) then aPixWidth
:= mTileSize
;
942 if (aPixHeight
< mTileSize
) then aPixHeight
:= mTileSize
;
945 mWidth
:= (aPixWidth
+mTileSize
-1) div mTileSize
;
946 mHeight
:= (aPixHeight
+mTileSize
-1) div mTileSize
;
947 SetLength(mGrid
, mWidth
*mHeight
);
948 SetLength(mCells
, mWidth
*mHeight
);
949 SetLength(mProxies
, 8192);
952 for idx
:= 0 to High(mCells
) do
954 mCells
[idx
].bodies
[0] := -1;
955 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
956 mCells
[idx
].next
:= idx
+1;
958 mCells
[High(mCells
)].next
:= -1; // last cell
960 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
962 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
963 mProxies
[High(mProxies
)].nextLink
:= -1;
969 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
]), MSG_NOTIFY
);
973 destructor TBodyGridBase
.Destroy ();
982 // ////////////////////////////////////////////////////////////////////////// //
983 procedure TBodyGridBase
.dumpStats ();
985 idx
, mcb
, ccidx
, cnt
: Integer;
988 for idx
:= 0 to High(mGrid
) do
995 ccidx
:= mCells
[ccidx
].next
;
997 if (mcb
< cnt
) then mcb
:= cnt
;
999 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
]), MSG_NOTIFY
);
1003 procedure TBodyGridBase
.forEachBodyCell (body
: TBodyProxyId
; cb
: TCellQueryCB
);
1005 g
, f
, ccidx
: Integer;
1008 if (body
< 0) or (body
> High(mProxies
)) or not assigned(cb
) then exit
;
1009 for g
:= 0 to High(mGrid
) do
1012 while (ccidx
<> -1) do
1014 cc
:= @mCells
[ccidx
];
1015 for f
:= 0 to GridCellBucketSize
-1 do
1017 if (cc
.bodies
[f
] = -1) then break
;
1018 if (cc
.bodies
[f
] = body
) then cb((g
mod mWidth
)*mTileSize
+mMinX
, (g
div mWidth
)*mTileSize
+mMinY
);
1027 function TBodyGridBase
.forEachInCell (x
, y
: Integer; cb
: TGridQueryCB
): ITP
;
1032 result
:= Default(ITP
);
1033 if not assigned(cb
) then exit
;
1036 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
> mHeight
*mTileSize
) then exit
;
1037 ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1038 while (ccidx
<> -1) do
1040 cc
:= @mCells
[ccidx
];
1041 for f
:= 0 to GridCellBucketSize
-1 do
1043 if (cc
.bodies
[f
] = -1) then break
;
1044 if cb(mProxies
[cc
.bodies
[f
]].mObj
, mProxies
[cc
.bodies
[f
]].mTag
) then begin result
:= mProxies
[cc
.bodies
[f
]].mObj
; exit
; end;
1052 // ////////////////////////////////////////////////////////////////////////// //
1053 function TBodyGridBase
.getGridWidthPx (): Integer; inline; begin result
:= mWidth
*mTileSize
; end;
1054 function TBodyGridBase
.getGridHeightPx (): Integer; inline; begin result
:= mHeight
*mTileSize
; end;
1057 function TBodyGridBase
.insideGrid (x
, y
: Integer): Boolean; inline;
1062 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
);
1066 function TBodyGridBase
.getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
1068 if (body
>= 0) and (body
< Length(mProxies
)) then
1070 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; end;
1082 function TBodyGridBase
.getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
1084 if (body
>= 0) and (body
< Length(mProxies
)) then
1086 with mProxies
[body
] do begin rw
:= mWidth
; rh
:= mHeight
; end;
1098 function TBodyGridBase
.getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
1100 if (body
>= 0) and (body
< Length(mProxies
)) then
1102 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; rw
:= mWidth
; rh
:= mHeight
; end;
1117 // ////////////////////////////////////////////////////////////////////////// //
1118 function TBodyGridBase
.getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
1120 if (pid
>= 0) and (pid
< Length(mProxies
)) then result
:= ((mProxies
[pid
].mTag
and TagDisabled
) = 0) else result
:= false;
1124 procedure TBodyGridBase
.setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
1126 if (pid
>= 0) and (pid
< Length(mProxies
)) then
1130 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
and not TagDisabled
;
1134 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
or TagDisabled
;
1140 function TBodyGridBase
.getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
1142 if (idx
>= 0) and (idx
< Length(mProxies
)) then result
:= @mProxies
[idx
] else result
:= nil;
1146 // ////////////////////////////////////////////////////////////////////////// //
1147 function TBodyGridBase
.allocCell (): Integer;
1152 if (mFreeCell
< 0) then
1154 // no free cells, want more
1155 mFreeCell
:= Length(mCells
);
1156 SetLength(mCells
, mFreeCell
+32768); // arbitrary number
1157 for idx
:= mFreeCell
to High(mCells
) do
1159 mCells
[idx
].bodies
[0] := -1;
1160 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
1161 mCells
[idx
].next
:= idx
+1;
1163 mCells
[High(mCells
)].next
:= -1; // last cell
1165 result
:= mFreeCell
;
1166 pc
:= @mCells
[result
];
1167 mFreeCell
:= pc
.next
;
1170 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
1174 procedure TBodyGridBase
.freeCell (idx
: Integer);
1176 if (idx
>= 0) and (idx
< Length(mCells
)) then
1181 bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
1190 // ////////////////////////////////////////////////////////////////////////// //
1191 function TBodyGridBase
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
1196 if (mProxyFree
= -1) then
1198 // no free proxies, resize list
1199 olen
:= Length(mProxies
);
1200 SetLength(mProxies
, olen
+8192); // arbitrary number
1201 for idx
:= olen
to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
1202 mProxies
[High(mProxies
)].nextLink
:= -1;
1205 // get one from list
1206 result
:= mProxyFree
;
1207 px
:= @mProxies
[result
];
1208 mProxyFree
:= px
.nextLink
;
1209 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
1214 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
1217 procedure TBodyGridBase
.freeProxy (body
: TBodyProxyId
);
1219 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1220 if (mProxyCount
= 0) then raise Exception
.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
1222 mProxies
[body
].mObj
:= nil;
1223 mProxies
[body
].nextLink
:= mProxyFree
;
1229 // ////////////////////////////////////////////////////////////////////////// //
1230 function TBodyGridBase
.forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
1237 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
1242 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
1245 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then exit
;
1246 ex
:= (x
+w
-1) div mTileSize
;
1247 ey
:= (y
+h
-1) div mTileSize
;
1248 x
:= x
div mTileSize
;
1249 y
:= y
div mTileSize
;
1251 if (x
< 0) then x
:= 0 else if (x
>= gw
) then x
:= gw
-1;
1252 if (y
< 0) then y
:= 0 else if (y
>= gh
) then y
:= gh
-1;
1253 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
1254 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
1255 if (x
> ex
) or (y
> ey
) then exit
; // just in case
1257 for gy
:= y
to ey
do
1259 for gx
:= x
to ex
do
1261 result
:= cb(gy
*gw
+gx
, bodyId
);
1262 if result
then exit
;
1268 // ////////////////////////////////////////////////////////////////////////// //
1269 function TBodyGridBase
.inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
1276 result
:= false; // never stop
1277 // add body to the given grid cell
1281 {$IF DEFINED(D2F_DEBUG)}
1283 while (ccidx
<> -1) do
1285 pi
:= @mCells
[ccidx
];
1286 for f
:= 0 to GridCellBucketSize
-1 do
1288 if (pi
.bodies
[f
] = -1) then break
;
1289 if (pi
.bodies
[f
] = bodyId
) then raise Exception
.Create('trying to insert already inserted proxy');
1295 while (ccidx
<> -1) do
1297 pi
:= @mCells
[ccidx
];
1298 // check "has room" flag
1299 if (pi
.bodies
[GridCellBucketSize
-1] = -1) then
1302 for f
:= 0 to GridCellBucketSize
-1 do
1304 if (pi
.bodies
[f
] = -1) then
1306 pi
.bodies
[f
] := bodyId
;
1307 if (f
+1 < GridCellBucketSize
) then pi
.bodies
[f
+1] := -1;
1311 raise Exception
.Create('internal error in grid inserter');
1313 // no room, go to next cell in list (if there is any)
1316 // no room in cells, add new cell to list
1318 // either no room, or no cell at all
1319 ccidx
:= allocCell();
1320 pi
:= @mCells
[ccidx
];
1321 pi
.bodies
[0] := bodyId
;
1324 mGrid
[grida
] := ccidx
;
1328 // assume that we cannot have one object added to bucket twice
1329 function TBodyGridBase
.remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
1332 pidx
, ccidx
: Integer;
1335 result
:= false; // never stop
1336 // find and remove cell
1337 pidx
:= -1; // previous cell index
1338 ccidx
:= mGrid
[grida
]; // current cell index
1339 while (ccidx
<> -1) do
1341 pc
:= @mCells
[ccidx
];
1342 for f
:= 0 to GridCellBucketSize
-1 do
1344 if (pc
.bodies
[f
] = bodyId
) then
1347 if (f
= 0) and (pc
.bodies
[1] = -1) then
1349 // this cell contains no elements, remove it
1350 if (pidx
= -1) then mGrid
[grida
] := pc
.next
else mCells
[pidx
].next
:= pc
.next
;
1354 // remove element from bucket
1355 for c
:= f
to GridCellBucketSize
-2 do
1357 pc
.bodies
[c
] := pc
.bodies
[c
+1];
1358 if (pc
.bodies
[c
] = -1) then break
;
1360 pc
.bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
1370 // ////////////////////////////////////////////////////////////////////////// //
1371 function TBodyGridBase
.insertBody (aObj
: ITP
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
1373 aTag
:= aTag
and TagFullMask
;
1374 result
:= allocProxy(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
1375 //insertInternal(result);
1376 forGridRect(aX
, aY
, aWidth
, aHeight
, inserter
, result
);
1380 procedure TBodyGridBase
.removeBody (body
: TBodyProxyId
);
1384 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1385 px
:= @mProxies
[body
];
1386 //removeInternal(body);
1387 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1392 // ////////////////////////////////////////////////////////////////////////// //
1393 procedure TBodyGridBase
.moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
1396 x0
, y0
, w
, h
: Integer;
1398 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1399 px
:= @mProxies
[body
];
1404 {$IF DEFINED(D2F_DEBUG_MOVER)}
1405 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
);
1407 if (nx
= x0
) and (ny
= y0
) and (nw
= w
) and (nh
= h
) then exit
;
1413 // did any corner crossed tile boundary?
1414 if (x0
div mTileSize
<> nx
div mTileSize
) or
1415 (y0
div mTileSize
<> ny
div mTileSize
) or
1416 ((x0
+w
-1) div mTileSize
<> (nx
+nw
-1) div mTileSize
) or
1417 ((y0
+h
-1) div mTileSize
<> (ny
+nh
-1) div mTileSize
) then
1419 //writeln('moveResizeBody: cell occupation changed! old=(', x0, ',', y0, ')-(', x0+w-1, ',', y0+h-1, '); new=(', nx, ',', ny, ')-(', nx+nw-1, ',', ny+nh-1, ')');
1420 //removeInternal(body);
1421 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1426 //insertInternal(body);
1427 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1439 //TODO: optimize for horizontal/vertical moves
1440 procedure TBodyGridBase
.moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
1444 ogx0
, ogx1
, ogy0
, ogy1
: Integer; // old grid rect
1445 ngx0
, ngx1
, ngy0
, ngy1
: Integer; // new grid rect
1450 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1451 // check if tile coords was changed
1452 px
:= @mProxies
[body
];
1455 if (nx
= x0
) and (ny
= y0
) then exit
;
1461 // check for heavy work
1464 ogx0
:= x0
div mTileSize
;
1465 ogy0
:= y0
div mTileSize
;
1466 ngx0
:= nx
div mTileSize
;
1467 ngy0
:= ny
div mTileSize
;
1468 ogx1
:= (x0
+pw
-1) div mTileSize
;
1469 ogy1
:= (y0
+ph
-1) div mTileSize
;
1470 ngx1
:= (nx
+pw
-1) div mTileSize
;
1471 ngy1
:= (ny
+ph
-1) div mTileSize
;
1472 {$IF DEFINED(D2F_DEBUG_MOVER)}
1473 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
);
1475 if (ogx0
<> ngx0
) or (ogy0
<> ngy0
) or (ogx1
<> ngx1
) or (ogy1
<> ngy1
) then
1477 // crossed tile boundary, do heavy work
1480 // cycle with old rect, remove body where it is necessary
1481 // optimized for horizontal moves
1482 {$IF DEFINED(D2F_DEBUG_MOVER)}
1483 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
);
1485 // remove stale marks
1486 if not ((ogy0
>= gh
) or (ogy1
< 0)) and
1487 not ((ogx0
>= gw
) or (ogx1
< 0)) then
1489 if (ogx0
< 0) then ogx0
:= 0;
1490 if (ogy0
< 0) then ogy0
:= 0;
1491 if (ogx1
> gw
-1) then ogx1
:= gw
-1;
1492 if (ogy1
> gh
-1) then ogy1
:= gh
-1;
1493 {$IF DEFINED(D2F_DEBUG_MOVER)}
1494 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0
, ogy0
, ogx1
, ogy1
]), MSG_NOTIFY
);
1496 for gx
:= ogx0
to ogx1
do
1498 if (gx
< ngx0
) or (gx
> ngx1
) then
1500 // this column is completely outside of new rect
1501 for gy
:= ogy0
to ogy1
do
1503 {$IF DEFINED(D2F_DEBUG_MOVER)}
1504 e_WriteLog(Format(' remove0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1506 remover(gy
*gw
+gx
, body
);
1512 for gy
:= ogy0
to ogy1
do
1514 if (gy
< ngy0
) or (gy
> ngy1
) then
1516 {$IF DEFINED(D2F_DEBUG_MOVER)}
1517 e_WriteLog(Format(' remove1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1519 remover(gy
*gw
+gx
, body
);
1525 // cycle with new rect, add body where it is necessary
1526 if not ((ngy0
>= gh
) or (ngy1
< 0)) and
1527 not ((ngx0
>= gw
) or (ngx1
< 0)) then
1529 if (ngx0
< 0) then ngx0
:= 0;
1530 if (ngy0
< 0) then ngy0
:= 0;
1531 if (ngx1
> gw
-1) then ngx1
:= gw
-1;
1532 if (ngy1
> gh
-1) then ngy1
:= gh
-1;
1533 {$IF DEFINED(D2F_DEBUG_MOVER)}
1534 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0
, ngy0
, ngx1
, ngy1
]), MSG_NOTIFY
);
1536 for gx
:= ngx0
to ngx1
do
1538 if (gx
< ogx0
) or (gx
> ogx1
) then
1540 // this column is completely outside of old rect
1541 for gy
:= ngy0
to ngy1
do
1543 {$IF DEFINED(D2F_DEBUG_MOVER)}
1544 e_WriteLog(Format(' insert0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1546 inserter(gy
*gw
+gx
, body
);
1552 for gy
:= ngy0
to ngy1
do
1554 if (gy
< ogy0
) or (gy
> ogy1
) then
1556 {$IF DEFINED(D2F_DEBUG_MOVER)}
1557 e_WriteLog(Format(' insert1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1559 inserter(gy
*gw
+gx
, body
);
1569 {$IF DEFINED(D2F_DEBUG_MOVER)}
1570 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
);
1573 // update coordinates
1579 procedure TBodyGridBase
.resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
1582 x0
, y0
, w
, h
: Integer;
1584 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1585 // check if tile coords was changed
1586 px
:= @mProxies
[body
];
1591 {$IF DEFINED(D2F_DEBUG_MOVER)}
1592 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
);
1594 if ((x0
+w
-1) div mTileSize
<> (x0
+nw
-1) div mTileSize
) or
1595 ((y0
+h
-1) div mTileSize
<> (y0
+nh
-1) div mTileSize
) then
1597 // crossed tile boundary, do heavy work
1598 //removeInternal(body);
1599 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1602 //insertInternal(body);
1603 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1607 // nothing to do with the grid, just fix size
1614 // ////////////////////////////////////////////////////////////////////////// //
1615 function TBodyGridBase
.atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
1617 ccidx
: Integer = -1;
1621 if (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
) then ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1622 result
:= TAtPointEnumerator
.Create(mCells
, ccidx
, getProxyById
);
1626 // ////////////////////////////////////////////////////////////////////////// //
1627 // no callback: return `true` on the first hit
1628 function TBodyGridBase
.forEachAtPoint (x
, y
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; exittag
: PInteger
=nil): ITP
;
1631 idx
, curci
: Integer;
1632 cc
: PGridCell
= nil;
1637 result
:= Default(ITP
);
1638 if (exittag
<> nil) then exittag
^ := 0;
1639 tagmask
:= tagmask
and TagFullMask
;
1640 if (tagmask
= 0) then exit
;
1642 {$IF DEFINED(D2F_DEBUG_XXQ)}
1643 if (assigned(cb
)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x
, y
]), MSG_NOTIFY
);
1646 // make coords (0,0)-based
1649 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
>= mHeight
*mTileSize
) then exit
;
1651 curci
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1653 {$IF DEFINED(D2F_DEBUG_XXQ)}
1654 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
);
1661 // increase query counter
1663 if (mLastQuery
= 0) then
1665 // just in case of overflow
1667 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1671 {$IF DEFINED(D2F_DEBUG_XXQ)}
1672 if (assigned(cb
)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x
, y
, lq
]), MSG_NOTIFY
);
1675 while (curci
<> -1) do
1677 {$IF DEFINED(D2F_DEBUG_XXQ)}
1678 if (assigned(cb
)) then e_WriteLog(Format(' cell #%d', [curci
]), MSG_NOTIFY
);
1680 cc
:= @mCells
[curci
];
1681 for f
:= 0 to GridCellBucketSize
-1 do
1683 if (cc
.bodies
[f
] = -1) then break
;
1684 px
:= @mProxies
[cc
.bodies
[f
]];
1685 {$IF DEFINED(D2F_DEBUG_XXQ)}
1686 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
);
1688 // shit. has to do it this way, so i can change tag in callback
1689 if (px
.mQueryMark
<> lq
) then
1691 px
.mQueryMark
:= lq
;
1693 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and
1694 (x
>= px
.mX
) and (y
>= px
.mY
) and (x
< px
.mX
+px
.mWidth
) and (y
< px
.mY
+px
.mHeight
) then
1696 if assigned(cb
) then
1698 if cb(px
.mObj
, ptag
) then
1701 if (exittag
<> nil) then exittag
^ := ptag
;
1708 if (exittag
<> nil) then exittag
^ := ptag
;
1719 // ////////////////////////////////////////////////////////////////////////// //
1720 // no callback: return `true` on the first hit
1721 function TBodyGridBase
.forEachInAABB (x
, y
, w
, h
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; allowDisabled
: Boolean=false): ITP
;
1725 sx
, sy
, ex
, ey
: Integer;
1728 cc
: PGridCell
= nil;
1735 result
:= Default(ITP
);
1736 if (w
< 1) or (h
< 1) then exit
;
1737 tagmask
:= tagmask
and TagFullMask
;
1738 if (tagmask
= 0) then exit
;
1750 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
1751 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then exit
;
1753 sx
:= x
div mTileSize
;
1754 sy
:= y
div mTileSize
;
1755 ex
:= (x
+w
-1) div mTileSize
;
1756 ey
:= (y
+h
-1) div mTileSize
;
1759 if (sx
< 0) then sx
:= 0 else if (sx
>= gw
) then sx
:= gw
-1;
1760 if (sy
< 0) then sy
:= 0 else if (sy
>= gh
) then sy
:= gh
-1;
1761 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
1762 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
1763 if (sx
> ex
) or (sy
> ey
) then exit
; // just in case
1765 // has something to do
1766 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
1769 // increase query counter
1771 if (mLastQuery
= 0) then
1773 // just in case of overflow
1775 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1777 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1781 for gy
:= sy
to ey
do
1783 for gx
:= sx
to ex
do
1786 curci
:= mGrid
[gy
*gw
+gx
];
1787 while (curci
<> -1) do
1789 cc
:= @mCells
[curci
];
1790 for f
:= 0 to GridCellBucketSize
-1 do
1792 if (cc
.bodies
[f
] = -1) then break
;
1793 px
:= @mProxies
[cc
.bodies
[f
]];
1794 // shit! has to do it this way, so i can change tag in callback
1795 if (px
.mQueryMark
= lq
) then continue
;
1796 px
.mQueryMark
:= lq
;
1798 if (not allowDisabled
) and ((ptag
and TagDisabled
) <> 0) then continue
;
1799 if ((ptag
and tagmask
) = 0) then continue
;
1800 if (x0
>= px
.mX
+px
.mWidth
) or (y0
>= px
.mY
+px
.mHeight
) then continue
;
1801 if (x0
+w
<= px
.mX
) or (y0
+h
<= px
.mY
) then continue
;
1802 if assigned(cb
) then
1804 if cb(px
.mObj
, ptag
) then begin result
:= px
.mObj
; mInQuery
:= false; exit
; end;
1822 // ////////////////////////////////////////////////////////////////////////// //
1823 function TBodyGridBase
.forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1; log
: Boolean=false): ITP
;
1831 gw
, gh
, minx
, miny
: Integer;
1835 //px0, py0, px1, py1: Integer;
1838 result
:= Default(ITP
);
1839 tagmask
:= tagmask
and TagFullMask
;
1840 if (tagmask
= 0) or not assigned(cb
) then exit
;
1847 // make query coords (0,0)-based
1853 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
1854 if not lw
.setup(x0
, y0
, x1
, y1
) then exit
; // out of screen
1856 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
1859 // increase query counter
1861 if (mLastQuery
= 0) then
1863 // just in case of overflow
1865 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1872 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1874 while (ccidx
<> -1) do
1876 cc
:= @mCells
[ccidx
];
1877 for f
:= 0 to GridCellBucketSize
-1 do
1879 if (cc
.bodies
[f
] = -1) then break
;
1880 px
:= @mProxies
[cc
.bodies
[f
]];
1882 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1884 px
.mQueryMark
:= lq
; // mark as processed
1885 if cb(px
.mObj
, ptag
) then
1896 // done processing cells, move to next tile
1897 until lw
.stepToNextTile();
1903 // ////////////////////////////////////////////////////////////////////////// //
1904 // trace box with the given velocity; return object hit (if any)
1905 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
1906 function TBodyGridBase
.traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
1914 minu0
: Single = 100000.0;
1916 cx0
, cy0
, cx1
, cy1
: Integer;
1917 hitpx
: PBodyProxyRec
= nil;
1919 result
:= Default(ITP
);
1922 if (aw
< 1) or (ah
< 1) then exit
;
1924 cx0
:= nmin(ax0
, ax0
+dx
);
1925 cy0
:= nmin(ay0
, ay0
+dy
);
1926 cx1
:= nmax(ax0
+aw
-1, ax0
+aw
-1+dx
);
1927 cy1
:= nmax(ay0
+ah
-1, ay0
+ah
-1+dy
);
1929 cx0
-= mMinX
; cy0
-= mMinY
;
1930 cx1
-= mMinX
; cy1
-= mMinY
;
1932 if (cx1
< 0) or (cy1
< 0) or (cx0
>= mWidth
*mTileSize
) or (cy0
>= mHeight
*mTileSize
) then exit
;
1934 if (cx0
< 0) then cx0
:= 0;
1935 if (cy0
< 0) then cy0
:= 0;
1936 if (cx1
>= mWidth
*mTileSize
) then cx1
:= mWidth
*mTileSize
-1;
1937 if (cy1
>= mHeight
*mTileSize
) then cy1
:= mHeight
*mTileSize
-1;
1939 if (cx0
> cx1
) or (cy0
> cy1
) then exit
;
1941 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
1944 // increase query counter
1946 if (mLastQuery
= 0) then
1948 // just in case of overflow
1950 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1954 for gy
:= cy0
div mTileSize
to cy1
div mTileSize
do
1956 for gx
:= cx0
div mTileSize
to cx1
div mTileSize
do
1958 ccidx
:= mGrid
[gy
*mWidth
+gx
];
1959 while (ccidx
<> -1) do
1961 cc
:= @mCells
[ccidx
];
1962 for f
:= 0 to GridCellBucketSize
-1 do
1964 if (cc
.bodies
[f
] = -1) then break
;
1965 px
:= @mProxies
[cc
.bodies
[f
]];
1967 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1969 px
.mQueryMark
:= lq
; // mark as processed
1970 if assigned(cb
) then
1972 if not cb(px
.mObj
, ptag
) then continue
;
1974 if not sweepAABB(ax0
, ay0
, aw
, ah
, dx
, dy
, px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, @u0
) then continue
;
1975 if (minu0
> u0
) then
1996 if (minu0
<= 1.0) then
1998 ex
:= ax0
+round(dx
*minu0
);
1999 ey
:= ay0
+round(dy
*minu0
);
2000 // just in case, compensate for floating point inexactness
2001 if (ex
>= hitpx
.mX
) and (ey
>= hitpx
.mY
) and (ex
< hitpx
.mX
+hitpx
.mWidth
) and (ey
< hitpx
.mY
+hitpx
.mHeight
) then
2003 ex
:= ax0
+trunc(dx
*minu0
);
2004 ey
:= ay0
+trunc(dy
*minu0
);
2012 // ////////////////////////////////////////////////////////////////////////// //
2013 {.$DEFINE D2F_DEBUG_OTR}
2014 function TBodyGridBase
.traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
2020 minx
, miny
: Integer;
2022 x0
, y0
, x1
, y1
: Integer;
2023 celly0
, celly1
: Integer;
2025 filled
: array[0..mTileSize
-1] of Byte;
2026 {$IF DEFINED(D2F_DEBUG_OTR)}
2033 if not ((ax0
= ax1
) or (ay0
= ay1
)) then raise Exception
.Create('orthoray is not orthogonal');
2035 tagmask
:= tagmask
and TagFullMask
;
2036 if (tagmask
= 0) then exit
;
2038 if (forEachAtPoint(ax0
, ay0
, nil, tagmask
) = nil) then exit
;
2043 // offset query coords to (0,0)-based
2051 if (x0
< 0) or (x0
>= mWidth
*mTileSize
) then exit
; // oops
2056 if (y1
< 0) or (y0
>= mHeight
*mTileSize
) then exit
;
2057 //if (ay0 < 0) then ay0 := 0;
2058 if (y0
< 0) then exit
;
2059 if (y1
>= mHeight
*mTileSize
) then y1
:= mHeight
*mTileSize
-1;
2065 if (y0
< 0) or (y1
>= mHeight
*mTileSize
) then exit
;
2066 //if (ay1 < 0) then ay1 := 0;
2067 if (y1
< 0) then exit
;
2068 if (y0
>= mHeight
*mTileSize
) then y0
:= mHeight
*mTileSize
-1;
2074 ccidx
:= mGrid
[(y0
div mTileSize
)*mWidth
+(x0
div mTileSize
)];
2075 FillChar(filled
, sizeof(filled
), 0);
2076 celly0
:= y0
and (not (mTileSize
-1));
2077 celly1
:= celly0
+mTileSize
-1;
2078 while (ccidx
<> -1) do
2080 cc
:= @mCells
[ccidx
];
2081 for f
:= 0 to GridCellBucketSize
-1 do
2083 if (cc
.bodies
[f
] = -1) then break
;
2084 px
:= @mProxies
[cc
.bodies
[f
]];
2086 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and
2087 (ax0
>= px
.x0
) and (ax0
<= px
.x1
) then
2089 // bound c0 and c1 to cell
2090 c0
:= nclamp(px
.y0
-miny
, celly0
, celly1
);
2091 c1
:= nclamp(px
.y1
-miny
, celly0
, celly1
);
2093 {$IF DEFINED(D2F_DEBUG_OTR)}
2094 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
)]);
2097 FillChar(filled
[c0
-celly0
], c1
-c0
+1, 1);
2103 {$IF DEFINED(D2F_DEBUG_OTR)}
2104 s
:= formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0
, ay0
, ay1
, y0
, celly0
, celly1
, dy
]);
2105 for f
:= 0 to High(filled
) do if (filled
[f
] <> 0) then s
+= '1' else s
+= '0';
2109 // now go till we hit cell boundary or empty space
2113 while (y0
>= celly0
) and (filled
[y0
-celly0
] <> 0) do
2115 {$IF DEFINED(D2F_DEBUG_OTR)}
2116 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
2121 {$IF DEFINED(D2F_DEBUG_OTR)}
2122 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
2124 if (ay0
<= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
2125 if (y0
>= celly0
) then begin ey
:= ay0
+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result
:= true; exit
; end;
2130 while (y0
<= celly1
) and (filled
[y0
-celly0
] <> 0) do begin Inc(y0
); Inc(ay0
); end;
2131 if (ay0
>= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
2132 if (y0
<= celly1
) then begin ey
:= ay0
-1; result
:= true; exit
; end;
2144 // ////////////////////////////////////////////////////////////////////////// //
2145 function TBodyGridBase
.traceRay (const x0
, y0
, x1
, y1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
2149 result
:= traceRay(ex
, ey
, x0
, y0
, x1
, y1
, cb
, tagmask
);
2153 // no callback: return `true` on the nearest hit
2154 // you are not supposed to understand this
2155 function TBodyGridBase
.traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridQueryCB
; tagmask
: Integer=-1): ITP
;
2157 lw
, sweepw
: TLineWalker
;
2163 gw
, gh
, minx
, miny
: Integer;
2167 px0
, py0
, px1
, py1
: Integer;
2168 lastDistSq
, distSq
, hx
, hy
: Integer;
2169 firstCell
: Boolean = true;
2172 result
:= Default(ITP
);
2173 tagmask
:= tagmask
and TagFullMask
;
2174 if (tagmask
= 0) then exit
;
2181 // make query coords (0,0)-based
2187 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
2188 if not lw
.setup(x0
, y0
, x1
, y1
) then exit
; // out of screen
2190 sweepw
:= TLineWalker
.Create(0, 0, 1, 1); // doesn't matter, just shut ups the compiler
2192 lastDistSq
:= distanceSq(ax0
, ay0
, ax1
, ay1
)+1;
2194 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
2197 // increase query counter
2199 if (mLastQuery
= 0) then
2201 // just in case of overflow
2203 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
2210 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
2213 while (ccidx
<> -1) do
2215 cc
:= @mCells
[ccidx
];
2216 for f
:= 0 to GridCellBucketSize
-1 do
2218 if (cc
.bodies
[f
] = -1) then break
;
2219 px
:= @mProxies
[cc
.bodies
[f
]];
2221 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
2223 px
.mQueryMark
:= lq
; // mark as processed
2224 if assigned(cb
) then
2226 if not cb(px
.mObj
, ptag
) then continue
;
2228 // get adjusted proxy coords
2231 px1
:= px0
+px
.mWidth
-1;
2232 py1
:= py0
+px
.mHeight
-1;
2234 if firstCell
and (x0
>= px0
) and (y0
>= py0
) and (x0
<= px1
) and (y0
<= py1
) then
2243 // do line-vs-aabb test
2244 sweepw
.setClip(px0
, py0
, px1
, py1
);
2245 if sweepw
.setup(x0
, y0
, x1
, y1
) then
2248 sweepw
.getPrevXY(hx
, hy
);
2249 distSq
:= distanceSq(x0
, y0
, hx
, hy
);
2250 if (distSq
< lastDistSq
) then
2252 lastDistSq
:= distSq
;
2256 // if this is not a first cell, get outta here
2257 if not firstCell
then begin mInQuery
:= false; exit
; end;
2266 // done processing cells; exit if we registered a hit
2267 // next cells can't have better candidates, obviously
2268 if wasHit
then begin mInQuery
:= false; exit
; end;
2270 // move to next tile
2271 until lw
.stepToNextTile();
2277 // ////////////////////////////////////////////////////////////////////////// //
2278 // no callback: return `true` on the nearest hit
2279 function TBodyGridBase
.traceRayOld (const x0
, y0
, x1
, y1
: Integer; cb
: TGridRayQueryCB
; tagmask
: Integer=-1): ITP
;
2283 result
:= traceRayOld(ex
, ey
, x0
, y0
, x1
, y1
, cb
, tagmask
);
2287 // no callback: return `true` on the nearest hit
2288 // you are not supposed to understand this
2289 function TBodyGridBase
.traceRayOld (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; cb
: TGridRayQueryCB
; tagmask
: Integer=-1): ITP
;
2291 wx0
, wy0
, wx1
, wy1
: Integer; // window coordinates
2292 stx
, sty
: Integer; // "steps" for x and y axes
2293 dsx
, dsy
: Integer; // "lengthes" for x and y axes
2294 dx2
, dy2
: Integer; // "double lengthes" for x and y axes
2295 xd
, yd
: Integer; // current coord
2296 e
: Integer; // "error" (as in bresenham algo)
2299 xptr
, yptr
: PInteger
;
2302 prevx
, prevy
: Integer;
2303 lastDistSq
: Integer;
2304 ccidx
, curci
: Integer;
2305 hasUntried
: Boolean;
2306 lastGA
: Integer = -1;
2309 wasHit
: Boolean = false;
2310 gw
, gh
, minx
, miny
, maxx
, maxy
: Integer;
2314 f
, ptag
, distSq
: Integer;
2315 x0
, y0
, x1
, y1
: Integer;
2316 //swapped: Boolean = false; // true: xd is yd, and vice versa
2317 // horizontal walker
2318 {$IFDEF GRID_USE_ORTHO_ACCEL}
2319 wklen
, wkstep
: Integer;
2324 xdist
, ydist
: Integer;
2326 result
:= Default(ITP
);
2327 lastObj
:= Default(ITP
);
2328 tagmask
:= tagmask
and TagFullMask
;
2329 ex
:= ax1
; // why not?
2330 ey
:= ay1
; // why not?
2331 if (tagmask
= 0) then exit
;
2333 if (ax0
= ax1
) and (ay0
= ay1
) then
2335 result
:= forEachAtPoint(ax0
, ay0
, nil, tagmask
, @ptag
);
2336 if (result
<> nil) then
2338 if assigned(cb
) and not cb(result
, ptag
, ax0
, ay0
, ax0
, ay0
) then result
:= Default(ITP
);
2343 lastDistSq
:= distanceSq(ax0
, ay0
, ax1
, ay1
)+1;
2349 maxx
:= gw
*mTileSize
-1;
2350 maxy
:= gh
*mTileSize
-1;
2352 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2353 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
);
2361 // offset query coords to (0,0)-based
2376 // from left to right
2377 if (x0
> wx1
) or (x1
< wx0
) then exit
; // out of screen
2378 stx
:= 1; // going right
2382 // from right to left
2383 if (x1
> wx1
) or (x0
< wx0
) then exit
; // out of screen
2384 stx
:= -1; // going left
2395 // from top to bottom
2396 if (y0
> wy1
) or (y1
< wy0
) then exit
; // out of screen
2397 sty
:= 1; // going down
2401 // from bottom to top
2402 if (y1
> wy1
) or (y0
< wy0
) then exit
; // out of screen
2403 sty
:= -1; // going up
2443 temp
:= dx2
*(wy0
-y0
)-dsx
;
2445 rem
:= temp
mod dy2
;
2446 if (xd
> wx1
) then exit
; // x is moved out of clipping rect, nothing to do
2447 if (xd
+1 >= wx0
) then
2451 //if (rem > 0) then begin Inc(xd); e += dy2; end; //BUGGY
2452 if (xd
< wx0
) then begin xd
+= 1; e
+= dy2
; end; //???
2457 if (not xfixed
) and (x0
< wx0
) then
2460 temp
:= dy2
*(wx0
-x0
);
2462 rem
:= temp
mod dx2
;
2463 if (yd
> wy1
) or (yd
= wy1
) and (rem
>= dsx
) then exit
;
2466 if (rem
>= dsx
) then begin Inc(yd
); e
-= dx2
; end;
2472 temp
:= dx2
*(wy1
-y0
)+dsx
;
2473 term
:= x0
+temp
div dy2
;
2474 rem
:= temp
mod dy2
;
2475 if (rem
= 0) then Dec(term
);
2478 if (term
> wx1
) then term
:= wx1
; // clip at right
2480 Inc(term
); // draw last point
2481 //if (term = xd) then exit; // this is the only point, get out of here
2483 if (sty
= -1) then yd
:= -yd
;
2484 if (stx
= -1) then begin xd
:= -xd
; term
:= -term
; end;
2487 // first move, to skip starting point
2488 // DON'T DO THIS! loop will take care of that
2492 result
:= forEachAtPoint(ax0
, ay0
, nil, tagmask
, @ptag
);
2493 if (result
<> nil) then
2495 if assigned(cb
) then
2497 if cb(result
, ptag
, ax0
, ay0
, ax0
, ay0
) then
2516 prevx
:= xptr
^+minx
;
2517 prevy
:= yptr
^+miny
;
2520 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2523 if (xd = term) then exit;
2526 {$IF DEFINED(D2F_DEBUG)}
2527 if (xptr
^ < 0) or (yptr
^ < 0) or (xptr
^ >= gw
*mTileSize
) and (yptr
^ >= gh
*mTileSize
) then raise Exception
.Create('raycaster internal error (0)');
2529 // DON'T DO THIS! loop will take care of that
2530 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2531 //ccidx := mGrid[lastGA];
2533 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2534 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
2537 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
2539 if mInQuery
then raise Exception
.Create('recursive queries aren''t supported');
2542 // increase query counter
2544 if (mLastQuery
= 0) then
2546 // just in case of overflow
2548 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
2552 {$IFDEF GRID_USE_ORTHO_ACCEL}
2553 // if this is strict horizontal/vertical trace, use optimized codepath
2554 if (ax0
= ax1
) or (ay0
= ay1
) then
2556 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2557 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
2558 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2559 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
2560 hopt
:= (ay0
= ay1
); // horizontal?
2561 if (stx
< 0) then begin {wksign := -1;} wklen
:= -(term
-xd
); end else begin {wksign := 1;} wklen
:= term
-xd
; end;
2562 {$IF DEFINED(D2F_DEBUG)}
2563 if dbgShowTraceLog
then e_LogWritefln('optimized htrace; wklen=%d', [wklen
]);
2565 ga
:= (yptr
^ div mTileSize
)*gw
+(xptr
^ div mTileSize
);
2566 // one of those will never change
2569 while (wklen
> 0) do
2571 {$IF DEFINED(D2F_DEBUG)}
2572 if dbgShowTraceLog
then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga
, xptr
^+minx
, yptr
^+miny
, y
, ay0
]);
2575 if (ga
<> lastGA
) then
2578 ccidx
:= mGrid
[lastGA
];
2579 // convert coords to map (to avoid ajdusting coords inside the loop)
2580 if hopt
then x
:= xptr
^+minx
else y
:= yptr
^+miny
;
2581 while (ccidx
<> -1) do
2583 cc
:= @mCells
[ccidx
];
2584 for f
:= 0 to GridCellBucketSize
-1 do
2586 if (cc
.bodies
[f
] = -1) then break
;
2587 px
:= @mProxies
[cc
.bodies
[f
]];
2589 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) and
2590 // constant coord should be inside
2591 ((hopt
and (y
>= px
.y0
) and (y
<= px
.y1
)) or
2592 ((not hopt
) and (x
>= px
.x0
) and (x
<= px
.x1
))) then
2594 px
.mQueryMark
:= lq
; // mark as processed
2595 // inside the proxy?
2596 if (hopt
and (x
> px
.x0
) and (x
< px
.x1
)) or
2597 ((not hopt
) and (y
> px
.y0
) and (y
< px
.y1
)) then
2600 if assigned(cb
) then
2602 if cb(px
.mObj
, ptag
, x
, y
, x
, y
) then
2613 distSq
:= distanceSq(ax0
, ay0
, x
, y
);
2614 {$IF DEFINED(D2F_DEBUG)}
2615 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
]);
2617 if (distSq
< lastDistSq
) then
2628 // remember this hitpoint if it is nearer than an old one
2638 if (x
< px
.x1
) then continue
; // not on the right edge
2645 if (x
> px
.x0
) then continue
; // not on the left edge
2658 if (y
< px
.y1
) then continue
; // not on the bottom edge
2665 if (y
> px
.y0
) then continue
; // not on the top edge
2670 if assigned(cb
) then
2672 if cb(px
.mObj
, ptag
, x
, y
, prevx
, prevy
) then
2683 distSq
:= distanceSq(ax0
, ay0
, prevx
, prevy
);
2684 {$IF DEFINED(D2F_DEBUG)}
2685 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
]);
2687 if (distSq
< lastDistSq
) then
2690 lastDistSq
:= distSq
;
2701 if wasHit
and not assigned(cb
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2702 if assigned(cb
) and cb(nil, 0, x
, y
, x
, y
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2704 // skip to next tile
2710 wkstep
:= ((xptr
^ or (mTileSize
-1))+1)-xptr
^;
2711 {$IF DEFINED(D2F_DEBUG)}
2712 if dbgShowTraceLog
then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen
, wkstep
]);
2714 if (wkstep
>= wklen
) then break
;
2721 wkstep
:= xptr
^-((xptr
^ and (not (mTileSize
-1)))-1);
2722 {$IF DEFINED(D2F_DEBUG)}
2723 if dbgShowTraceLog
then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen
, wkstep
]);
2725 if (wkstep
>= wklen
) then break
;
2735 wkstep
:= ((yptr
^ or (mTileSize
-1))+1)-yptr
^;
2736 {$IF DEFINED(D2F_DEBUG)}
2737 if dbgShowTraceLog
then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen
, wkstep
]);
2739 if (wkstep
>= wklen
) then break
;
2746 wkstep
:= yptr
^-((yptr
^ and (not (mTileSize
-1)))-1);
2747 {$IF DEFINED(D2F_DEBUG)}
2748 if dbgShowTraceLog
then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen
, wkstep
]);
2750 if (wkstep
>= wklen
) then break
;
2757 // we can travel less than one cell
2758 if wasHit
and not assigned(cb
) then result
:= lastObj
else begin ex
:= ax1
; ey
:= ay1
; end;
2764 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2765 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB((xptr
^ div mTileSize
*mTileSize
)+minx
, (yptr
^ div mTileSize
*mTileSize
)+miny
);
2768 //e_LogWritefln('*********************', []);
2771 while (xd
<> term
) do
2774 {$IF DEFINED(D2F_DEBUG)}
2775 if (xptr
^ < 0) or (yptr
^ < 0) or (xptr
^ >= gw
*mTileSize
) and (yptr
^ >= gh
*mTileSize
) then raise Exception
.Create('raycaster internal error (0)');
2778 ga
:= (yptr
^ div mTileSize
)*gw
+(xptr
^ div mTileSize
);
2779 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2780 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
);
2782 if (ga
<> lastGA
) then
2785 {$IF DEFINED(D2F_DEBUG)}
2786 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB((xptr
^ div mTileSize
*mTileSize
)+minx
, (yptr
^ div mTileSize
*mTileSize
)+miny
);
2788 if (ccidx
<> -1) then
2790 // signal cell completion
2791 if assigned(cb
) then
2793 if cb(nil, 0, xptr
^+minx
, yptr
^+miny
, prevx
, prevy
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2803 ccidx
:= mGrid
[lastGA
];
2805 // has something to process in this tile?
2806 if (ccidx
<> -1) then
2810 hasUntried
:= false; // this will be set to `true` if we have some proxies we still want to process at the next step
2811 // convert coords to map (to avoid ajdusting coords inside the loop)
2814 // process cell list
2815 while (curci
<> -1) do
2817 cc
:= @mCells
[curci
];
2818 for f
:= 0 to GridCellBucketSize
-1 do
2820 if (cc
.bodies
[f
] = -1) then break
;
2821 px
:= @mProxies
[cc
.bodies
[f
]];
2823 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
2825 // can we process this proxy?
2826 if (x
>= px
.mX
) and (y
>= px
.mY
) and (x
< px
.mX
+px
.mWidth
) and (y
< px
.mY
+px
.mHeight
) then
2828 px
.mQueryMark
:= lq
; // mark as processed
2829 if assigned(cb
) then
2831 if cb(px
.mObj
, ptag
, x
, y
, prevx
, prevy
) then
2842 // remember this hitpoint if it is nearer than an old one
2843 distSq
:= distanceSq(ax0
, ay0
, prevx
, prevy
);
2844 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2845 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
);
2847 if (distSq
< lastDistSq
) then
2850 lastDistSq
:= distSq
;
2859 // this is possibly interesting proxy, set "has more to check" flag
2867 // still has something interesting in this cell?
2868 if not hasUntried
then
2870 // nope, don't process this cell anymore; signal cell completion
2872 if assigned(cb
) then
2874 if cb(nil, 0, x
, y
, prevx
, prevy
) then begin result
:= lastObj
; mInQuery
:= false; exit
; end;
2884 if (ccidx
= -1) then
2886 // move to cell edge, as we have nothing to trace here anymore
2887 if (stx
< 0) then xdist
:= xd
and (not (mTileSize
-1)) else xdist
:= xd
or (mTileSize
-1);
2888 if (sty
< 0) then ydist
:= yd
and (not (mTileSize
-1)) else ydist
:= yd
or (mTileSize
-1);
2889 //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]);
2890 while (xd
<> xdist
) and (yd
<> ydist
) do
2894 if (e
>= 0) then begin yd
+= sty
; e
-= dx2
; end else e
+= dy2
;
2895 //e_LogWritefln(' xd=%d; yd=%d', [xd, yd]);
2896 if (xd
= term
) then break
;
2898 //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]);
2899 if (xd
= term
) then break
;
2901 //putPixel(xptr^, yptr^);
2903 prevx
:= xptr
^+minx
;
2904 prevy
:= yptr
^+miny
;
2905 if (e
>= 0) then begin yd
+= sty
; e
-= dx2
; end else e
+= dy2
;
2908 // we can travel less than one cell
2909 if wasHit
and not assigned(cb
) then
2915 ex
:= ax1
; // why not?
2916 ey
:= ay1
; // why not?