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}
33 * In order to make this usable for kind-of-recursive calls,
34 * we'll use "frame memory pool" to return results. That is,
35 * we will allocate a memory pool that will be cleared on
36 * frame start, and then used as a simple "no-free" allocator.
37 * Grid will put results into this pool, and will never bother
38 * to free it. Caller should call "release" on result, and
39 * the pool will throw away everything.
40 * No more callbacks, of course.
44 GridTileSize
= 32; // must be power of two!
47 PGridCellCoord
= ^TGridCellCoord
;
48 TGridCellCoord
= record
52 CellCoordIter
= specialize PoolIter
<TGridCellCoord
>;
56 TBodyProxyId
= Integer;
58 generic TBodyGridBase
<ITP
> = class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
61 type TCellQueryCB
= procedure (x
, y
: Integer) is nested
; // top-left cell corner coords
63 type Iter
= specialize PoolIter
<ITP
>;
65 const TagDisabled
= $40000000;
66 const TagFullMask
= $3fffffff;
70 GridCellBucketSize
= 8; // WARNING! can't be less than 2!
74 PBodyProxyRec
= ^TBodyProxyRec
;
75 TBodyProxyRec
= record
77 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
78 mQueryMark
: LongWord
; // was this object visited at this query?
80 mTag
: Integer; // `TagDisabled` set: disabled ;-)
81 nextLink
: TBodyProxyId
; // next free or nothing
84 procedure setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
86 function getTag (): Integer; inline;
87 procedure setTag (v
: Integer); inline;
89 function getEnabled (): Boolean; inline;
90 procedure setEnabled (v
: Boolean); inline;
92 function getX1 (): Integer; inline;
93 function getY1 (): Integer; inline;
96 property x
: Integer read mX
;
97 property y
: Integer read mY
;
98 property width
: Integer read mWidth
;
99 property height
: Integer read mHeight
;
100 property tag
: Integer read getTag write setTag
;
101 property enabled
: Boolean read getEnabled write setEnabled
;
102 property obj
: ITP read mObj
;
104 property x0
: Integer read mX
;
105 property y0
: Integer read mY
;
106 property x1
: Integer read getX1
;
107 property y1
: Integer read getY1
;
112 PGridCell
= ^TGridCell
;
114 bodies
: array [0..GridCellBucketSize
-1] of Integer; // -1: end of list
115 next
: Integer; // in this cell; index in mCells
118 TCellArray
= array of TGridCell
;
120 TGridInternalCB
= function (grida
: Integer; bodyId
: TBodyProxyId
): Boolean of object; // return `true` to stop
123 //mTileSize: Integer;
124 const mTileSize
= GridTileSize
;
125 type TGetProxyFn
= function (pxidx
: Integer): PBodyProxyRec
of object;
128 const tileSize
= mTileSize
;
131 TAtPointEnumerator
= record
134 curidx
, curbki
: Integer;
137 constructor Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
138 function MoveNext (): Boolean; inline;
139 function getCurrent (): PBodyProxyRec
; inline;
140 property Current
: PBodyProxyRec read getCurrent
;
144 mMinX
, mMinY
: Integer; // so grids can start at any origin
145 mWidth
, mHeight
: Integer; // in tiles
146 mGrid
: array of Integer; // mWidth*mHeight, index in mCells
147 mCells
: TCellArray
; // cell pool
148 mFreeCell
: Integer; // first free cell index or -1
149 mLastQuery
: LongWord
;
151 mProxies
: array of TBodyProxyRec
;
152 mProxyFree
: TBodyProxyId
; // free
153 mProxyCount
: Integer; // currently used
154 mProxyMaxCount
: Integer;
157 dbgShowTraceLog
: Boolean;
158 {$IF DEFINED(D2F_DEBUG)}
159 dbgRayTraceTileHitCB
: TCellQueryCB
;
163 function allocCell (): Integer;
164 procedure freeCell (idx
: Integer); // `next` is simply overwritten
166 function allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
167 procedure freeProxy (body
: TBodyProxyId
);
169 function forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
171 function inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
172 function remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
174 function getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
175 procedure setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
177 function getGridWidthPx (): Integer; inline;
178 function getGridHeightPx (): Integer; inline;
180 function getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
183 constructor Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
184 destructor Destroy (); override;
186 function insertBody (aObj
: ITP
; ax
, ay
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
187 procedure removeBody (body
: TBodyProxyId
); // WARNING! this WILL destroy proxy!
189 procedure moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
190 procedure resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
191 procedure moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
193 function insideGrid (x
, y
: Integer): Boolean; inline;
195 // `false` if `body` is surely invalid
196 function getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
197 function getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
198 function getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
200 // return number of ITP thingys put into frame pool
201 // if `firstHit` is `true`, return on first hit (obviously)
202 function forEachInAABB (x
, y
, w
, h
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
204 // return number of ITP thingys put into frame pool
205 // if `firstHit` is `true`, return on first hit (obviously)
206 function forEachAtPoint (x
, y
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
208 function atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
210 // return object of the nearest hit or nil
211 function traceRay (const x0
, y0
, x1
, y1
: Integer; tagmask
: Integer=-1): ITP
; overload
;
212 function traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): ITP
;
214 // return `false` if we're still inside at the end
215 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
216 // `true`: endpoint will point at the last "inside" pixel
217 // `false`: endpoint will be (ax1, ay1)
218 function traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
220 // trace line along the grid, put all objects from passed cells into frame pool, in no particular order
221 // return number of ITP thingys put into frame pool
222 function forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1; log
: Boolean=false): Iter
;
224 // trace box with the given velocity; return object hit (if any)
225 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
226 //WARNING: don't change tags in callbacks here!
227 function traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; tagmask
: Integer=-1): ITP
;
230 function forEachBodyCell (body
: TBodyProxyId
): CellCoordIter
; // this puts `TGridCellCoord` into frame pool for each cell
231 function forEachInCell (x
, y
: Integer): Iter
; // this puts `ITP` into frame pool
232 procedure dumpStats ();
235 //WARNING! no sanity checks!
236 property proxyEnabled
[pid
: TBodyProxyId
]: Boolean read getProxyEnabled write setProxyEnabled
;
238 property gridX0
: Integer read mMinX
;
239 property gridY0
: Integer read mMinY
;
240 property gridWidth
: Integer read getGridWidthPx
; // in pixels
241 property gridHeight
: Integer read getGridHeightPx
; // in pixels
243 property proxy
[idx
: TBodyProxyId
]: PBodyProxyRec read getProxyById
;
248 // common structure for all line tracers
251 const TileSize
= GridTileSize
;
254 wx0
, wy0
, wx1
, wy1
: Integer; // window coordinates
255 stx
, sty
: Integer; // "steps" for x and y axes
256 stleft
: Integer; // "steps left"
257 err
, errinc
, errmax
: Integer;
258 xd
, yd
: Integer; // current coord
262 // call `setyp` after this
263 constructor Create (minx
, miny
, maxx
, maxy
: Integer);
265 procedure setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
267 // this will use `w[xy][01]` to clip coords
268 // return `false` if the whole line was clipped away
269 // on `true`, you should process first point, and go on
270 function setup (x0
, y0
, x1
, y1
: Integer): Boolean;
272 // call this *after* doing a step
273 // WARNING! if you will do a step when this returns `true`, you will fall into limbo
274 function done (): Boolean; inline;
276 // as you will prolly call `done()` after doing a step anyway, this will do it for you
277 // move to next point, return `true` when the line is complete (i.e. you should stop)
278 function step (): Boolean; inline;
280 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
281 function stepToNextTile (): Boolean; inline;
283 procedure getXY (out ox
, oy
: Integer); inline;
287 property x
: Integer read xd
;
288 property y
: Integer read yd
;
292 procedure swapInt (var a
: Integer; var b
: Integer); inline;
293 //function minInt (a, b: Integer): Integer; inline;
294 //function maxInt (a, b: Integer): Integer; inline;
300 SysUtils
, e_log
, g_console
, geom
, utils
;
303 // ////////////////////////////////////////////////////////////////////////// //
304 procedure swapInt (var a
: Integer; var b
: Integer); inline; var t
: Integer; begin t
:= a
; a
:= b
; b
:= t
; end;
305 //procedure swapInt (var a: Integer; var b: Integer); inline; begin a := a xor b; b := b xor a; a := a xor b; end;
306 //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
307 //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
310 // ////////////////////////////////////////////////////////////////////////// //
311 constructor TLineWalker
.Create (minx
, miny
, maxx
, maxy
: Integer);
313 setClip(minx
, miny
, maxx
, maxy
);
316 procedure TLineWalker
.setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
325 function TLineWalker
.setup (x0
, y0
, x1
, y1
: Integer): Boolean;
327 sx0
, sy0
, sx1
, sy1
: Single;
329 if (wx1
< wx0
) or (wy1
< wy0
) then begin stleft
:= 0; xd
:= x0
; yd
:= y0
; result
:= false; exit
; end;
331 if (x0
>= wx0
) and (y0
>= wy0
) and (x0
<= wx1
) and (y0
<= wy1
) and
332 (x1
>= wx0
) and (y1
>= wy0
) and (x1
<= wx1
) and (y1
<= wy1
) then
338 sx0
:= x0
; sy0
:= y0
;
339 sx1
:= x1
; sy1
:= y1
;
340 result
:= clipLine(sx0
, sy0
, sx1
, sy1
, wx0
, wy0
, wx1
, wy1
);
341 if not result
then begin stleft
:= 0; xd
:= x0
; yd
:= y0
; exit
; end;
342 x0
:= trunc(sx0
); y0
:= trunc(sy0
);
343 x1
:= trunc(sx1
); y1
:= trunc(sy1
);
346 // check for ortho lines
351 stleft
:= abs(x1
-x0
)+1;
352 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
355 errmax
:= 10; // anything that is greater than zero
357 else if (x0
= x1
) then
361 stleft
:= abs(y1
-y0
)+1;
363 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
365 errmax
:= 10; // anything that is greater than zero
370 if (abs(x1
-x0
) >= abs(y1
-y0
)) then
374 stleft
:= abs(x1
-x0
)+1;
375 errinc
:= abs(y1
-y0
)+1;
381 stleft
:= abs(y1
-y0
)+1;
382 errinc
:= abs(x1
-x0
)+1;
384 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
385 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
393 function TLineWalker
.done (): Boolean; inline; begin result
:= (stleft
<= 0); end;
396 function TLineWalker
.step (): Boolean; inline;
402 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
408 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
411 result
:= (stleft
<= 0);
415 function TLineWalker
.stepToNextTile (): Boolean; inline;
418 xwalk
, ywalk
, wklen
: Integer; // to the respective edges
423 if (stleft
< 2) then begin result
:= true; exit
; end; // max one pixel left, nothing to do
425 // strictly horizontal?
432 ex
:= (xd
and (not (TileSize
-1)))-1;
438 ex
:= (xd
or (TileSize
-1))+1;
441 result
:= (stleft
<= 0);
446 // strictly vertical?
453 ey
:= (yd
and (not (TileSize
-1)))-1;
458 // yd: to bottom edge
459 ey
:= (yd
or (TileSize
-1))+1;
462 result
:= (stleft
<= 0);
472 ex
:= (xd
and (not (TileSize
-1)))-1;
477 ex
:= (xd
or (TileSize
-1))+1;
484 ey
:= (yd
and (not (TileSize
-1)))-1;
489 ey
:= (yd
or (TileSize
-1))+1;
494 while (xd <> ex) and (yd <> ey) do
500 if (err >= 0) then begin err -= errmax; yd += sty; end;
506 if (err >= 0) then begin err -= errmax; xd += stx; end;
509 if (stleft < 1) then begin result := true; exit; end;
513 if (xwalk
<= ywalk
) then wklen
:= xwalk
else wklen
:= ywalk
;
516 // in which dir we want to walk?
518 if (stleft
<= 0) then begin result
:= true; exit
; end;
522 for f
:= 1 to wklen
do
525 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
531 for f
:= 1 to wklen
do
534 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
537 // check for walk completion
538 if (xd
= ex
) or (yd
= ey
) then exit
;
543 procedure TLineWalker
.getXY (out ox
, oy
: Integer); inline; begin ox
:= xd
; oy
:= yd
; end;
546 // ////////////////////////////////////////////////////////////////////////// //
547 procedure TBodyGridBase
.TBodyProxyRec
.setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
560 function TBodyGridBase
.TBodyProxyRec
.getTag (): Integer; inline;
562 result
:= mTag
and TagFullMask
;
565 procedure TBodyGridBase
.TBodyProxyRec
.setTag (v
: Integer); inline;
567 mTag
:= (mTag
and TagDisabled
) or (v
and TagFullMask
);
570 function TBodyGridBase
.TBodyProxyRec
.getEnabled (): Boolean; inline;
572 result
:= ((mTag
and TagDisabled
) = 0);
575 procedure TBodyGridBase
.TBodyProxyRec
.setEnabled (v
: Boolean); inline;
577 if v
then mTag
:= mTag
and (not TagDisabled
) else mTag
:= mTag
or TagDisabled
;
580 function TBodyGridBase
.TBodyProxyRec
.getX1 (): Integer; inline;
582 result
:= mX
+mWidth
-1;
585 function TBodyGridBase
.TBodyProxyRec
.getY1 (): Integer; inline;
587 result
:= mY
+mHeight
-1;
591 // ////////////////////////////////////////////////////////////////////////// //
592 constructor TBodyGridBase
.TAtPointEnumerator
.Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
601 function TBodyGridBase
.TAtPointEnumerator
.MoveNext (): Boolean; inline;
603 while (curidx
<> -1) do
605 while (curbki
< GridCellBucketSize
) do
608 if (mCells
[curidx
].bodies
[curbki
] = -1) then break
;
612 curidx
:= mCells
[curidx
].next
;
619 function TBodyGridBase
.TAtPointEnumerator
.getCurrent (): PBodyProxyRec
; inline;
621 result
:= getpx(mCells
[curidx
].bodies
[curbki
]);
625 // ////////////////////////////////////////////////////////////////////////// //
626 constructor TBodyGridBase
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
630 dbgShowTraceLog
:= false;
631 {$IF DEFINED(D2F_DEBUG)}
632 dbgRayTraceTileHitCB
:= nil;
635 if aTileSize < 1 then aTileSize := 1;
636 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
637 mTileSize := aTileSize;
639 if (aPixWidth
< mTileSize
) then aPixWidth
:= mTileSize
;
640 if (aPixHeight
< mTileSize
) then aPixHeight
:= mTileSize
;
643 mWidth
:= (aPixWidth
+mTileSize
-1) div mTileSize
;
644 mHeight
:= (aPixHeight
+mTileSize
-1) div mTileSize
;
645 SetLength(mGrid
, mWidth
*mHeight
);
646 SetLength(mCells
, mWidth
*mHeight
);
647 SetLength(mProxies
, 8192);
650 for idx
:= 0 to High(mCells
) do
652 mCells
[idx
].bodies
[0] := -1;
653 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
654 mCells
[idx
].next
:= idx
+1;
656 mCells
[High(mCells
)].next
:= -1; // last cell
658 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
660 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
661 mProxies
[High(mProxies
)].nextLink
:= -1;
667 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
]), TMsgType
.Notify
);
671 destructor TBodyGridBase
.Destroy ();
680 // ////////////////////////////////////////////////////////////////////////// //
681 procedure TBodyGridBase
.dumpStats ();
683 idx
, mcb
, ccidx
, cnt
: Integer;
686 for idx
:= 0 to High(mGrid
) do
693 ccidx
:= mCells
[ccidx
].next
;
695 if (mcb
< cnt
) then mcb
:= cnt
;
697 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
);
701 function TBodyGridBase
.forEachBodyCell (body
: TBodyProxyId
): CellCoordIter
;
703 g
, f
, ccidx
: Integer;
705 presobj
: PGridCellCoord
;
707 result
:= CellCoordIter
.Create(framePool
);
708 if (body
< 0) or (body
> High(mProxies
)) then begin result
.finishIt(); exit
; end;
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
720 presobj
:= PGridCellCoord(framePool
.alloc(sizeof(TGridCellCoord
)));
721 presobj
^.x
:= (g
mod mWidth
)*mTileSize
+mMinX
;
722 presobj
^.y
:= (g
div mWidth
)*mTileSize
+mMinY
;
723 //cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
734 function TBodyGridBase
.forEachInCell (x
, y
: Integer): Iter
;
740 result
:= Iter
.Create(framePool
);
743 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
> mHeight
*mTileSize
) then begin result
.finishIt(); exit
; end;
744 ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
745 while (ccidx
<> -1) do
747 cc
:= @mCells
[ccidx
];
748 for f
:= 0 to GridCellBucketSize
-1 do
750 if (cc
.bodies
[f
] = -1) then break
;
751 //if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
752 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
753 //presobj^ := mProxies[cc.bodies[f]].mObj;
754 Move(mProxies
[cc
.bodies
[f
]].mObj
, presobj
^, sizeof(ITP
));
763 // ////////////////////////////////////////////////////////////////////////// //
764 function TBodyGridBase
.getGridWidthPx (): Integer; inline; begin result
:= mWidth
*mTileSize
; end;
765 function TBodyGridBase
.getGridHeightPx (): Integer; inline; begin result
:= mHeight
*mTileSize
; end;
768 function TBodyGridBase
.insideGrid (x
, y
: Integer): Boolean; inline;
773 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
);
777 function TBodyGridBase
.getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
779 if (body
>= 0) and (body
< Length(mProxies
)) then
781 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; end;
793 function TBodyGridBase
.getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
795 if (body
>= 0) and (body
< Length(mProxies
)) then
797 with mProxies
[body
] do begin rw
:= mWidth
; rh
:= mHeight
; end;
809 function TBodyGridBase
.getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
811 if (body
>= 0) and (body
< Length(mProxies
)) then
813 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; rw
:= mWidth
; rh
:= mHeight
; end;
828 // ////////////////////////////////////////////////////////////////////////// //
829 function TBodyGridBase
.getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
831 if (pid
>= 0) and (pid
< Length(mProxies
)) then result
:= ((mProxies
[pid
].mTag
and TagDisabled
) = 0) else result
:= false;
835 procedure TBodyGridBase
.setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
837 if (pid
>= 0) and (pid
< Length(mProxies
)) then
841 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
and not TagDisabled
;
845 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
or TagDisabled
;
851 function TBodyGridBase
.getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
853 if (idx
>= 0) and (idx
< Length(mProxies
)) then result
:= @mProxies
[idx
] else result
:= nil;
857 // ////////////////////////////////////////////////////////////////////////// //
858 function TBodyGridBase
.allocCell (): Integer;
863 if (mFreeCell
< 0) then
865 // no free cells, want more
866 mFreeCell
:= Length(mCells
);
867 SetLength(mCells
, mFreeCell
+32768); // arbitrary number
868 for idx
:= mFreeCell
to High(mCells
) do
870 mCells
[idx
].bodies
[0] := -1;
871 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
872 mCells
[idx
].next
:= idx
+1;
874 mCells
[High(mCells
)].next
:= -1; // last cell
877 pc
:= @mCells
[result
];
878 mFreeCell
:= pc
.next
;
881 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
885 procedure TBodyGridBase
.freeCell (idx
: Integer);
887 if (idx
>= 0) and (idx
< Length(mCells
)) then
892 bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
901 // ////////////////////////////////////////////////////////////////////////// //
902 function TBodyGridBase
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
907 if (mProxyFree
= -1) then
909 // no free proxies, resize list
910 olen
:= Length(mProxies
);
911 SetLength(mProxies
, olen
+8192); // arbitrary number
912 for idx
:= olen
to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
913 mProxies
[High(mProxies
)].nextLink
:= -1;
917 result
:= mProxyFree
;
918 px
:= @mProxies
[result
];
919 mProxyFree
:= px
.nextLink
;
920 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
925 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
928 procedure TBodyGridBase
.freeProxy (body
: TBodyProxyId
);
930 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
931 if (mProxyCount
= 0) then raise Exception
.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
933 mProxies
[body
].mObj
:= nil;
934 mProxies
[body
].nextLink
:= mProxyFree
;
940 // ////////////////////////////////////////////////////////////////////////// //
941 function TBodyGridBase
.forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
948 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
953 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
956 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then exit
;
957 ex
:= (x
+w
-1) div mTileSize
;
958 ey
:= (y
+h
-1) div mTileSize
;
959 x
:= x
div mTileSize
;
960 y
:= y
div mTileSize
;
962 if (x
< 0) then x
:= 0 else if (x
>= gw
) then x
:= gw
-1;
963 if (y
< 0) then y
:= 0 else if (y
>= gh
) then y
:= gh
-1;
964 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
965 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
966 if (x
> ex
) or (y
> ey
) then exit
; // just in case
972 result
:= cb(gy
*gw
+gx
, bodyId
);
979 // ////////////////////////////////////////////////////////////////////////// //
980 function TBodyGridBase
.inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
987 result
:= false; // never stop
988 // add body to the given grid cell
992 {$IF DEFINED(D2F_DEBUG)}
994 while (ccidx
<> -1) do
996 pi
:= @mCells
[ccidx
];
997 for f
:= 0 to GridCellBucketSize
-1 do
999 if (pi
.bodies
[f
] = -1) then break
;
1000 if (pi
.bodies
[f
] = bodyId
) then raise Exception
.Create('trying to insert already inserted proxy');
1006 while (ccidx
<> -1) do
1008 pi
:= @mCells
[ccidx
];
1009 // check "has room" flag
1010 if (pi
.bodies
[GridCellBucketSize
-1] = -1) then
1013 for f
:= 0 to GridCellBucketSize
-1 do
1015 if (pi
.bodies
[f
] = -1) then
1017 pi
.bodies
[f
] := bodyId
;
1018 if (f
+1 < GridCellBucketSize
) then pi
.bodies
[f
+1] := -1;
1022 raise Exception
.Create('internal error in grid inserter');
1024 // no room, go to next cell in list (if there is any)
1027 // no room in cells, add new cell to list
1029 // either no room, or no cell at all
1030 ccidx
:= allocCell();
1031 pi
:= @mCells
[ccidx
];
1032 pi
.bodies
[0] := bodyId
;
1035 mGrid
[grida
] := ccidx
;
1039 // assume that we cannot have one object added to bucket twice
1040 function TBodyGridBase
.remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
1043 pidx
, ccidx
: Integer;
1046 result
:= false; // never stop
1047 // find and remove cell
1048 pidx
:= -1; // previous cell index
1049 ccidx
:= mGrid
[grida
]; // current cell index
1050 while (ccidx
<> -1) do
1052 pc
:= @mCells
[ccidx
];
1053 for f
:= 0 to GridCellBucketSize
-1 do
1055 if (pc
.bodies
[f
] = bodyId
) then
1058 if (f
= 0) and (pc
.bodies
[1] = -1) then
1060 // this cell contains no elements, remove it
1061 if (pidx
= -1) then mGrid
[grida
] := pc
.next
else mCells
[pidx
].next
:= pc
.next
;
1065 // remove element from bucket
1066 for c
:= f
to GridCellBucketSize
-2 do
1068 pc
.bodies
[c
] := pc
.bodies
[c
+1];
1069 if (pc
.bodies
[c
] = -1) then break
;
1071 pc
.bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
1081 // ////////////////////////////////////////////////////////////////////////// //
1082 function TBodyGridBase
.insertBody (aObj
: ITP
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
1084 aTag
:= aTag
and TagFullMask
;
1085 result
:= allocProxy(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
1086 //insertInternal(result);
1087 forGridRect(aX
, aY
, aWidth
, aHeight
, inserter
, result
);
1091 procedure TBodyGridBase
.removeBody (body
: TBodyProxyId
);
1095 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1096 px
:= @mProxies
[body
];
1097 //removeInternal(body);
1098 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1103 // ////////////////////////////////////////////////////////////////////////// //
1104 procedure TBodyGridBase
.moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
1107 x0
, y0
, w
, h
: Integer;
1109 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1110 px
:= @mProxies
[body
];
1115 {$IF DEFINED(D2F_DEBUG_MOVER)}
1116 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
);
1118 if (nx
= x0
) and (ny
= y0
) and (nw
= w
) and (nh
= h
) then exit
;
1124 // did any corner crossed tile boundary?
1125 if (x0
div mTileSize
<> nx
div mTileSize
) or
1126 (y0
div mTileSize
<> ny
div mTileSize
) or
1127 ((x0
+w
-1) div mTileSize
<> (nx
+nw
-1) div mTileSize
) or
1128 ((y0
+h
-1) div mTileSize
<> (ny
+nh
-1) div mTileSize
) then
1130 //writeln('moveResizeBody: cell occupation changed! old=(', x0, ',', y0, ')-(', x0+w-1, ',', y0+h-1, '); new=(', nx, ',', ny, ')-(', nx+nw-1, ',', ny+nh-1, ')');
1131 //removeInternal(body);
1132 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1137 //insertInternal(body);
1138 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1150 //TODO: optimize for horizontal/vertical moves
1151 procedure TBodyGridBase
.moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
1155 ogx0
, ogx1
, ogy0
, ogy1
: Integer; // old grid rect
1156 ngx0
, ngx1
, ngy0
, ngy1
: Integer; // new grid rect
1161 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1162 // check if tile coords was changed
1163 px
:= @mProxies
[body
];
1166 if (nx
= x0
) and (ny
= y0
) then exit
;
1172 // check for heavy work
1175 ogx0
:= x0
div mTileSize
;
1176 ogy0
:= y0
div mTileSize
;
1177 ngx0
:= nx
div mTileSize
;
1178 ngy0
:= ny
div mTileSize
;
1179 ogx1
:= (x0
+pw
-1) div mTileSize
;
1180 ogy1
:= (y0
+ph
-1) div mTileSize
;
1181 ngx1
:= (nx
+pw
-1) div mTileSize
;
1182 ngy1
:= (ny
+ph
-1) div mTileSize
;
1183 {$IF DEFINED(D2F_DEBUG_MOVER)}
1184 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
);
1186 if (ogx0
<> ngx0
) or (ogy0
<> ngy0
) or (ogx1
<> ngx1
) or (ogy1
<> ngy1
) then
1188 // crossed tile boundary, do heavy work
1191 // cycle with old rect, remove body where it is necessary
1192 // optimized for horizontal moves
1193 {$IF DEFINED(D2F_DEBUG_MOVER)}
1194 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
);
1196 // remove stale marks
1197 if not ((ogy0
>= gh
) or (ogy1
< 0)) and
1198 not ((ogx0
>= gw
) or (ogx1
< 0)) then
1200 if (ogx0
< 0) then ogx0
:= 0;
1201 if (ogy0
< 0) then ogy0
:= 0;
1202 if (ogx1
> gw
-1) then ogx1
:= gw
-1;
1203 if (ogy1
> gh
-1) then ogy1
:= gh
-1;
1204 {$IF DEFINED(D2F_DEBUG_MOVER)}
1205 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0
, ogy0
, ogx1
, ogy1
]), MSG_NOTIFY
);
1207 for gx
:= ogx0
to ogx1
do
1209 if (gx
< ngx0
) or (gx
> ngx1
) then
1211 // this column is completely outside of new rect
1212 for gy
:= ogy0
to ogy1
do
1214 {$IF DEFINED(D2F_DEBUG_MOVER)}
1215 e_WriteLog(Format(' remove0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1217 remover(gy
*gw
+gx
, body
);
1223 for gy
:= ogy0
to ogy1
do
1225 if (gy
< ngy0
) or (gy
> ngy1
) then
1227 {$IF DEFINED(D2F_DEBUG_MOVER)}
1228 e_WriteLog(Format(' remove1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1230 remover(gy
*gw
+gx
, body
);
1236 // cycle with new rect, add body where it is necessary
1237 if not ((ngy0
>= gh
) or (ngy1
< 0)) and
1238 not ((ngx0
>= gw
) or (ngx1
< 0)) then
1240 if (ngx0
< 0) then ngx0
:= 0;
1241 if (ngy0
< 0) then ngy0
:= 0;
1242 if (ngx1
> gw
-1) then ngx1
:= gw
-1;
1243 if (ngy1
> gh
-1) then ngy1
:= gh
-1;
1244 {$IF DEFINED(D2F_DEBUG_MOVER)}
1245 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0
, ngy0
, ngx1
, ngy1
]), MSG_NOTIFY
);
1247 for gx
:= ngx0
to ngx1
do
1249 if (gx
< ogx0
) or (gx
> ogx1
) then
1251 // this column is completely outside of old rect
1252 for gy
:= ngy0
to ngy1
do
1254 {$IF DEFINED(D2F_DEBUG_MOVER)}
1255 e_WriteLog(Format(' insert0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1257 inserter(gy
*gw
+gx
, body
);
1263 for gy
:= ngy0
to ngy1
do
1265 if (gy
< ogy0
) or (gy
> ogy1
) then
1267 {$IF DEFINED(D2F_DEBUG_MOVER)}
1268 e_WriteLog(Format(' insert1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1270 inserter(gy
*gw
+gx
, body
);
1280 {$IF DEFINED(D2F_DEBUG_MOVER)}
1281 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
);
1284 // update coordinates
1290 procedure TBodyGridBase
.resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
1293 x0
, y0
, w
, h
: Integer;
1295 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1296 // check if tile coords was changed
1297 px
:= @mProxies
[body
];
1302 {$IF DEFINED(D2F_DEBUG_MOVER)}
1303 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
);
1305 if ((x0
+w
-1) div mTileSize
<> (x0
+nw
-1) div mTileSize
) or
1306 ((y0
+h
-1) div mTileSize
<> (y0
+nh
-1) div mTileSize
) then
1308 // crossed tile boundary, do heavy work
1309 //removeInternal(body);
1310 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1313 //insertInternal(body);
1314 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1318 // nothing to do with the grid, just fix size
1325 // ////////////////////////////////////////////////////////////////////////// //
1326 function TBodyGridBase
.atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
1328 ccidx
: Integer = -1;
1332 if (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
) then ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1333 result
:= TAtPointEnumerator
.Create(mCells
, ccidx
, getProxyById
);
1337 // ////////////////////////////////////////////////////////////////////////// //
1338 // no callback: return `true` on the first hit
1339 function TBodyGridBase
.forEachAtPoint (x
, y
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
1342 idx
, curci
: Integer;
1343 cc
: PGridCell
= nil;
1349 result
:= Iter
.Create(framePool
);
1350 tagmask
:= tagmask
and TagFullMask
;
1351 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1353 {$IF DEFINED(D2F_DEBUG_XXQ)}
1354 if (assigned(cb
)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x
, y
]), MSG_NOTIFY
);
1357 // make coords (0,0)-based
1360 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
>= mHeight
*mTileSize
) then begin result
.finishIt(); exit
; end;
1362 curci
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1364 {$IF DEFINED(D2F_DEBUG_XXQ)}
1365 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
);
1372 // increase query counter
1374 if (mLastQuery
= 0) then
1376 // just in case of overflow
1378 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1382 {$IF DEFINED(D2F_DEBUG_XXQ)}
1383 if (assigned(cb
)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x
, y
, lq
]), MSG_NOTIFY
);
1386 while (curci
<> -1) do
1388 {$IF DEFINED(D2F_DEBUG_XXQ)}
1389 //if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1391 cc
:= @mCells
[curci
];
1392 for f
:= 0 to GridCellBucketSize
-1 do
1394 if (cc
.bodies
[f
] = -1) then break
;
1395 px
:= @mProxies
[cc
.bodies
[f
]];
1396 {$IF DEFINED(D2F_DEBUG_XXQ)}
1397 //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);
1399 if (px
.mQueryMark
= lq
) then continue
;
1400 px
.mQueryMark
:= lq
;
1402 if (not allowDisabled
) and ((ptag
and TagDisabled
) <> 0) then continue
;
1403 if ((ptag
and tagmask
) = 0) then continue
;
1404 if (x
>= px
.mX
) and (y
>= px
.mY
) and (x
< px
.mX
+px
.mWidth
) and (y
< px
.mY
+px
.mHeight
) then
1406 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1407 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1408 if (firstHit
) then begin result
.finishIt(); exit
; end;
1417 // ////////////////////////////////////////////////////////////////////////// //
1418 // no callback: return `true` on the first hit
1419 // return number of ITP thingys put into frame pool
1420 function TBodyGridBase
.forEachInAABB (x
, y
, w
, h
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
1424 sx
, sy
, ex
, ey
: Integer;
1427 cc
: PGridCell
= nil;
1435 if (w
= 1) and (h
= 1) then
1437 result
:= forEachAtPoint(x
, y
, tagmask
, allowDisabled
, firstHit
);
1441 result
:= Iter
.Create(framePool
);
1442 if (w
< 1) or (h
< 1) then begin result
.finishIt(); exit
; end;
1444 tagmask
:= tagmask
and TagFullMask
;
1445 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1457 if (x
+w
<= 0) or (y
+h
<= 0) then begin result
.finishIt(); exit
; end;
1458 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then begin result
.finishIt(); exit
; end;
1460 sx
:= x
div mTileSize
;
1461 sy
:= y
div mTileSize
;
1462 ex
:= (x
+w
-1) div mTileSize
;
1463 ey
:= (y
+h
-1) div mTileSize
;
1466 if (sx
< 0) then sx
:= 0 else if (sx
>= gw
) then sx
:= gw
-1;
1467 if (sy
< 0) then sy
:= 0 else if (sy
>= gh
) then sy
:= gh
-1;
1468 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
1469 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
1470 if (sx
> ex
) or (sy
> ey
) then begin result
.finishIt(); exit
; end; // just in case
1472 // has something to do
1474 // increase query counter
1476 if (mLastQuery
= 0) then
1478 // just in case of overflow
1480 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1482 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1486 for gy
:= sy
to ey
do
1488 for gx
:= sx
to ex
do
1491 curci
:= mGrid
[gy
*gw
+gx
];
1492 while (curci
<> -1) do
1494 cc
:= @mCells
[curci
];
1495 for f
:= 0 to GridCellBucketSize
-1 do
1497 if (cc
.bodies
[f
] = -1) then break
;
1498 px
:= @mProxies
[cc
.bodies
[f
]];
1499 // shit! has to do it this way, so i can change tag in callback
1500 if (px
.mQueryMark
= lq
) then continue
;
1501 px
.mQueryMark
:= lq
;
1503 if (not allowDisabled
) and ((ptag
and TagDisabled
) <> 0) then continue
;
1504 if ((ptag
and tagmask
) = 0) then continue
;
1505 if (x0
>= px
.mX
+px
.mWidth
) or (y0
>= px
.mY
+px
.mHeight
) then continue
;
1506 if (x0
+w
<= px
.mX
) or (y0
+h
<= px
.mY
) then continue
;
1507 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1508 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1509 if (firstHit
) then begin result
.finishIt(); exit
; end;
1519 // ////////////////////////////////////////////////////////////////////////// //
1520 function TBodyGridBase
.forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1; log
: Boolean=false): Iter
;
1528 gw
, gh
, minx
, miny
: Integer;
1532 //px0, py0, px1, py1: Integer;
1536 result
:= Iter
.Create(framePool
);
1537 tagmask
:= tagmask
and TagFullMask
;
1538 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1545 // make query coords (0,0)-based
1551 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
1552 if not lw
.setup(x0
, y0
, x1
, y1
) then begin result
.finishIt(); exit
; end; // out of screen
1554 // increase query counter
1556 if (mLastQuery
= 0) then
1558 // just in case of overflow
1560 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1567 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1569 while (ccidx
<> -1) do
1571 cc
:= @mCells
[ccidx
];
1572 for f
:= 0 to GridCellBucketSize
-1 do
1574 if (cc
.bodies
[f
] = -1) then break
;
1575 px
:= @mProxies
[cc
.bodies
[f
]];
1577 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1579 px
.mQueryMark
:= lq
; // mark as processed
1580 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1581 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1587 // done processing cells, move to next tile
1588 until lw
.stepToNextTile();
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 // trace box with the given velocity; return object hit (if any)
1595 function TBodyGridBase
.traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; tagmask
: Integer=-1): ITP
;
1603 minu0
: Single = 100000.0;
1605 cx0
, cy0
, cx1
, cy1
: Integer;
1606 hitpx
: PBodyProxyRec
= nil;
1608 result
:= Default(ITP
);
1611 if (aw
< 1) or (ah
< 1) then exit
;
1613 cx0
:= nmin(ax0
, ax0
+dx
);
1614 cy0
:= nmin(ay0
, ay0
+dy
);
1615 cx1
:= nmax(ax0
+aw
-1, ax0
+aw
-1+dx
);
1616 cy1
:= nmax(ay0
+ah
-1, ay0
+ah
-1+dy
);
1618 cx0
-= mMinX
; cy0
-= mMinY
;
1619 cx1
-= mMinX
; cy1
-= mMinY
;
1621 if (cx1
< 0) or (cy1
< 0) or (cx0
>= mWidth
*mTileSize
) or (cy0
>= mHeight
*mTileSize
) then exit
;
1623 if (cx0
< 0) then cx0
:= 0;
1624 if (cy0
< 0) then cy0
:= 0;
1625 if (cx1
>= mWidth
*mTileSize
) then cx1
:= mWidth
*mTileSize
-1;
1626 if (cy1
>= mHeight
*mTileSize
) then cy1
:= mHeight
*mTileSize
-1;
1628 if (cx0
> cx1
) or (cy0
> cy1
) then exit
;
1630 // increase query counter
1632 if (mLastQuery
= 0) then
1634 // just in case of overflow
1636 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1640 for gy
:= cy0
div mTileSize
to cy1
div mTileSize
do
1642 for gx
:= cx0
div mTileSize
to cx1
div mTileSize
do
1644 ccidx
:= mGrid
[gy
*mWidth
+gx
];
1645 while (ccidx
<> -1) do
1647 cc
:= @mCells
[ccidx
];
1648 for f
:= 0 to GridCellBucketSize
-1 do
1650 if (cc
.bodies
[f
] = -1) then break
;
1651 px
:= @mProxies
[cc
.bodies
[f
]];
1653 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1655 px
.mQueryMark
:= lq
; // mark as processed
1656 if not sweepAABB(ax0
, ay0
, aw
, ah
, dx
, dy
, px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, @u0
) then continue
;
1657 if (minu0
> u0
) then
1677 if (minu0
<= 1.0) then
1679 ex
:= ax0
+round(dx
*minu0
);
1680 ey
:= ay0
+round(dy
*minu0
);
1681 // just in case, compensate for floating point inexactness
1682 if (ex
>= hitpx
.mX
) and (ey
>= hitpx
.mY
) and (ex
< hitpx
.mX
+hitpx
.mWidth
) and (ey
< hitpx
.mY
+hitpx
.mHeight
) then
1684 ex
:= ax0
+trunc(dx
*minu0
);
1685 ey
:= ay0
+trunc(dy
*minu0
);
1691 // ////////////////////////////////////////////////////////////////////////// //
1692 {.$DEFINE D2F_DEBUG_OTR}
1693 function TBodyGridBase
.traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
1699 minx
, miny
: Integer;
1701 x0
, y0
, x1
, y1
: Integer;
1702 celly0
, celly1
: Integer;
1704 filled
: array[0..mTileSize
-1] of Byte;
1705 {$IF DEFINED(D2F_DEBUG_OTR)}
1713 if not ((ax0
= ax1
) or (ay0
= ay1
)) then raise Exception
.Create('orthoray is not orthogonal');
1715 tagmask
:= tagmask
and TagFullMask
;
1716 if (tagmask
= 0) then exit
;
1718 it
:= forEachAtPoint(ax0
, ay0
, tagmask
, false, true);
1719 if (it
.length
= 0) then begin it
.release(); exit
; end;
1725 // offset query coords to (0,0)-based
1733 if (x0
< 0) or (x0
>= mWidth
*mTileSize
) then exit
; // oops
1738 if (y1
< 0) or (y0
>= mHeight
*mTileSize
) then exit
;
1739 //if (ay0 < 0) then ay0 := 0;
1740 if (y0
< 0) then exit
;
1741 if (y1
>= mHeight
*mTileSize
) then y1
:= mHeight
*mTileSize
-1;
1747 if (y0
< 0) or (y1
>= mHeight
*mTileSize
) then exit
;
1748 //if (ay1 < 0) then ay1 := 0;
1749 if (y1
< 0) then exit
;
1750 if (y0
>= mHeight
*mTileSize
) then y0
:= mHeight
*mTileSize
-1;
1756 ccidx
:= mGrid
[(y0
div mTileSize
)*mWidth
+(x0
div mTileSize
)];
1757 FillChar(filled
, sizeof(filled
), 0);
1758 celly0
:= y0
and (not (mTileSize
-1));
1759 celly1
:= celly0
+mTileSize
-1;
1760 while (ccidx
<> -1) do
1762 cc
:= @mCells
[ccidx
];
1763 for f
:= 0 to GridCellBucketSize
-1 do
1765 if (cc
.bodies
[f
] = -1) then break
;
1766 px
:= @mProxies
[cc
.bodies
[f
]];
1768 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and
1769 (ax0
>= px
.x0
) and (ax0
<= px
.x1
) then
1771 // bound c0 and c1 to cell
1772 c0
:= nclamp(px
.y0
-miny
, celly0
, celly1
);
1773 c1
:= nclamp(px
.y1
-miny
, celly0
, celly1
);
1775 {$IF DEFINED(D2F_DEBUG_OTR)}
1776 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
)]);
1779 FillChar(filled
[c0
-celly0
], c1
-c0
+1, 1);
1785 {$IF DEFINED(D2F_DEBUG_OTR)}
1786 s
:= formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0
, ay0
, ay1
, y0
, celly0
, celly1
, dy
]);
1787 for f
:= 0 to High(filled
) do if (filled
[f
] <> 0) then s
+= '1' else s
+= '0';
1791 // now go till we hit cell boundary or empty space
1795 while (y0
>= celly0
) and (filled
[y0
-celly0
] <> 0) do
1797 {$IF DEFINED(D2F_DEBUG_OTR)}
1798 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
1803 {$IF DEFINED(D2F_DEBUG_OTR)}
1804 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
1806 if (ay0
<= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
1807 if (y0
>= celly0
) then begin ey
:= ay0
+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result
:= true; exit
; end;
1812 while (y0
<= celly1
) and (filled
[y0
-celly0
] <> 0) do begin Inc(y0
); Inc(ay0
); end;
1813 if (ay0
>= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
1814 if (y0
<= celly1
) then begin ey
:= ay0
-1; result
:= true; exit
; end;
1826 // ////////////////////////////////////////////////////////////////////////// //
1827 function TBodyGridBase
.traceRay (const x0
, y0
, x1
, y1
: Integer; tagmask
: Integer=-1): ITP
;
1831 result
:= traceRay(ex
, ey
, x0
, y0
, x1
, y1
, tagmask
);
1835 // you are not supposed to understand this
1836 function TBodyGridBase
.traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): ITP
;
1844 gw
, gh
, minx
, miny
: Integer;
1848 px0
, py0
, px1
, py1
: Integer;
1849 lastDistSq
, distSq
, hx
, hy
: Integer;
1850 firstCell
: Boolean = true;
1853 result
:= Default(ITP
);
1854 tagmask
:= tagmask
and TagFullMask
;
1855 if (tagmask
= 0) then exit
;
1862 // make query coords (0,0)-based
1868 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
1869 if not lw
.setup(x0
, y0
, x1
, y1
) then exit
; // out of screen
1871 lastDistSq
:= distanceSq(ax0
, ay0
, ax1
, ay1
)+1;
1873 {$IF DEFINED(D2F_DEBUG)}
1874 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]);
1877 // increase query counter
1879 if (mLastQuery
= 0) then
1881 // just in case of overflow
1883 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1889 {$IF DEFINED(D2F_DEBUG)}
1890 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB(cx
+mMinX
, cy
+mMinY
);
1893 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1896 while (ccidx
<> -1) do
1898 cc
:= @mCells
[ccidx
];
1899 for f
:= 0 to GridCellBucketSize
-1 do
1901 if (cc
.bodies
[f
] = -1) then break
;
1902 px
:= @mProxies
[cc
.bodies
[f
]];
1904 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1906 px
.mQueryMark
:= lq
; // mark as processed
1907 // get adjusted proxy coords
1910 px1
:= px0
+px
.mWidth
-1;
1911 py1
:= py0
+px
.mHeight
-1;
1912 {$IF DEFINED(D2F_DEBUG)}
1913 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' cxy=(%s,%s); pan=(%s,%s)-(%s,%s)', [cx, cy, px0, py0, px1, py1]);
1916 if firstCell
and (x0
>= px0
) and (y0
>= py0
) and (x0
<= px1
) and (y0
<= py1
) then
1922 {$IF DEFINED(D2F_DEBUG)}
1923 if assigned(dbgRayTraceTileHitCB
) then e_LogWriteln(' INSIDE!');
1927 // do line-vs-aabb test
1928 if lineAABBIntersects(x0
, y0
, x1
, y1
, px0
, py0
, px1
-px0
+1, py1
-py0
+1, hx
, hy
) then
1931 distSq
:= distanceSq(x0
, y0
, hx
, hy
);
1932 {$IF DEFINED(D2F_DEBUG)}
1933 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' hit=(%s,%s); distSq=%s; lastDistSq=%s', [hx, hy, distSq, lastDistSq]);
1935 if (distSq
< lastDistSq
) then
1937 lastDistSq
:= distSq
;
1949 // done processing cells; exit if we registered a hit
1950 // next cells can't have better candidates, obviously
1951 if wasHit
then exit
;
1953 // move to next tile
1954 until lw
.stepToNextTile();