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, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 // universal spatial grid
16 {$INCLUDE ../shared/a_modes.inc}
17 {$IF DEFINED(D2F_DEBUG)}
18 {.$DEFINE D2F_DEBUG_RAYTRACE}
19 {.$DEFINE D2F_DEBUG_XXQ}
20 {.$DEFINE D2F_DEBUG_MOVER}
22 {.$DEFINE GRID_USE_ORTHO_ACCEL}
32 * In order to make this usable for kind-of-recursive calls,
33 * we'll use "frame memory pool" to return results. That is,
34 * we will allocate a memory pool that will be cleared on
35 * frame start, and then used as a simple "no-free" allocator.
36 * Grid will put results into this pool, and will never bother
37 * to free it. Caller should call "release" on result, and
38 * the pool will throw away everything.
39 * No more callbacks, of course.
43 GridTileSize
= 32; // must be power of two!
46 PGridCellCoord
= ^TGridCellCoord
;
47 TGridCellCoord
= record
51 CellCoordIter
= specialize PoolIter
<TGridCellCoord
>;
55 TBodyProxyId
= Integer;
57 generic TBodyGridBase
<ITP
> = class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
60 type TCellQueryCB
= procedure (x
, y
: Integer) is nested
; // top-left cell corner coords
62 type Iter
= specialize PoolIter
<ITP
>;
64 const TagDisabled
= $40000000;
65 const TagFullMask
= $3fffffff;
69 GridCellBucketSize
= 8; // WARNING! can't be less than 2!
73 PBodyProxyRec
= ^TBodyProxyRec
;
74 TBodyProxyRec
= record
76 mX
, mY
, mWidth
, mHeight
: Integer; // aabb
77 mQueryMark
: LongWord
; // was this object visited at this query?
79 mTag
: Integer; // `TagDisabled` set: disabled ;-)
80 nextLink
: TBodyProxyId
; // next free or nothing
83 procedure setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
85 function getTag (): Integer; inline;
86 procedure setTag (v
: Integer); inline;
88 function getEnabled (): Boolean; inline;
89 procedure setEnabled (v
: Boolean); inline;
91 function getX1 (): Integer; inline;
92 function getY1 (): Integer; inline;
95 property x
: Integer read mX
;
96 property y
: Integer read mY
;
97 property width
: Integer read mWidth
;
98 property height
: Integer read mHeight
;
99 property tag
: Integer read getTag write setTag
;
100 property enabled
: Boolean read getEnabled write setEnabled
;
101 property obj
: ITP read mObj
;
103 property x0
: Integer read mX
;
104 property y0
: Integer read mY
;
105 property x1
: Integer read getX1
;
106 property y1
: Integer read getY1
;
111 PGridCell
= ^TGridCell
;
113 bodies
: array [0..GridCellBucketSize
-1] of Integer; // -1: end of list
114 next
: Integer; // in this cell; index in mCells
117 TCellArray
= array of TGridCell
;
119 TGridInternalCB
= function (grida
: Integer; bodyId
: TBodyProxyId
): Boolean of object; // return `true` to stop
122 //mTileSize: Integer;
123 const mTileSize
= GridTileSize
;
124 type TGetProxyFn
= function (pxidx
: Integer): PBodyProxyRec
of object;
127 const tileSize
= mTileSize
;
130 TAtPointEnumerator
= record
133 curidx
, curbki
: Integer;
136 constructor Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
137 function MoveNext (): Boolean; inline;
138 function getCurrent (): PBodyProxyRec
; inline;
139 property Current
: PBodyProxyRec read getCurrent
;
143 mMinX
, mMinY
: Integer; // so grids can start at any origin
144 mWidth
, mHeight
: Integer; // in tiles
145 mGrid
: array of Integer; // mWidth*mHeight, index in mCells
146 mCells
: TCellArray
; // cell pool
147 mFreeCell
: Integer; // first free cell index or -1
148 mLastQuery
: LongWord
;
150 mProxies
: array of TBodyProxyRec
;
151 mProxyFree
: TBodyProxyId
; // free
152 mProxyCount
: Integer; // currently used
153 mProxyMaxCount
: Integer;
156 dbgShowTraceLog
: Boolean;
157 {$IF DEFINED(D2F_DEBUG)}
158 dbgRayTraceTileHitCB
: TCellQueryCB
;
162 function allocCell (): Integer;
163 procedure freeCell (idx
: Integer); // `next` is simply overwritten
165 function allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
166 procedure freeProxy (body
: TBodyProxyId
);
168 function forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
170 function inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
171 function remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
173 function getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
174 procedure setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
176 function getGridWidthPx (): Integer; inline;
177 function getGridHeightPx (): Integer; inline;
179 function getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
182 constructor Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
183 destructor Destroy (); override;
185 function insertBody (aObj
: ITP
; ax
, ay
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
186 procedure removeBody (body
: TBodyProxyId
); // WARNING! this WILL destroy proxy!
188 procedure moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
189 procedure resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
190 procedure moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
192 function insideGrid (x
, y
: Integer): Boolean; inline;
194 // `false` if `body` is surely invalid
195 function getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
196 function getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
197 function getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
199 // return number of ITP thingys put into frame pool
200 // if `firstHit` is `true`, return on first hit (obviously)
201 function forEachInAABB (x
, y
, w
, h
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
203 // return number of ITP thingys put into frame pool
204 // if `firstHit` is `true`, return on first hit (obviously)
205 function forEachAtPoint (x
, y
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
207 function atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
209 // return object of the nearest hit or nil
210 function traceRay (const x0
, y0
, x1
, y1
: Integer; tagmask
: Integer=-1): ITP
; overload
;
211 function traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): ITP
;
213 // return `false` if we're still inside at the end
214 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
215 // `true`: endpoint will point at the last "inside" pixel
216 // `false`: endpoint will be (ax1, ay1)
217 function traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
219 // trace line along the grid, put all objects from passed cells into frame pool, in no particular order
220 // return number of ITP thingys put into frame pool
221 function forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1; log
: Boolean=false): Iter
;
223 // trace box with the given velocity; return object hit (if any)
224 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
225 //WARNING: don't change tags in callbacks here!
226 function traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; tagmask
: Integer=-1): ITP
;
229 function forEachBodyCell (body
: TBodyProxyId
): CellCoordIter
; // this puts `TGridCellCoord` into frame pool for each cell
230 function forEachInCell (x
, y
: Integer): Iter
; // this puts `ITP` into frame pool
231 procedure dumpStats ();
234 //WARNING! no sanity checks!
235 property proxyEnabled
[pid
: TBodyProxyId
]: Boolean read getProxyEnabled write setProxyEnabled
;
237 property gridX0
: Integer read mMinX
;
238 property gridY0
: Integer read mMinY
;
239 property gridWidth
: Integer read getGridWidthPx
; // in pixels
240 property gridHeight
: Integer read getGridHeightPx
; // in pixels
242 property proxy
[idx
: TBodyProxyId
]: PBodyProxyRec read getProxyById
;
247 // common structure for all line tracers
250 const TileSize
= GridTileSize
;
253 wx0
, wy0
, wx1
, wy1
: Integer; // window coordinates
254 stx
, sty
: Integer; // "steps" for x and y axes
255 stleft
: Integer; // "steps left"
256 err
, errinc
, errmax
: Integer;
257 xd
, yd
: Integer; // current coord
261 // call `setyp` after this
262 constructor Create (minx
, miny
, maxx
, maxy
: Integer);
264 procedure setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
266 // this will use `w[xy][01]` to clip coords
267 // return `false` if the whole line was clipped away
268 // on `true`, you should process first point, and go on
269 function setup (x0
, y0
, x1
, y1
: Integer): Boolean;
271 // call this *after* doing a step
272 // WARNING! if you will do a step when this returns `true`, you will fall into limbo
273 function done (): Boolean; inline;
275 // as you will prolly call `done()` after doing a step anyway, this will do it for you
276 // move to next point, return `true` when the line is complete (i.e. you should stop)
277 function step (): Boolean; inline;
279 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
280 function stepToNextTile (): Boolean; inline;
282 procedure getXY (out ox
, oy
: Integer); inline;
286 property x
: Integer read xd
;
287 property y
: Integer read yd
;
291 procedure swapInt (var a
: Integer; var b
: Integer); inline;
292 //function minInt (a, b: Integer): Integer; inline;
293 //function maxInt (a, b: Integer): Integer; inline;
299 SysUtils
, e_log
, g_console
, geom
, utils
;
302 // ////////////////////////////////////////////////////////////////////////// //
303 procedure swapInt (var a
: Integer; var b
: Integer); inline; var t
: Integer; begin t
:= a
; a
:= b
; b
:= t
; end;
304 //procedure swapInt (var a: Integer; var b: Integer); inline; begin a := a xor b; b := b xor a; a := a xor b; end;
305 //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
306 //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
309 // ////////////////////////////////////////////////////////////////////////// //
310 constructor TLineWalker
.Create (minx
, miny
, maxx
, maxy
: Integer);
312 setClip(minx
, miny
, maxx
, maxy
);
315 procedure TLineWalker
.setClip (minx
, miny
, maxx
, maxy
: Integer); inline;
324 function TLineWalker
.setup (x0
, y0
, x1
, y1
: Integer): Boolean;
326 sx0
, sy0
, sx1
, sy1
: Single;
328 if (wx1
< wx0
) or (wy1
< wy0
) then begin stleft
:= 0; xd
:= x0
; yd
:= y0
; result
:= false; exit
; end;
330 if (x0
>= wx0
) and (y0
>= wy0
) and (x0
<= wx1
) and (y0
<= wy1
) and
331 (x1
>= wx0
) and (y1
>= wy0
) and (x1
<= wx1
) and (y1
<= wy1
) then
337 sx0
:= x0
; sy0
:= y0
;
338 sx1
:= x1
; sy1
:= y1
;
339 result
:= clipLine(sx0
, sy0
, sx1
, sy1
, wx0
, wy0
, wx1
, wy1
);
340 if not result
then begin stleft
:= 0; xd
:= x0
; yd
:= y0
; exit
; end;
341 x0
:= trunc(sx0
); y0
:= trunc(sy0
);
342 x1
:= trunc(sx1
); y1
:= trunc(sy1
);
345 // check for ortho lines
350 stleft
:= abs(x1
-x0
)+1;
351 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
354 errmax
:= 10; // anything that is greater than zero
356 else if (x0
= x1
) then
360 stleft
:= abs(y1
-y0
)+1;
362 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
364 errmax
:= 10; // anything that is greater than zero
369 if (abs(x1
-x0
) >= abs(y1
-y0
)) then
373 stleft
:= abs(x1
-x0
)+1;
374 errinc
:= abs(y1
-y0
)+1;
380 stleft
:= abs(y1
-y0
)+1;
381 errinc
:= abs(x1
-x0
)+1;
383 if (x0
< x1
) then stx
:= 1 else stx
:= -1;
384 if (y0
< y1
) then sty
:= 1 else sty
:= -1;
392 function TLineWalker
.done (): Boolean; inline; begin result
:= (stleft
<= 0); end;
395 function TLineWalker
.step (): Boolean; inline;
401 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
407 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
410 result
:= (stleft
<= 0);
414 function TLineWalker
.stepToNextTile (): Boolean; inline;
417 xwalk
, ywalk
, wklen
: Integer; // to the respective edges
422 if (stleft
< 2) then begin result
:= true; exit
; end; // max one pixel left, nothing to do
424 // strictly horizontal?
431 ex
:= (xd
and (not (TileSize
-1)))-1;
437 ex
:= (xd
or (TileSize
-1))+1;
440 result
:= (stleft
<= 0);
445 // strictly vertical?
452 ey
:= (yd
and (not (TileSize
-1)))-1;
457 // yd: to bottom edge
458 ey
:= (yd
or (TileSize
-1))+1;
461 result
:= (stleft
<= 0);
471 ex
:= (xd
and (not (TileSize
-1)))-1;
476 ex
:= (xd
or (TileSize
-1))+1;
483 ey
:= (yd
and (not (TileSize
-1)))-1;
488 ey
:= (yd
or (TileSize
-1))+1;
493 while (xd <> ex) and (yd <> ey) do
499 if (err >= 0) then begin err -= errmax; yd += sty; end;
505 if (err >= 0) then begin err -= errmax; xd += stx; end;
508 if (stleft < 1) then begin result := true; exit; end;
512 if (xwalk
<= ywalk
) then wklen
:= xwalk
else wklen
:= ywalk
;
515 // in which dir we want to walk?
517 if (stleft
<= 0) then begin result
:= true; exit
; end;
521 for f
:= 1 to wklen
do
524 if (err
>= 0) then begin err
-= errmax
; yd
+= sty
; end;
530 for f
:= 1 to wklen
do
533 if (err
>= 0) then begin err
-= errmax
; xd
+= stx
; end;
536 // check for walk completion
537 if (xd
= ex
) or (yd
= ey
) then exit
;
542 procedure TLineWalker
.getXY (out ox
, oy
: Integer); inline; begin ox
:= xd
; oy
:= yd
; end;
545 // ////////////////////////////////////////////////////////////////////////// //
546 procedure TBodyGridBase
.TBodyProxyRec
.setup (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer);
559 function TBodyGridBase
.TBodyProxyRec
.getTag (): Integer; inline;
561 result
:= mTag
and TagFullMask
;
564 procedure TBodyGridBase
.TBodyProxyRec
.setTag (v
: Integer); inline;
566 mTag
:= (mTag
and TagDisabled
) or (v
and TagFullMask
);
569 function TBodyGridBase
.TBodyProxyRec
.getEnabled (): Boolean; inline;
571 result
:= ((mTag
and TagDisabled
) = 0);
574 procedure TBodyGridBase
.TBodyProxyRec
.setEnabled (v
: Boolean); inline;
576 if v
then mTag
:= mTag
and (not TagDisabled
) else mTag
:= mTag
or TagDisabled
;
579 function TBodyGridBase
.TBodyProxyRec
.getX1 (): Integer; inline;
581 result
:= mX
+mWidth
-1;
584 function TBodyGridBase
.TBodyProxyRec
.getY1 (): Integer; inline;
586 result
:= mY
+mHeight
-1;
590 // ////////////////////////////////////////////////////////////////////////// //
591 constructor TBodyGridBase
.TAtPointEnumerator
.Create (acells
: TCellArray
; aidx
: Integer; agetpx
: TGetProxyFn
);
600 function TBodyGridBase
.TAtPointEnumerator
.MoveNext (): Boolean; inline;
602 while (curidx
<> -1) do
604 while (curbki
< GridCellBucketSize
) do
607 if (mCells
[curidx
].bodies
[curbki
] = -1) then break
;
611 curidx
:= mCells
[curidx
].next
;
618 function TBodyGridBase
.TAtPointEnumerator
.getCurrent (): PBodyProxyRec
; inline;
620 result
:= getpx(mCells
[curidx
].bodies
[curbki
]);
624 // ////////////////////////////////////////////////////////////////////////// //
625 constructor TBodyGridBase
.Create (aMinPixX
, aMinPixY
, aPixWidth
, aPixHeight
: Integer{; aTileSize: Integer=GridDefaultTileSize});
629 dbgShowTraceLog
:= false;
630 {$IF DEFINED(D2F_DEBUG)}
631 dbgRayTraceTileHitCB
:= nil;
634 if aTileSize < 1 then aTileSize := 1;
635 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
636 mTileSize := aTileSize;
638 if (aPixWidth
< mTileSize
) then aPixWidth
:= mTileSize
;
639 if (aPixHeight
< mTileSize
) then aPixHeight
:= mTileSize
;
642 mWidth
:= (aPixWidth
+mTileSize
-1) div mTileSize
;
643 mHeight
:= (aPixHeight
+mTileSize
-1) div mTileSize
;
644 SetLength(mGrid
, mWidth
*mHeight
);
645 SetLength(mCells
, mWidth
*mHeight
);
646 SetLength(mProxies
, 8192);
649 for idx
:= 0 to High(mCells
) do
651 mCells
[idx
].bodies
[0] := -1;
652 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
653 mCells
[idx
].next
:= idx
+1;
655 mCells
[High(mCells
)].next
:= -1; // last cell
657 for idx
:= 0 to High(mGrid
) do mGrid
[idx
] := -1;
659 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
660 mProxies
[High(mProxies
)].nextLink
:= -1;
666 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
]), TMsgType
.Notify
);
670 destructor TBodyGridBase
.Destroy ();
679 // ////////////////////////////////////////////////////////////////////////// //
680 procedure TBodyGridBase
.dumpStats ();
682 idx
, mcb
, ccidx
, cnt
: Integer;
685 for idx
:= 0 to High(mGrid
) do
692 ccidx
:= mCells
[ccidx
].next
;
694 if (mcb
< cnt
) then mcb
:= cnt
;
696 e_WriteLog(Format('grid size: %dx%d (tile size: %d); pix: %dx%d; used cells: %d; max bodies in cell: %d; max proxies allocated: %d; proxies used: %d', [mWidth
, mHeight
, mTileSize
, mWidth
*mTileSize
, mHeight
*mTileSize
, mUsedCells
, mcb
, mProxyMaxCount
, mProxyCount
]), TMsgType
.Notify
);
700 function TBodyGridBase
.forEachBodyCell (body
: TBodyProxyId
): CellCoordIter
;
702 g
, f
, ccidx
: Integer;
704 presobj
: PGridCellCoord
;
706 result
:= CellCoordIter
.Create(framePool
);
707 if (body
< 0) or (body
> High(mProxies
)) then begin result
.finishIt(); exit
; end;
708 for g
:= 0 to High(mGrid
) do
711 while (ccidx
<> -1) do
713 cc
:= @mCells
[ccidx
];
714 for f
:= 0 to GridCellBucketSize
-1 do
716 if (cc
.bodies
[f
] = -1) then break
;
717 if (cc
.bodies
[f
] = body
) then
719 presobj
:= PGridCellCoord(framePool
.alloc(sizeof(TGridCellCoord
)));
720 presobj
^.x
:= (g
mod mWidth
)*mTileSize
+mMinX
;
721 presobj
^.y
:= (g
div mWidth
)*mTileSize
+mMinY
;
722 //cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
733 function TBodyGridBase
.forEachInCell (x
, y
: Integer): Iter
;
739 result
:= Iter
.Create(framePool
);
742 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
> mHeight
*mTileSize
) then begin result
.finishIt(); exit
; end;
743 ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
744 while (ccidx
<> -1) do
746 cc
:= @mCells
[ccidx
];
747 for f
:= 0 to GridCellBucketSize
-1 do
749 if (cc
.bodies
[f
] = -1) then break
;
750 //if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
751 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
752 //presobj^ := mProxies[cc.bodies[f]].mObj;
753 Move(mProxies
[cc
.bodies
[f
]].mObj
, presobj
^, sizeof(ITP
));
762 // ////////////////////////////////////////////////////////////////////////// //
763 function TBodyGridBase
.getGridWidthPx (): Integer; inline; begin result
:= mWidth
*mTileSize
; end;
764 function TBodyGridBase
.getGridHeightPx (): Integer; inline; begin result
:= mHeight
*mTileSize
; end;
767 function TBodyGridBase
.insideGrid (x
, y
: Integer): Boolean; inline;
772 result
:= (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
);
776 function TBodyGridBase
.getBodyXY (body
: TBodyProxyId
; out rx
, ry
: Integer): Boolean; inline;
778 if (body
>= 0) and (body
< Length(mProxies
)) then
780 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; end;
792 function TBodyGridBase
.getBodyWH (body
: TBodyProxyId
; out rw
, rh
: Integer): Boolean; inline;
794 if (body
>= 0) and (body
< Length(mProxies
)) then
796 with mProxies
[body
] do begin rw
:= mWidth
; rh
:= mHeight
; end;
808 function TBodyGridBase
.getBodyDims (body
: TBodyProxyId
; out rx
, ry
, rw
, rh
: Integer): Boolean; inline;
810 if (body
>= 0) and (body
< Length(mProxies
)) then
812 with mProxies
[body
] do begin rx
:= mX
; ry
:= mY
; rw
:= mWidth
; rh
:= mHeight
; end;
827 // ////////////////////////////////////////////////////////////////////////// //
828 function TBodyGridBase
.getProxyEnabled (pid
: TBodyProxyId
): Boolean; inline;
830 if (pid
>= 0) and (pid
< Length(mProxies
)) then result
:= ((mProxies
[pid
].mTag
and TagDisabled
) = 0) else result
:= false;
834 procedure TBodyGridBase
.setProxyEnabled (pid
: TBodyProxyId
; val
: Boolean); inline;
836 if (pid
>= 0) and (pid
< Length(mProxies
)) then
840 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
and not TagDisabled
;
844 mProxies
[pid
].mTag
:= mProxies
[pid
].mTag
or TagDisabled
;
850 function TBodyGridBase
.getProxyById (idx
: TBodyProxyId
): PBodyProxyRec
; inline;
852 if (idx
>= 0) and (idx
< Length(mProxies
)) then result
:= @mProxies
[idx
] else result
:= nil;
856 // ////////////////////////////////////////////////////////////////////////// //
857 function TBodyGridBase
.allocCell (): Integer;
862 if (mFreeCell
< 0) then
864 // no free cells, want more
865 mFreeCell
:= Length(mCells
);
866 SetLength(mCells
, mFreeCell
+32768); // arbitrary number
867 for idx
:= mFreeCell
to High(mCells
) do
869 mCells
[idx
].bodies
[0] := -1;
870 mCells
[idx
].bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
871 mCells
[idx
].next
:= idx
+1;
873 mCells
[High(mCells
)].next
:= -1; // last cell
876 pc
:= @mCells
[result
];
877 mFreeCell
:= pc
.next
;
880 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
884 procedure TBodyGridBase
.freeCell (idx
: Integer);
886 if (idx
>= 0) and (idx
< Length(mCells
)) then
891 bodies
[GridCellBucketSize
-1] := -1; // 'has free room' flag
900 // ////////////////////////////////////////////////////////////////////////// //
901 function TBodyGridBase
.allocProxy (aX
, aY
, aWidth
, aHeight
: Integer; aObj
: ITP
; aTag
: Integer): TBodyProxyId
;
906 if (mProxyFree
= -1) then
908 // no free proxies, resize list
909 olen
:= Length(mProxies
);
910 SetLength(mProxies
, olen
+8192); // arbitrary number
911 for idx
:= olen
to High(mProxies
) do mProxies
[idx
].nextLink
:= idx
+1;
912 mProxies
[High(mProxies
)].nextLink
:= -1;
916 result
:= mProxyFree
;
917 px
:= @mProxies
[result
];
918 mProxyFree
:= px
.nextLink
;
919 px
.setup(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
924 if (mProxyMaxCount
< mProxyCount
) then mProxyMaxCount
:= mProxyCount
;
927 procedure TBodyGridBase
.freeProxy (body
: TBodyProxyId
);
929 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
930 if (mProxyCount
= 0) then raise Exception
.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
932 mProxies
[body
].mObj
:= nil;
933 mProxies
[body
].nextLink
:= mProxyFree
;
939 // ////////////////////////////////////////////////////////////////////////// //
940 function TBodyGridBase
.forGridRect (x
, y
, w
, h
: Integer; cb
: TGridInternalCB
; bodyId
: TBodyProxyId
): Boolean;
947 if (w
< 1) or (h
< 1) or not assigned(cb
) then exit
;
952 if (x
+w
<= 0) or (y
+h
<= 0) then exit
;
955 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then exit
;
956 ex
:= (x
+w
-1) div mTileSize
;
957 ey
:= (y
+h
-1) div mTileSize
;
958 x
:= x
div mTileSize
;
959 y
:= y
div mTileSize
;
961 if (x
< 0) then x
:= 0 else if (x
>= gw
) then x
:= gw
-1;
962 if (y
< 0) then y
:= 0 else if (y
>= gh
) then y
:= gh
-1;
963 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
964 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
965 if (x
> ex
) or (y
> ey
) then exit
; // just in case
971 result
:= cb(gy
*gw
+gx
, bodyId
);
978 // ////////////////////////////////////////////////////////////////////////// //
979 function TBodyGridBase
.inserter (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
986 result
:= false; // never stop
987 // add body to the given grid cell
991 {$IF DEFINED(D2F_DEBUG)}
993 while (ccidx
<> -1) do
995 pi
:= @mCells
[ccidx
];
996 for f
:= 0 to GridCellBucketSize
-1 do
998 if (pi
.bodies
[f
] = -1) then break
;
999 if (pi
.bodies
[f
] = bodyId
) then raise Exception
.Create('trying to insert already inserted proxy');
1005 while (ccidx
<> -1) do
1007 pi
:= @mCells
[ccidx
];
1008 // check "has room" flag
1009 if (pi
.bodies
[GridCellBucketSize
-1] = -1) then
1012 for f
:= 0 to GridCellBucketSize
-1 do
1014 if (pi
.bodies
[f
] = -1) then
1016 pi
.bodies
[f
] := bodyId
;
1017 if (f
+1 < GridCellBucketSize
) then pi
.bodies
[f
+1] := -1;
1021 raise Exception
.Create('internal error in grid inserter');
1023 // no room, go to next cell in list (if there is any)
1026 // no room in cells, add new cell to list
1028 // either no room, or no cell at all
1029 ccidx
:= allocCell();
1030 pi
:= @mCells
[ccidx
];
1031 pi
.bodies
[0] := bodyId
;
1034 mGrid
[grida
] := ccidx
;
1038 // assume that we cannot have one object added to bucket twice
1039 function TBodyGridBase
.remover (grida
: Integer; bodyId
: TBodyProxyId
): Boolean;
1042 pidx
, ccidx
: Integer;
1045 result
:= false; // never stop
1046 // find and remove cell
1047 pidx
:= -1; // previous cell index
1048 ccidx
:= mGrid
[grida
]; // current cell index
1049 while (ccidx
<> -1) do
1051 pc
:= @mCells
[ccidx
];
1052 for f
:= 0 to GridCellBucketSize
-1 do
1054 if (pc
.bodies
[f
] = bodyId
) then
1057 if (f
= 0) and (pc
.bodies
[1] = -1) then
1059 // this cell contains no elements, remove it
1060 if (pidx
= -1) then mGrid
[grida
] := pc
.next
else mCells
[pidx
].next
:= pc
.next
;
1064 // remove element from bucket
1065 for c
:= f
to GridCellBucketSize
-2 do
1067 pc
.bodies
[c
] := pc
.bodies
[c
+1];
1068 if (pc
.bodies
[c
] = -1) then break
;
1070 pc
.bodies
[GridCellBucketSize
-1] := -1; // "has free room" flag
1080 // ////////////////////////////////////////////////////////////////////////// //
1081 function TBodyGridBase
.insertBody (aObj
: ITP
; aX
, aY
, aWidth
, aHeight
: Integer; aTag
: Integer=-1): TBodyProxyId
;
1083 aTag
:= aTag
and TagFullMask
;
1084 result
:= allocProxy(aX
, aY
, aWidth
, aHeight
, aObj
, aTag
);
1085 //insertInternal(result);
1086 forGridRect(aX
, aY
, aWidth
, aHeight
, inserter
, result
);
1090 procedure TBodyGridBase
.removeBody (body
: TBodyProxyId
);
1094 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1095 px
:= @mProxies
[body
];
1096 //removeInternal(body);
1097 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1102 // ////////////////////////////////////////////////////////////////////////// //
1103 procedure TBodyGridBase
.moveResizeBody (body
: TBodyProxyId
; nx
, ny
, nw
, nh
: Integer);
1106 x0
, y0
, w
, h
: Integer;
1108 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1109 px
:= @mProxies
[body
];
1114 {$IF DEFINED(D2F_DEBUG_MOVER)}
1115 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
);
1117 if (nx
= x0
) and (ny
= y0
) and (nw
= w
) and (nh
= h
) then exit
;
1123 // did any corner crossed tile boundary?
1124 if (x0
div mTileSize
<> nx
div mTileSize
) or
1125 (y0
div mTileSize
<> ny
div mTileSize
) or
1126 ((x0
+w
-1) div mTileSize
<> (nx
+nw
-1) div mTileSize
) or
1127 ((y0
+h
-1) div mTileSize
<> (ny
+nh
-1) div mTileSize
) then
1129 //writeln('moveResizeBody: cell occupation changed! old=(', x0, ',', y0, ')-(', x0+w-1, ',', y0+h-1, '); new=(', nx, ',', ny, ')-(', nx+nw-1, ',', ny+nh-1, ')');
1130 //removeInternal(body);
1131 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1136 //insertInternal(body);
1137 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1149 //TODO: optimize for horizontal/vertical moves
1150 procedure TBodyGridBase
.moveBody (body
: TBodyProxyId
; nx
, ny
: Integer);
1154 ogx0
, ogx1
, ogy0
, ogy1
: Integer; // old grid rect
1155 ngx0
, ngx1
, ngy0
, ngy1
: Integer; // new grid rect
1160 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1161 // check if tile coords was changed
1162 px
:= @mProxies
[body
];
1165 if (nx
= x0
) and (ny
= y0
) then exit
;
1171 // check for heavy work
1174 ogx0
:= x0
div mTileSize
;
1175 ogy0
:= y0
div mTileSize
;
1176 ngx0
:= nx
div mTileSize
;
1177 ngy0
:= ny
div mTileSize
;
1178 ogx1
:= (x0
+pw
-1) div mTileSize
;
1179 ogy1
:= (y0
+ph
-1) div mTileSize
;
1180 ngx1
:= (nx
+pw
-1) div mTileSize
;
1181 ngy1
:= (ny
+ph
-1) div mTileSize
;
1182 {$IF DEFINED(D2F_DEBUG_MOVER)}
1183 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
);
1185 if (ogx0
<> ngx0
) or (ogy0
<> ngy0
) or (ogx1
<> ngx1
) or (ogy1
<> ngy1
) then
1187 // crossed tile boundary, do heavy work
1190 // cycle with old rect, remove body where it is necessary
1191 // optimized for horizontal moves
1192 {$IF DEFINED(D2F_DEBUG_MOVER)}
1193 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
);
1195 // remove stale marks
1196 if not ((ogy0
>= gh
) or (ogy1
< 0)) and
1197 not ((ogx0
>= gw
) or (ogx1
< 0)) then
1199 if (ogx0
< 0) then ogx0
:= 0;
1200 if (ogy0
< 0) then ogy0
:= 0;
1201 if (ogx1
> gw
-1) then ogx1
:= gw
-1;
1202 if (ogy1
> gh
-1) then ogy1
:= gh
-1;
1203 {$IF DEFINED(D2F_DEBUG_MOVER)}
1204 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0
, ogy0
, ogx1
, ogy1
]), MSG_NOTIFY
);
1206 for gx
:= ogx0
to ogx1
do
1208 if (gx
< ngx0
) or (gx
> ngx1
) then
1210 // this column is completely outside of new rect
1211 for gy
:= ogy0
to ogy1
do
1213 {$IF DEFINED(D2F_DEBUG_MOVER)}
1214 e_WriteLog(Format(' remove0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1216 remover(gy
*gw
+gx
, body
);
1222 for gy
:= ogy0
to ogy1
do
1224 if (gy
< ngy0
) or (gy
> ngy1
) then
1226 {$IF DEFINED(D2F_DEBUG_MOVER)}
1227 e_WriteLog(Format(' remove1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1229 remover(gy
*gw
+gx
, body
);
1235 // cycle with new rect, add body where it is necessary
1236 if not ((ngy0
>= gh
) or (ngy1
< 0)) and
1237 not ((ngx0
>= gw
) or (ngx1
< 0)) then
1239 if (ngx0
< 0) then ngx0
:= 0;
1240 if (ngy0
< 0) then ngy0
:= 0;
1241 if (ngx1
> gw
-1) then ngx1
:= gw
-1;
1242 if (ngy1
> gh
-1) then ngy1
:= gh
-1;
1243 {$IF DEFINED(D2F_DEBUG_MOVER)}
1244 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0
, ngy0
, ngx1
, ngy1
]), MSG_NOTIFY
);
1246 for gx
:= ngx0
to ngx1
do
1248 if (gx
< ogx0
) or (gx
> ogx1
) then
1250 // this column is completely outside of old rect
1251 for gy
:= ngy0
to ngy1
do
1253 {$IF DEFINED(D2F_DEBUG_MOVER)}
1254 e_WriteLog(Format(' insert0:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1256 inserter(gy
*gw
+gx
, body
);
1262 for gy
:= ngy0
to ngy1
do
1264 if (gy
< ogy0
) or (gy
> ogy1
) then
1266 {$IF DEFINED(D2F_DEBUG_MOVER)}
1267 e_WriteLog(Format(' insert1:(%d,%d)', [gx
, gy
]), MSG_NOTIFY
);
1269 inserter(gy
*gw
+gx
, body
);
1279 {$IF DEFINED(D2F_DEBUG_MOVER)}
1280 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
);
1283 // update coordinates
1289 procedure TBodyGridBase
.resizeBody (body
: TBodyProxyId
; nw
, nh
: Integer);
1292 x0
, y0
, w
, h
: Integer;
1294 if (body
< 0) or (body
> High(mProxies
)) then exit
; // just in case
1295 // check if tile coords was changed
1296 px
:= @mProxies
[body
];
1301 {$IF DEFINED(D2F_DEBUG_MOVER)}
1302 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
);
1304 if ((x0
+w
-1) div mTileSize
<> (x0
+nw
-1) div mTileSize
) or
1305 ((y0
+h
-1) div mTileSize
<> (y0
+nh
-1) div mTileSize
) then
1307 // crossed tile boundary, do heavy work
1308 //removeInternal(body);
1309 forGridRect(px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, remover
, body
);
1312 //insertInternal(body);
1313 forGridRect(px
.mX
, px
.mY
, nw
, nh
, inserter
, body
);
1317 // nothing to do with the grid, just fix size
1324 // ////////////////////////////////////////////////////////////////////////// //
1325 function TBodyGridBase
.atCellInPoint (x
, y
: Integer): TAtPointEnumerator
;
1327 ccidx
: Integer = -1;
1331 if (x
>= 0) and (y
>= 0) and (x
< mWidth
*mTileSize
) and (y
< mHeight
*mTileSize
) then ccidx
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1332 result
:= TAtPointEnumerator
.Create(mCells
, ccidx
, getProxyById
);
1336 // ////////////////////////////////////////////////////////////////////////// //
1337 // no callback: return `true` on the first hit
1338 function TBodyGridBase
.forEachAtPoint (x
, y
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
1341 idx
, curci
: Integer;
1342 cc
: PGridCell
= nil;
1348 result
:= Iter
.Create(framePool
);
1349 tagmask
:= tagmask
and TagFullMask
;
1350 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1352 {$IF DEFINED(D2F_DEBUG_XXQ)}
1353 if (assigned(cb
)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x
, y
]), MSG_NOTIFY
);
1356 // make coords (0,0)-based
1359 if (x
< 0) or (y
< 0) or (x
>= mWidth
*mTileSize
) or (y
>= mHeight
*mTileSize
) then begin result
.finishIt(); exit
; end;
1361 curci
:= mGrid
[(y
div mTileSize
)*mWidth
+(x
div mTileSize
)];
1363 {$IF DEFINED(D2F_DEBUG_XXQ)}
1364 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
);
1371 // increase query counter
1373 if (mLastQuery
= 0) then
1375 // just in case of overflow
1377 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1381 {$IF DEFINED(D2F_DEBUG_XXQ)}
1382 if (assigned(cb
)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x
, y
, lq
]), MSG_NOTIFY
);
1385 while (curci
<> -1) do
1387 {$IF DEFINED(D2F_DEBUG_XXQ)}
1388 //if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1390 cc
:= @mCells
[curci
];
1391 for f
:= 0 to GridCellBucketSize
-1 do
1393 if (cc
.bodies
[f
] = -1) then break
;
1394 px
:= @mProxies
[cc
.bodies
[f
]];
1395 {$IF DEFINED(D2F_DEBUG_XXQ)}
1396 //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);
1398 if (px
.mQueryMark
= lq
) then continue
;
1399 px
.mQueryMark
:= lq
;
1401 if (not allowDisabled
) and ((ptag
and TagDisabled
) <> 0) then continue
;
1402 if ((ptag
and tagmask
) = 0) then continue
;
1403 if (x
>= px
.mX
) and (y
>= px
.mY
) and (x
< px
.mX
+px
.mWidth
) and (y
< px
.mY
+px
.mHeight
) then
1405 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1406 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1407 if (firstHit
) then begin result
.finishIt(); exit
; end;
1416 // ////////////////////////////////////////////////////////////////////////// //
1417 // no callback: return `true` on the first hit
1418 // return number of ITP thingys put into frame pool
1419 function TBodyGridBase
.forEachInAABB (x
, y
, w
, h
: Integer; tagmask
: Integer=-1; allowDisabled
: Boolean=false; firstHit
: Boolean=false): Iter
;
1423 sx
, sy
, ex
, ey
: Integer;
1426 cc
: PGridCell
= nil;
1434 if (w
= 1) and (h
= 1) then
1436 result
:= forEachAtPoint(x
, y
, tagmask
, allowDisabled
, firstHit
);
1440 result
:= Iter
.Create(framePool
);
1441 if (w
< 1) or (h
< 1) then begin result
.finishIt(); exit
; end;
1443 tagmask
:= tagmask
and TagFullMask
;
1444 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1456 if (x
+w
<= 0) or (y
+h
<= 0) then begin result
.finishIt(); exit
; end;
1457 if (x
>= gw
*mTileSize
) or (y
>= gh
*mTileSize
) then begin result
.finishIt(); exit
; end;
1459 sx
:= x
div mTileSize
;
1460 sy
:= y
div mTileSize
;
1461 ex
:= (x
+w
-1) div mTileSize
;
1462 ey
:= (y
+h
-1) div mTileSize
;
1465 if (sx
< 0) then sx
:= 0 else if (sx
>= gw
) then sx
:= gw
-1;
1466 if (sy
< 0) then sy
:= 0 else if (sy
>= gh
) then sy
:= gh
-1;
1467 if (ex
< 0) then ex
:= 0 else if (ex
>= gw
) then ex
:= gw
-1;
1468 if (ey
< 0) then ey
:= 0 else if (ey
>= gh
) then ey
:= gh
-1;
1469 if (sx
> ex
) or (sy
> ey
) then begin result
.finishIt(); exit
; end; // just in case
1471 // has something to do
1473 // increase query counter
1475 if (mLastQuery
= 0) then
1477 // just in case of overflow
1479 for idx
:= 0 to High(mProxies
) do mProxies
[idx
].mQueryMark
:= 0;
1481 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1485 for gy
:= sy
to ey
do
1487 for gx
:= sx
to ex
do
1490 curci
:= mGrid
[gy
*gw
+gx
];
1491 while (curci
<> -1) do
1493 cc
:= @mCells
[curci
];
1494 for f
:= 0 to GridCellBucketSize
-1 do
1496 if (cc
.bodies
[f
] = -1) then break
;
1497 px
:= @mProxies
[cc
.bodies
[f
]];
1498 // shit! has to do it this way, so i can change tag in callback
1499 if (px
.mQueryMark
= lq
) then continue
;
1500 px
.mQueryMark
:= lq
;
1502 if (not allowDisabled
) and ((ptag
and TagDisabled
) <> 0) then continue
;
1503 if ((ptag
and tagmask
) = 0) then continue
;
1504 if (x0
>= px
.mX
+px
.mWidth
) or (y0
>= px
.mY
+px
.mHeight
) then continue
;
1505 if (x0
+w
<= px
.mX
) or (y0
+h
<= px
.mY
) then continue
;
1506 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1507 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1508 if (firstHit
) then begin result
.finishIt(); exit
; end;
1518 // ////////////////////////////////////////////////////////////////////////// //
1519 function TBodyGridBase
.forEachAlongLine (ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1; log
: Boolean=false): Iter
;
1527 gw
, gh
, minx
, miny
: Integer;
1531 //px0, py0, px1, py1: Integer;
1535 result
:= Iter
.Create(framePool
);
1536 tagmask
:= tagmask
and TagFullMask
;
1537 if (tagmask
= 0) then begin result
.finishIt(); exit
; end;
1544 // make query coords (0,0)-based
1550 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
1551 if not lw
.setup(x0
, y0
, x1
, y1
) then begin result
.finishIt(); exit
; end; // out of screen
1553 // increase query counter
1555 if (mLastQuery
= 0) then
1557 // just in case of overflow
1559 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1566 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1568 while (ccidx
<> -1) do
1570 cc
:= @mCells
[ccidx
];
1571 for f
:= 0 to GridCellBucketSize
-1 do
1573 if (cc
.bodies
[f
] = -1) then break
;
1574 px
:= @mProxies
[cc
.bodies
[f
]];
1576 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1578 px
.mQueryMark
:= lq
; // mark as processed
1579 presobj
:= PITP(framePool
.alloc(sizeof(ITP
)));
1580 Move(px
.mObj
, presobj
^, sizeof(ITP
));
1586 // done processing cells, move to next tile
1587 until lw
.stepToNextTile();
1592 // ////////////////////////////////////////////////////////////////////////// //
1593 // trace box with the given velocity; return object hit (if any)
1594 function TBodyGridBase
.traceBox (out ex
, ey
: Integer; const ax0
, ay0
, aw
, ah
: Integer; const dx
, dy
: Integer; tagmask
: Integer=-1): ITP
;
1602 minu0
: Single = 100000.0;
1604 cx0
, cy0
, cx1
, cy1
: Integer;
1605 hitpx
: PBodyProxyRec
= nil;
1607 result
:= Default(ITP
);
1610 if (aw
< 1) or (ah
< 1) then exit
;
1612 cx0
:= nmin(ax0
, ax0
+dx
);
1613 cy0
:= nmin(ay0
, ay0
+dy
);
1614 cx1
:= nmax(ax0
+aw
-1, ax0
+aw
-1+dx
);
1615 cy1
:= nmax(ay0
+ah
-1, ay0
+ah
-1+dy
);
1617 cx0
-= mMinX
; cy0
-= mMinY
;
1618 cx1
-= mMinX
; cy1
-= mMinY
;
1620 if (cx1
< 0) or (cy1
< 0) or (cx0
>= mWidth
*mTileSize
) or (cy0
>= mHeight
*mTileSize
) then exit
;
1622 if (cx0
< 0) then cx0
:= 0;
1623 if (cy0
< 0) then cy0
:= 0;
1624 if (cx1
>= mWidth
*mTileSize
) then cx1
:= mWidth
*mTileSize
-1;
1625 if (cy1
>= mHeight
*mTileSize
) then cy1
:= mHeight
*mTileSize
-1;
1627 if (cx0
> cx1
) or (cy0
> cy1
) then exit
;
1629 // increase query counter
1631 if (mLastQuery
= 0) then
1633 // just in case of overflow
1635 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1639 for gy
:= cy0
div mTileSize
to cy1
div mTileSize
do
1641 for gx
:= cx0
div mTileSize
to cx1
div mTileSize
do
1643 ccidx
:= mGrid
[gy
*mWidth
+gx
];
1644 while (ccidx
<> -1) do
1646 cc
:= @mCells
[ccidx
];
1647 for f
:= 0 to GridCellBucketSize
-1 do
1649 if (cc
.bodies
[f
] = -1) then break
;
1650 px
:= @mProxies
[cc
.bodies
[f
]];
1652 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1654 px
.mQueryMark
:= lq
; // mark as processed
1655 if not sweepAABB(ax0
, ay0
, aw
, ah
, dx
, dy
, px
.mX
, px
.mY
, px
.mWidth
, px
.mHeight
, @u0
) then continue
;
1656 if (minu0
> u0
) then
1676 if (minu0
<= 1.0) then
1678 ex
:= ax0
+round(dx
*minu0
);
1679 ey
:= ay0
+round(dy
*minu0
);
1680 // just in case, compensate for floating point inexactness
1681 if (ex
>= hitpx
.mX
) and (ey
>= hitpx
.mY
) and (ex
< hitpx
.mX
+hitpx
.mWidth
) and (ey
< hitpx
.mY
+hitpx
.mHeight
) then
1683 ex
:= ax0
+trunc(dx
*minu0
);
1684 ey
:= ay0
+trunc(dy
*minu0
);
1690 // ////////////////////////////////////////////////////////////////////////// //
1691 {.$DEFINE D2F_DEBUG_OTR}
1692 function TBodyGridBase
.traceOrthoRayWhileIn (out ex
, ey
: Integer; ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): Boolean;
1698 minx
, miny
: Integer;
1700 x0
, y0
, x1
, y1
: Integer;
1701 celly0
, celly1
: Integer;
1703 filled
: array[0..mTileSize
-1] of Byte;
1704 {$IF DEFINED(D2F_DEBUG_OTR)}
1712 if not ((ax0
= ax1
) or (ay0
= ay1
)) then raise Exception
.Create('orthoray is not orthogonal');
1714 tagmask
:= tagmask
and TagFullMask
;
1715 if (tagmask
= 0) then exit
;
1717 it
:= forEachAtPoint(ax0
, ay0
, tagmask
, false, true);
1718 if (it
.length
= 0) then begin it
.release(); exit
; end;
1724 // offset query coords to (0,0)-based
1732 if (x0
< 0) or (x0
>= mWidth
*mTileSize
) then exit
; // oops
1737 if (y1
< 0) or (y0
>= mHeight
*mTileSize
) then exit
;
1738 //if (ay0 < 0) then ay0 := 0;
1739 if (y0
< 0) then exit
;
1740 if (y1
>= mHeight
*mTileSize
) then y1
:= mHeight
*mTileSize
-1;
1746 if (y0
< 0) or (y1
>= mHeight
*mTileSize
) then exit
;
1747 //if (ay1 < 0) then ay1 := 0;
1748 if (y1
< 0) then exit
;
1749 if (y0
>= mHeight
*mTileSize
) then y0
:= mHeight
*mTileSize
-1;
1755 ccidx
:= mGrid
[(y0
div mTileSize
)*mWidth
+(x0
div mTileSize
)];
1756 FillChar(filled
, sizeof(filled
), 0);
1757 celly0
:= y0
and (not (mTileSize
-1));
1758 celly1
:= celly0
+mTileSize
-1;
1759 while (ccidx
<> -1) do
1761 cc
:= @mCells
[ccidx
];
1762 for f
:= 0 to GridCellBucketSize
-1 do
1764 if (cc
.bodies
[f
] = -1) then break
;
1765 px
:= @mProxies
[cc
.bodies
[f
]];
1767 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and
1768 (ax0
>= px
.x0
) and (ax0
<= px
.x1
) then
1770 // bound c0 and c1 to cell
1771 c0
:= nclamp(px
.y0
-miny
, celly0
, celly1
);
1772 c1
:= nclamp(px
.y1
-miny
, celly0
, celly1
);
1774 {$IF DEFINED(D2F_DEBUG_OTR)}
1775 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
)]);
1778 FillChar(filled
[c0
-celly0
], c1
-c0
+1, 1);
1784 {$IF DEFINED(D2F_DEBUG_OTR)}
1785 s
:= formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0
, ay0
, ay1
, y0
, celly0
, celly1
, dy
]);
1786 for f
:= 0 to High(filled
) do if (filled
[f
] <> 0) then s
+= '1' else s
+= '0';
1790 // now go till we hit cell boundary or empty space
1794 while (y0
>= celly0
) and (filled
[y0
-celly0
] <> 0) do
1796 {$IF DEFINED(D2F_DEBUG_OTR)}
1797 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
1802 {$IF DEFINED(D2F_DEBUG_OTR)}
1803 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0
-celly0
, y0
, celly0
, ay0
, ay1
]);
1805 if (ay0
<= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
1806 if (y0
>= celly0
) then begin ey
:= ay0
+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result
:= true; exit
; end;
1811 while (y0
<= celly1
) and (filled
[y0
-celly0
] <> 0) do begin Inc(y0
); Inc(ay0
); end;
1812 if (ay0
>= ay1
) then begin ey
:= ay1
; result
:= false; exit
; end;
1813 if (y0
<= celly1
) then begin ey
:= ay0
-1; result
:= true; exit
; end;
1825 // ////////////////////////////////////////////////////////////////////////// //
1826 function TBodyGridBase
.traceRay (const x0
, y0
, x1
, y1
: Integer; tagmask
: Integer=-1): ITP
;
1830 result
:= traceRay(ex
, ey
, x0
, y0
, x1
, y1
, tagmask
);
1834 // you are not supposed to understand this
1835 function TBodyGridBase
.traceRay (out ex
, ey
: Integer; const ax0
, ay0
, ax1
, ay1
: Integer; tagmask
: Integer=-1): ITP
;
1843 gw
, gh
, minx
, miny
: Integer;
1847 px0
, py0
, px1
, py1
: Integer;
1848 lastDistSq
, distSq
, hx
, hy
: Integer;
1849 firstCell
: Boolean = true;
1852 result
:= Default(ITP
);
1853 tagmask
:= tagmask
and TagFullMask
;
1854 if (tagmask
= 0) then exit
;
1861 // make query coords (0,0)-based
1867 lw
:= TLineWalker
.Create(0, 0, gw
*mTileSize
-1, gh
*mTileSize
-1);
1868 if not lw
.setup(x0
, y0
, x1
, y1
) then exit
; // out of screen
1870 lastDistSq
:= distanceSq(ax0
, ay0
, ax1
, ay1
)+1;
1872 {$IF DEFINED(D2F_DEBUG)}
1873 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]);
1876 // increase query counter
1878 if (mLastQuery
= 0) then
1880 // just in case of overflow
1882 for f
:= 0 to High(mProxies
) do mProxies
[f
].mQueryMark
:= 0;
1888 {$IF DEFINED(D2F_DEBUG)}
1889 if assigned(dbgRayTraceTileHitCB
) then dbgRayTraceTileHitCB(cx
+mMinX
, cy
+mMinY
);
1892 ccidx
:= mGrid
[(cy
div mTileSize
)*gw
+(cx
div mTileSize
)];
1895 while (ccidx
<> -1) do
1897 cc
:= @mCells
[ccidx
];
1898 for f
:= 0 to GridCellBucketSize
-1 do
1900 if (cc
.bodies
[f
] = -1) then break
;
1901 px
:= @mProxies
[cc
.bodies
[f
]];
1903 if ((ptag
and TagDisabled
) = 0) and ((ptag
and tagmask
) <> 0) and (px
.mQueryMark
<> lq
) then
1905 px
.mQueryMark
:= lq
; // mark as processed
1906 // get adjusted proxy coords
1909 px1
:= px0
+px
.mWidth
-1;
1910 py1
:= py0
+px
.mHeight
-1;
1911 {$IF DEFINED(D2F_DEBUG)}
1912 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' cxy=(%s,%s); pan=(%s,%s)-(%s,%s)', [cx, cy, px0, py0, px1, py1]);
1915 if firstCell
and (x0
>= px0
) and (y0
>= py0
) and (x0
<= px1
) and (y0
<= py1
) then
1921 {$IF DEFINED(D2F_DEBUG)}
1922 if assigned(dbgRayTraceTileHitCB
) then e_LogWriteln(' INSIDE!');
1926 // do line-vs-aabb test
1927 if lineAABBIntersects(x0
, y0
, x1
, y1
, px0
, py0
, px1
-px0
+1, py1
-py0
+1, hx
, hy
) then
1930 distSq
:= distanceSq(x0
, y0
, hx
, hy
);
1931 {$IF DEFINED(D2F_DEBUG)}
1932 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' hit=(%s,%s); distSq=%s; lastDistSq=%s', [hx, hy, distSq, lastDistSq]);
1934 if (distSq
< lastDistSq
) then
1936 lastDistSq
:= distSq
;
1948 // done processing cells; exit if we registered a hit
1949 // next cells can't have better candidates, obviously
1950 if wasHit
then exit
;
1952 // move to next tile
1953 until lw
.stepToNextTile();