DEADSOFTWARE

finally fixed (i hope) orthotrace bug; turned on orthotrace acceleration
[d2df-sdl.git] / src / game / g_grid.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 // universal spatial grid
17 {$INCLUDE ../shared/a_modes.inc}
18 {$IF DEFINED(D2F_DEBUG)}
19 {.$DEFINE D2F_DEBUG_RAYTRACE}
20 {.$DEFINE D2F_DEBUG_XXQ}
21 {.$DEFINE D2F_DEBUG_MOVER}
22 {$ENDIF}
23 {$DEFINE GRID_USE_ORTHO_ACCEL}
24 unit g_grid;
26 interface
29 type
30 TBodyProxyId = Integer;
32 generic TBodyGridBase<ITP> = class(TObject)
33 public
34 type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
35 type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
37 type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
39 const TagDisabled = $40000000;
40 const TagFullMask = $3fffffff;
42 private
43 const
44 GridDefaultTileSize = 32; // must be power of two!
45 GridCellBucketSize = 8; // WARNING! can't be less than 2!
47 public
48 type
49 PBodyProxyRec = ^TBodyProxyRec;
50 TBodyProxyRec = record
51 private
52 mX, mY, mWidth, mHeight: Integer; // aabb
53 mQueryMark: LongWord; // was this object visited at this query?
54 mObj: ITP;
55 mTag: Integer; // `TagDisabled` set: disabled ;-)
56 nextLink: TBodyProxyId; // next free or nothing
58 private
59 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
61 function getTag (): Integer; inline;
62 procedure setTag (v: Integer); inline;
64 function getEnabled (): Boolean; inline;
65 procedure setEnabled (v: Boolean); inline;
67 function getX1 (): Integer; inline;
68 function getY1 (): Integer; inline;
70 public
71 property x: Integer read mX;
72 property y: Integer read mY;
73 property width: Integer read mWidth;
74 property height: Integer read mHeight;
75 property tag: Integer read getTag write setTag;
76 property enabled: Boolean read getEnabled write setEnabled;
77 property obj: ITP read mObj;
79 property x0: Integer read mX;
80 property y0: Integer read mY;
81 property x1: Integer read getX1;
82 property y1: Integer read getY1;
83 end;
85 private
86 type
87 PGridCell = ^TGridCell;
88 TGridCell = record
89 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
90 next: Integer; // in this cell; index in mCells
91 end;
93 TCellArray = array of TGridCell;
95 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
97 private
98 //mTileSize: Integer;
99 const mTileSize = GridDefaultTileSize;
100 type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
102 public
103 const tileSize = mTileSize;
105 type
106 TAtPointEnumerator = record
107 private
108 mCells: TCellArray;
109 curidx, curbki: Integer;
110 getpx: TGetProxyFn;
111 public
112 constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
113 function MoveNext (): Boolean; inline;
114 function getCurrent (): PBodyProxyRec; inline;
115 property Current: PBodyProxyRec read getCurrent;
116 end;
118 private
119 mMinX, mMinY: Integer; // so grids can start at any origin
120 mWidth, mHeight: Integer; // in tiles
121 mGrid: array of Integer; // mWidth*mHeight, index in mCells
122 mCells: TCellArray; // cell pool
123 mFreeCell: Integer; // first free cell index or -1
124 mLastQuery: LongWord;
125 mUsedCells: Integer;
126 mProxies: array of TBodyProxyRec;
127 mProxyFree: TBodyProxyId; // free
128 mProxyCount: Integer; // currently used
129 mProxyMaxCount: Integer;
130 mInQuery: Boolean;
132 public
133 dbgShowTraceLog: Boolean;
134 {$IF DEFINED(D2F_DEBUG)}
135 dbgRayTraceTileHitCB: TCellQueryCB;
136 {$ENDIF}
138 private
139 function allocCell (): Integer;
140 procedure freeCell (idx: Integer); // `next` is simply overwritten
142 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
143 procedure freeProxy (body: TBodyProxyId);
145 procedure insertInternal (body: TBodyProxyId);
146 procedure removeInternal (body: TBodyProxyId);
148 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
150 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
151 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
153 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
154 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
156 function getGridWidthPx (): Integer; inline;
157 function getGridHeightPx (): Integer; inline;
159 function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
161 public
162 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
163 destructor Destroy (); override;
165 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
166 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
168 procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
169 procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
170 procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
172 function insideGrid (x, y: Integer): Boolean; inline;
174 // `false` if `body` is surely invalid
175 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
176 function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
177 function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
179 //WARNING: don't modify grid while any query is in progress (no checks are made!)
180 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
181 // no callback: return `true` on the first hit
182 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
184 //WARNING: don't modify grid while any query is in progress (no checks are made!)
185 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
186 // no callback: return object on the first hit or nil
187 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
189 function atCellInPoint (x, y: Integer): TAtPointEnumerator;
191 //WARNING: don't modify grid while any query is in progress (no checks are made!)
192 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
193 // cb with `(nil)` will be called before processing new tile
194 // no callback: return object of the nearest hit or nil
195 // if `inverted` is true, trace will register bodies *exluding* tagmask
196 //WARNING: don't change tags in callbacks here!
197 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
198 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
200 //function traceOrthoRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
201 //function traceOrthoRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
203 //WARNING: don't modify grid while any query is in progress (no checks are made!)
204 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
205 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
206 //WARNING: don't change tags in callbacks here!
207 function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
209 // debug
210 procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
211 function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
212 procedure dumpStats ();
214 public
215 //WARNING! no sanity checks!
216 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
218 property gridX0: Integer read mMinX;
219 property gridY0: Integer read mMinY;
220 property gridWidth: Integer read getGridWidthPx; // in pixels
221 property gridHeight: Integer read getGridHeightPx; // in pixels
223 property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
224 end;
227 // you are not supposed to understand this
228 // returns `true` if there is an intersection, and enter coords
229 // enter coords will be equal to (x0, y0) if starting point is inside the box
230 // if result is `false`, `inx` and `iny` are undefined
231 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
233 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
235 procedure swapInt (var a: Integer; var b: Integer); inline;
236 function minInt (a, b: Integer): Integer; inline;
237 function maxInt (a, b: Integer): Integer; inline;
240 implementation
242 uses
243 SysUtils, e_log, g_console;
246 // ////////////////////////////////////////////////////////////////////////// //
247 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
248 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
249 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
251 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
254 // ////////////////////////////////////////////////////////////////////////// //
255 // you are not supposed to understand this
256 // returns `true` if there is an intersection, and enter coords
257 // enter coords will be equal to (x0, y0) if starting point is inside the box
258 // if result is `false`, `inx` and `iny` are undefined
259 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
260 var
261 wx0, wy0, wx1, wy1: Integer; // window coordinates
262 stx, sty: Integer; // "steps" for x and y axes
263 dsx, dsy: Integer; // "lengthes" for x and y axes
264 dx2, dy2: Integer; // "double lengthes" for x and y axes
265 xd, yd: Integer; // current coord
266 e: Integer; // "error" (as in bresenham algo)
267 rem: Integer;
268 //!term: Integer;
269 d0, d1: PInteger;
270 xfixed: Boolean;
271 temp: Integer;
272 begin
273 result := false;
274 // why not
275 inx := x0;
276 iny := y0;
277 if (bw < 1) or (bh < 1) then exit; // impossible box
279 if (x0 = x1) and (y0 = y1) then
280 begin
281 // check this point
282 result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
283 exit;
284 end;
286 // check if staring point is inside the box
287 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
289 // clip rectange
290 wx0 := bx;
291 wy0 := by;
292 wx1 := bx+bw-1;
293 wy1 := by+bh-1;
295 // horizontal setup
296 if (x0 < x1) then
297 begin
298 // from left to right
299 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
300 stx := 1; // going right
301 end
302 else
303 begin
304 // from right to left
305 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
306 stx := -1; // going left
307 x0 := -x0;
308 x1 := -x1;
309 wx0 := -wx0;
310 wx1 := -wx1;
311 swapInt(wx0, wx1);
312 end;
314 // vertical setup
315 if (y0 < y1) then
316 begin
317 // from top to bottom
318 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
319 sty := 1; // going down
320 end
321 else
322 begin
323 // from bottom to top
324 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
325 sty := -1; // going up
326 y0 := -y0;
327 y1 := -y1;
328 wy0 := -wy0;
329 wy1 := -wy1;
330 swapInt(wy0, wy1);
331 end;
333 dsx := x1-x0;
334 dsy := y1-y0;
336 if (dsx < dsy) then
337 begin
338 d0 := @yd;
339 d1 := @xd;
340 swapInt(x0, y0);
341 swapInt(x1, y1);
342 swapInt(dsx, dsy);
343 swapInt(wx0, wy0);
344 swapInt(wx1, wy1);
345 swapInt(stx, sty);
346 end
347 else
348 begin
349 d0 := @xd;
350 d1 := @yd;
351 end;
353 dx2 := 2*dsx;
354 dy2 := 2*dsy;
355 xd := x0;
356 yd := y0;
357 e := 2*dsy-dsx;
358 //!term := x1;
360 xfixed := false;
361 if (y0 < wy0) then
362 begin
363 // clip at top
364 temp := dx2*(wy0-y0)-dsx;
365 xd += temp div dy2;
366 rem := temp mod dy2;
367 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
368 if (xd+1 >= wx0) then
369 begin
370 yd := wy0;
371 e -= rem+dsx;
372 if (rem > 0) then begin Inc(xd); e += dy2; end;
373 xfixed := true;
374 end;
375 end;
377 if (not xfixed) and (x0 < wx0) then
378 begin
379 // clip at left
380 temp := dy2*(wx0-x0);
381 yd += temp div dx2;
382 rem := temp mod dx2;
383 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
384 xd := wx0;
385 e += rem;
386 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
387 end;
389 (*
390 if (y1 > wy1) then
391 begin
392 // clip at bottom
393 temp := dx2*(wy1-y0)+dsx;
394 term := x0+temp div dy2;
395 rem := temp mod dy2;
396 if (rem = 0) then Dec(term);
397 end;
399 if (term > wx1) then term := wx1; // clip at right
401 Inc(term); // draw last point
402 //if (term = xd) then exit; // this is the only point, get out of here
403 *)
405 if (sty = -1) then yd := -yd;
406 if (stx = -1) then begin xd := -xd; {!term := -term;} end;
407 //!dx2 -= dy2;
409 inx := d0^;
410 iny := d1^;
411 result := true;
412 end;
415 // ////////////////////////////////////////////////////////////////////////// //
416 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
417 begin
418 mX := aX;
419 mY := aY;
420 mWidth := aWidth;
421 mHeight := aHeight;
422 mQueryMark := 0;
423 mObj := aObj;
424 mTag := aTag;
425 nextLink := -1;
426 end;
429 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
430 begin
431 result := mTag and TagFullMask;
432 end;
434 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
435 begin
436 mTag := (mTag and TagDisabled) or (v and TagFullMask);
437 end;
439 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
440 begin
441 result := ((mTag and TagDisabled) = 0);
442 end;
444 procedure TBodyGridBase.TBodyProxyRec.setEnabled (v: Boolean); inline;
445 begin
446 if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled;
447 end;
449 function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline;
450 begin
451 result := mX+mWidth-1;
452 end;
454 function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline;
455 begin
456 result := mY+mHeight-1;
457 end;
460 // ////////////////////////////////////////////////////////////////////////// //
461 constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
462 begin
463 mCells := acells;
464 curidx := aidx;
465 curbki := -1;
466 getpx := agetpx;
467 end;
470 function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline;
471 begin
472 while (curidx <> -1) do
473 begin
474 while (curbki < GridCellBucketSize) do
475 begin
476 Inc(curbki);
477 if (mCells[curidx].bodies[curbki] = -1) then break;
478 result := true;
479 exit;
480 end;
481 curidx := mCells[curidx].next;
482 curbki := -1;
483 end;
484 result := false;
485 end;
488 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
489 begin
490 result := getpx(mCells[curidx].bodies[curbki]);
491 end;
494 // ////////////////////////////////////////////////////////////////////////// //
495 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
496 var
497 idx: Integer;
498 begin
499 dbgShowTraceLog := false;
500 {$IF DEFINED(D2F_DEBUG)}
501 dbgRayTraceTileHitCB := nil;
502 {$ENDIF}
504 if aTileSize < 1 then aTileSize := 1;
505 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
506 mTileSize := aTileSize;
508 if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
509 if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
510 mMinX := aMinPixX;
511 mMinY := aMinPixY;
512 mWidth := (aPixWidth+mTileSize-1) div mTileSize;
513 mHeight := (aPixHeight+mTileSize-1) div mTileSize;
514 SetLength(mGrid, mWidth*mHeight);
515 SetLength(mCells, mWidth*mHeight);
516 SetLength(mProxies, 8192);
517 mFreeCell := 0;
518 // init free list
519 for idx := 0 to High(mCells) do
520 begin
521 mCells[idx].bodies[0] := -1;
522 mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
523 mCells[idx].next := idx+1;
524 end;
525 mCells[High(mCells)].next := -1; // last cell
526 // init grid
527 for idx := 0 to High(mGrid) do mGrid[idx] := -1;
528 // init proxies
529 for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
530 mProxies[High(mProxies)].nextLink := -1;
531 mLastQuery := 0;
532 mUsedCells := 0;
533 mProxyFree := 0;
534 mProxyCount := 0;
535 mProxyMaxCount := 0;
536 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
537 end;
540 destructor TBodyGridBase.Destroy ();
541 begin
542 mCells := nil;
543 mGrid := nil;
544 mProxies := nil;
545 inherited;
546 end;
549 // ////////////////////////////////////////////////////////////////////////// //
550 procedure TBodyGridBase.dumpStats ();
551 var
552 idx, mcb, cidx, cnt: Integer;
553 begin
554 mcb := 0;
555 for idx := 0 to High(mGrid) do
556 begin
557 cidx := mGrid[idx];
558 cnt := 0;
559 while cidx >= 0 do
560 begin
561 Inc(cnt);
562 cidx := mCells[cidx].next;
563 end;
564 if (mcb < cnt) then mcb := cnt;
565 end;
566 e_WriteLog(Format('grid size: %dx%d (tile size: %d); pix: %dx%d; used cells: %d; max bodies in cell: %d; max proxies allocated: %d; proxies used: %d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize, mUsedCells, mcb, mProxyMaxCount, mProxyCount]), MSG_NOTIFY);
567 end;
570 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
571 var
572 g, f, cidx: Integer;
573 cc: PGridCell;
574 begin
575 if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
576 for g := 0 to High(mGrid) do
577 begin
578 cidx := mGrid[g];
579 while (cidx <> -1) do
580 begin
581 cc := @mCells[cidx];
582 for f := 0 to GridCellBucketSize-1 do
583 begin
584 if (cc.bodies[f] = -1) then break;
585 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
586 end;
587 // next cell
588 cidx := cc.next;
589 end;
590 end;
591 end;
594 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
595 var
596 f, cidx: Integer;
597 cc: PGridCell;
598 begin
599 result := Default(ITP);
600 if not assigned(cb) then exit;
601 Dec(x, mMinX);
602 Dec(y, mMinY);
603 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
604 cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
605 while (cidx <> -1) do
606 begin
607 cc := @mCells[cidx];
608 for f := 0 to GridCellBucketSize-1 do
609 begin
610 if (cc.bodies[f] = -1) then break;
611 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
612 end;
613 // next cell
614 cidx := cc.next;
615 end;
616 end;
619 // ////////////////////////////////////////////////////////////////////////// //
620 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
621 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
624 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
625 begin
626 // fix coords
627 Dec(x, mMinX);
628 Dec(y, mMinY);
629 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
630 end;
633 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
634 begin
635 if (body >= 0) and (body < Length(mProxies)) then
636 begin
637 with mProxies[body] do begin rx := mX; ry := mY; end;
638 result := true;
639 end
640 else
641 begin
642 rx := 0;
643 ry := 0;
644 result := false;
645 end;
646 end;
649 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
650 begin
651 if (body >= 0) and (body < Length(mProxies)) then
652 begin
653 with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
654 result := true;
655 end
656 else
657 begin
658 rw := 0;
659 rh := 0;
660 result := false;
661 end;
662 end;
665 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
666 begin
667 if (body >= 0) and (body < Length(mProxies)) then
668 begin
669 with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
670 result := true;
671 end
672 else
673 begin
674 rx := 0;
675 ry := 0;
676 rw := 0;
677 rh := 0;
678 result := false;
679 end;
680 end;
684 // ////////////////////////////////////////////////////////////////////////// //
685 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
686 begin
687 if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
688 end;
691 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
692 begin
693 if (pid >= 0) then
694 begin
695 if val then
696 begin
697 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
698 end
699 else
700 begin
701 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
702 end;
703 end;
704 end;
707 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
708 begin
709 if (idx >= 0) and (idx < High(mProxies)) then result := @mProxies[idx] else result := nil;
710 end;
713 // ////////////////////////////////////////////////////////////////////////// //
714 function TBodyGridBase.allocCell (): Integer;
715 var
716 idx: Integer;
717 pc: PGridCell;
718 begin
719 if (mFreeCell < 0) then
720 begin
721 // no free cells, want more
722 mFreeCell := Length(mCells);
723 SetLength(mCells, mFreeCell+32768); // arbitrary number
724 for idx := mFreeCell to High(mCells) do
725 begin
726 mCells[idx].bodies[0] := -1;
727 mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
728 mCells[idx].next := idx+1;
729 end;
730 mCells[High(mCells)].next := -1; // last cell
731 end;
732 result := mFreeCell;
733 pc := @mCells[result];
734 mFreeCell := pc.next;
735 pc.next := -1;
736 Inc(mUsedCells);
737 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
738 end;
741 procedure TBodyGridBase.freeCell (idx: Integer);
742 begin
743 if (idx >= 0) and (idx < Length(mCells)) then
744 begin
745 with mCells[idx] do
746 begin
747 bodies[0] := -1;
748 bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
749 next := mFreeCell;
750 end;
751 mFreeCell := idx;
752 Dec(mUsedCells);
753 end;
754 end;
757 // ////////////////////////////////////////////////////////////////////////// //
758 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
759 var
760 olen, idx: Integer;
761 px: PBodyProxyRec;
762 begin
763 if (mProxyFree = -1) then
764 begin
765 // no free proxies, resize list
766 olen := Length(mProxies);
767 SetLength(mProxies, olen+8192); // arbitrary number
768 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
769 mProxies[High(mProxies)].nextLink := -1;
770 mProxyFree := olen;
771 end;
772 // get one from list
773 result := mProxyFree;
774 px := @mProxies[result];
775 mProxyFree := px.nextLink;
776 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
777 // add to used list
778 px.nextLink := -1;
779 // statistics
780 Inc(mProxyCount);
781 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
782 end;
784 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
785 begin
786 if (body < 0) or (body > High(mProxies)) then exit; // just in case
787 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
788 // add to free list
789 mProxies[body].mObj := nil;
790 mProxies[body].nextLink := mProxyFree;
791 mProxyFree := body;
792 Dec(mProxyCount);
793 end;
796 // ////////////////////////////////////////////////////////////////////////// //
797 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
798 const
799 tsize = mTileSize;
800 var
801 gx, gy: Integer;
802 gw, gh: Integer;
803 begin
804 result := false;
805 if (w < 1) or (h < 1) or not assigned(cb) then exit;
806 // fix coords
807 Dec(x, mMinX);
808 Dec(y, mMinY);
809 // go on
810 if (x+w <= 0) or (y+h <= 0) then exit;
811 gw := mWidth;
812 gh := mHeight;
813 //tsize := mTileSize;
814 if (x >= gw*tsize) or (y >= gh*tsize) then exit;
815 for gy := y div tsize to (y+h-1) div tsize do
816 begin
817 if (gy < 0) then continue;
818 if (gy >= gh) then break;
819 for gx := x div tsize to (x+w-1) div tsize do
820 begin
821 if (gx < 0) then continue;
822 if (gx >= gw) then break;
823 result := cb(gy*gw+gx, bodyId);
824 if result then exit;
825 end;
826 end;
827 end;
830 // ////////////////////////////////////////////////////////////////////////// //
831 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
832 var
833 cidx: Integer;
834 pc: Integer;
835 pi: PGridCell;
836 f: Integer;
837 begin
838 result := false; // never stop
839 // add body to the given grid cell
840 pc := mGrid[grida];
841 if (pc <> -1) then
842 begin
843 {$IF DEFINED(D2F_DEBUG)}
844 cidx := pc;
845 while (cidx <> -1) do
846 begin
847 pi := @mCells[cidx];
848 for f := 0 to GridCellBucketSize-1 do
849 begin
850 if (pi.bodies[f] = -1) then break;
851 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
852 end;
853 cidx := pi.next;
854 end;
855 {$ENDIF}
856 cidx := pc;
857 while (cidx <> -1) do
858 begin
859 pi := @mCells[cidx];
860 // check "has room" flag
861 if (pi.bodies[GridCellBucketSize-1] = -1) then
862 begin
863 // can add here
864 for f := 0 to GridCellBucketSize-1 do
865 begin
866 if (pi.bodies[f] = -1) then
867 begin
868 pi.bodies[f] := bodyId;
869 if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
870 exit;
871 end;
872 end;
873 raise Exception.Create('internal error in grid inserter');
874 end;
875 // no room, go to next cell in list (if there is any)
876 cidx := pi.next;
877 end;
878 // no room in cells, add new cell to list
879 end;
880 // either no room, or no cell at all
881 cidx := allocCell();
882 pi := @mCells[cidx];
883 pi.bodies[0] := bodyId;
884 pi.bodies[1] := -1;
885 pi.next := pc;
886 mGrid[grida] := cidx;
887 end;
889 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
890 var
891 px: PBodyProxyRec;
892 begin
893 if (body < 0) or (body > High(mProxies)) then exit; // just in case
894 px := @mProxies[body];
895 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
896 end;
899 // assume that we cannot have one object added to bucket twice
900 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
901 var
902 f, c: Integer;
903 pidx, cidx: Integer;
904 pc: PGridCell;
905 begin
906 result := false; // never stop
907 // find and remove cell
908 pidx := -1; // previous cell index
909 cidx := mGrid[grida]; // current cell index
910 while (cidx <> -1) do
911 begin
912 pc := @mCells[cidx];
913 for f := 0 to GridCellBucketSize-1 do
914 begin
915 if (pc.bodies[f] = bodyId) then
916 begin
917 // i found her!
918 if (f = 0) and (pc.bodies[1] = -1) then
919 begin
920 // this cell contains no elements, remove it
921 if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
922 freeCell(cidx);
923 exit;
924 end;
925 // remove element from bucket
926 for c := f to GridCellBucketSize-2 do
927 begin
928 pc.bodies[c] := pc.bodies[c+1];
929 if (pc.bodies[c] = -1) then break;
930 end;
931 pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
932 exit;
933 end;
934 end;
935 pidx := cidx;
936 cidx := pc.next;
937 end;
938 end;
940 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
941 var
942 px: PBodyProxyRec;
943 begin
944 if (body < 0) or (body > High(mProxies)) then exit; // just in case
945 px := @mProxies[body];
946 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
947 end;
950 // ////////////////////////////////////////////////////////////////////////// //
951 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
952 begin
953 aTag := aTag and TagFullMask;
954 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
955 insertInternal(result);
956 end;
959 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
960 begin
961 if (body < 0) or (body > High(mProxies)) then exit; // just in case
962 removeInternal(body);
963 freeProxy(body);
964 end;
967 // ////////////////////////////////////////////////////////////////////////// //
968 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
969 var
970 px: PBodyProxyRec;
971 x0, y0, w, h: Integer;
972 begin
973 if (body < 0) or (body > High(mProxies)) then exit; // just in case
974 px := @mProxies[body];
975 x0 := px.mX;
976 y0 := px.mY;
977 w := px.mWidth;
978 h := px.mHeight;
979 {$IF DEFINED(D2F_DEBUG_MOVER)}
980 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);
981 {$ENDIF}
982 if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
983 // map -> grid
984 Dec(x0, mMinX);
985 Dec(y0, mMinY);
986 Dec(nx, mMinX);
987 Dec(ny, mMinY);
988 // did any corner crossed tile boundary?
989 if (x0 div mTileSize <> nx div mTileSize) or
990 (y0 div mTileSize <> ny div mTileSize) or
991 ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
992 ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
993 begin
994 removeInternal(body);
995 px.mX := nx+mMinX;
996 px.mY := ny+mMinY;
997 px.mWidth := nw;
998 px.mHeight := nh;
999 insertInternal(body);
1000 end
1001 else
1002 begin
1003 px.mX := nx+mMinX;
1004 px.mY := ny+mMinY;
1005 px.mWidth := nw;
1006 px.mHeight := nh;
1007 end;
1008 end;
1010 //TODO: optimize for horizontal/vertical moves
1011 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
1012 var
1013 px: PBodyProxyRec;
1014 x0, y0: Integer;
1015 ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
1016 ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
1017 gx, gy: Integer;
1018 gw, gh: Integer;
1019 pw, ph: Integer;
1020 begin
1021 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1022 // check if tile coords was changed
1023 px := @mProxies[body];
1024 x0 := px.mX;
1025 y0 := px.mY;
1026 if (nx = x0) and (ny = y0) then exit;
1027 // map -> grid
1028 Dec(x0, mMinX);
1029 Dec(y0, mMinY);
1030 Dec(nx, mMinX);
1031 Dec(ny, mMinY);
1032 // check for heavy work
1033 pw := px.mWidth;
1034 ph := px.mHeight;
1035 ogx0 := x0 div mTileSize;
1036 ogy0 := y0 div mTileSize;
1037 ngx0 := nx div mTileSize;
1038 ngy0 := ny div mTileSize;
1039 ogx1 := (x0+pw-1) div mTileSize;
1040 ogy1 := (y0+ph-1) div mTileSize;
1041 ngx1 := (nx+pw-1) div mTileSize;
1042 ngy1 := (ny+ph-1) div mTileSize;
1043 {$IF DEFINED(D2F_DEBUG_MOVER)}
1044 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);
1045 {$ENDIF}
1046 if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1047 begin
1048 // crossed tile boundary, do heavy work
1049 gw := mWidth;
1050 gh := mHeight;
1051 // cycle with old rect, remove body where it is necessary
1052 // optimized for horizontal moves
1053 {$IF DEFINED(D2F_DEBUG_MOVER)}
1054 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);
1055 {$ENDIF}
1056 // remove stale marks
1057 if not ((ogy0 >= gh) or (ogy1 < 0)) and
1058 not ((ogx0 >= gw) or (ogx1 < 0)) then
1059 begin
1060 if (ogx0 < 0) then ogx0 := 0;
1061 if (ogy0 < 0) then ogy0 := 0;
1062 if (ogx1 > gw-1) then ogx1 := gw-1;
1063 if (ogy1 > gh-1) then ogy1 := gh-1;
1064 {$IF DEFINED(D2F_DEBUG_MOVER)}
1065 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1066 {$ENDIF}
1067 for gx := ogx0 to ogx1 do
1068 begin
1069 if (gx < ngx0) or (gx > ngx1) then
1070 begin
1071 // this column is completely outside of new rect
1072 for gy := ogy0 to ogy1 do
1073 begin
1074 {$IF DEFINED(D2F_DEBUG_MOVER)}
1075 e_WriteLog(Format(' remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1076 {$ENDIF}
1077 remover(gy*gw+gx, body);
1078 end;
1079 end
1080 else
1081 begin
1082 // heavy checks
1083 for gy := ogy0 to ogy1 do
1084 begin
1085 if (gy < ngy0) or (gy > ngy1) then
1086 begin
1087 {$IF DEFINED(D2F_DEBUG_MOVER)}
1088 e_WriteLog(Format(' remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1089 {$ENDIF}
1090 remover(gy*gw+gx, body);
1091 end;
1092 end;
1093 end;
1094 end;
1095 end;
1096 // cycle with new rect, add body where it is necessary
1097 if not ((ngy0 >= gh) or (ngy1 < 0)) and
1098 not ((ngx0 >= gw) or (ngx1 < 0)) then
1099 begin
1100 if (ngx0 < 0) then ngx0 := 0;
1101 if (ngy0 < 0) then ngy0 := 0;
1102 if (ngx1 > gw-1) then ngx1 := gw-1;
1103 if (ngy1 > gh-1) then ngy1 := gh-1;
1104 {$IF DEFINED(D2F_DEBUG_MOVER)}
1105 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1106 {$ENDIF}
1107 for gx := ngx0 to ngx1 do
1108 begin
1109 if (gx < ogx0) or (gx > ogx1) then
1110 begin
1111 // this column is completely outside of old rect
1112 for gy := ngy0 to ngy1 do
1113 begin
1114 {$IF DEFINED(D2F_DEBUG_MOVER)}
1115 e_WriteLog(Format(' insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1116 {$ENDIF}
1117 inserter(gy*gw+gx, body);
1118 end;
1119 end
1120 else
1121 begin
1122 // heavy checks
1123 for gy := ngy0 to ngy1 do
1124 begin
1125 if (gy < ogy0) or (gy > ogy1) then
1126 begin
1127 {$IF DEFINED(D2F_DEBUG_MOVER)}
1128 e_WriteLog(Format(' insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1129 {$ENDIF}
1130 inserter(gy*gw+gx, body);
1131 end;
1132 end;
1133 end;
1134 end;
1135 end;
1136 // done
1137 end
1138 else
1139 begin
1140 {$IF DEFINED(D2F_DEBUG_MOVER)}
1141 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);
1142 {$ENDIF}
1143 end;
1144 // update coordinates
1145 px.mX := nx+mMinX;
1146 px.mY := ny+mMinY;
1147 end;
1149 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1150 var
1151 px: PBodyProxyRec;
1152 x0, y0, w, h: Integer;
1153 begin
1154 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1155 // check if tile coords was changed
1156 px := @mProxies[body];
1157 x0 := px.mX-mMinX;
1158 y0 := px.mY-mMinY;
1159 w := px.mWidth;
1160 h := px.mHeight;
1161 {$IF DEFINED(D2F_DEBUG_MOVER)}
1162 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);
1163 {$ENDIF}
1164 if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1165 ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1166 begin
1167 // crossed tile boundary, do heavy work
1168 removeInternal(body);
1169 px.mWidth := nw;
1170 px.mHeight := nh;
1171 insertInternal(body);
1172 end
1173 else
1174 begin
1175 // nothing to do with the grid, just fix size
1176 px.mWidth := nw;
1177 px.mHeight := nh;
1178 end;
1179 end;
1182 // ////////////////////////////////////////////////////////////////////////// //
1183 function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator;
1184 var
1185 cidx: Integer = -1;
1186 begin
1187 Dec(x, mMinX);
1188 Dec(y, mMinY);
1189 if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1190 result := TAtPointEnumerator.Create(mCells, cidx, getProxyById);
1191 end;
1194 // ////////////////////////////////////////////////////////////////////////// //
1195 // no callback: return `true` on the first hit
1196 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1197 var
1198 f: Integer;
1199 idx, curci: Integer;
1200 cc: PGridCell = nil;
1201 px: PBodyProxyRec;
1202 lq: LongWord;
1203 ptag: Integer;
1204 begin
1205 result := Default(ITP);
1206 if (exittag <> nil) then exittag^ := 0;
1207 tagmask := tagmask and TagFullMask;
1208 if (tagmask = 0) then exit;
1210 {$IF DEFINED(D2F_DEBUG_XXQ)}
1211 if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1212 {$ENDIF}
1214 // make coords (0,0)-based
1215 Dec(x, mMinX);
1216 Dec(y, mMinY);
1217 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1219 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1221 {$IF DEFINED(D2F_DEBUG_XXQ)}
1222 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);
1223 {$ENDIF}
1225 // restore coords
1226 Inc(x, mMinX);
1227 Inc(y, mMinY);
1229 // increase query counter
1230 Inc(mLastQuery);
1231 if (mLastQuery = 0) then
1232 begin
1233 // just in case of overflow
1234 mLastQuery := 1;
1235 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1236 end;
1237 lq := mLastQuery;
1239 {$IF DEFINED(D2F_DEBUG_XXQ)}
1240 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1241 {$ENDIF}
1243 while (curci <> -1) do
1244 begin
1245 {$IF DEFINED(D2F_DEBUG_XXQ)}
1246 if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1247 {$ENDIF}
1248 cc := @mCells[curci];
1249 for f := 0 to GridCellBucketSize-1 do
1250 begin
1251 if (cc.bodies[f] = -1) then break;
1252 px := @mProxies[cc.bodies[f]];
1253 {$IF DEFINED(D2F_DEBUG_XXQ)}
1254 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);
1255 {$ENDIF}
1256 // shit. has to do it this way, so i can change tag in callback
1257 if (px.mQueryMark <> lq) then
1258 begin
1259 px.mQueryMark := lq;
1260 ptag := px.mTag;
1261 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1262 (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1263 begin
1264 if assigned(cb) then
1265 begin
1266 if cb(px.mObj, ptag) then
1267 begin
1268 result := px.mObj;
1269 if (exittag <> nil) then exittag^ := ptag;
1270 exit;
1271 end;
1272 end
1273 else
1274 begin
1275 result := px.mObj;
1276 if (exittag <> nil) then exittag^ := ptag;
1277 exit;
1278 end;
1279 end;
1280 end;
1281 end;
1282 curci := cc.next;
1283 end;
1284 end;
1287 // ////////////////////////////////////////////////////////////////////////// //
1288 // no callback: return `true` on the first hit
1289 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1290 const
1291 tsize = mTileSize;
1292 var
1293 idx: Integer;
1294 gx, gy: Integer;
1295 curci: Integer;
1296 f: Integer;
1297 cc: PGridCell = nil;
1298 px: PBodyProxyRec;
1299 lq: LongWord;
1300 gw: Integer;
1301 x0, y0: Integer;
1302 ptag: Integer;
1303 begin
1304 result := Default(ITP);
1305 if (w < 1) or (h < 1) then exit;
1306 tagmask := tagmask and TagFullMask;
1307 if (tagmask = 0) then exit;
1309 x0 := x;
1310 y0 := y;
1312 // fix coords
1313 Dec(x, mMinX);
1314 Dec(y, mMinY);
1316 gw := mWidth;
1317 //tsize := mTileSize;
1319 if (x+w <= 0) or (y+h <= 0) then exit;
1320 if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1322 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1323 mInQuery := true;
1325 // increase query counter
1326 Inc(mLastQuery);
1327 if (mLastQuery = 0) then
1328 begin
1329 // just in case of overflow
1330 mLastQuery := 1;
1331 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1332 end;
1333 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1334 lq := mLastQuery;
1336 // go on
1337 for gy := y div tsize to (y+h-1) div tsize do
1338 begin
1339 if (gy < 0) then continue;
1340 if (gy >= mHeight) then break;
1341 for gx := x div tsize to (x+w-1) div tsize do
1342 begin
1343 if (gx < 0) then continue;
1344 if (gx >= gw) then break;
1345 // process cells
1346 curci := mGrid[gy*gw+gx];
1347 while (curci <> -1) do
1348 begin
1349 cc := @mCells[curci];
1350 for f := 0 to GridCellBucketSize-1 do
1351 begin
1352 if (cc.bodies[f] = -1) then break;
1353 px := @mProxies[cc.bodies[f]];
1354 // shit. has to do it this way, so i can change tag in callback
1355 if (px.mQueryMark = lq) then continue;
1356 px.mQueryMark := lq;
1357 ptag := px.mTag;
1358 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1359 if ((ptag and tagmask) = 0) then continue;
1360 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1361 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1362 if assigned(cb) then
1363 begin
1364 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
1365 end
1366 else
1367 begin
1368 result := px.mObj;
1369 mInQuery := false;
1370 exit;
1371 end;
1372 end;
1373 curci := cc.next;
1374 end;
1375 end;
1376 end;
1378 mInQuery := false;
1379 end;
1382 // ////////////////////////////////////////////////////////////////////////// //
1383 // no callback: return `true` on the nearest hit
1384 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1385 var
1386 ex, ey: Integer;
1387 begin
1388 result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1389 end;
1392 // no callback: return `true` on the nearest hit
1393 // you are not supposed to understand this
1394 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1395 const
1396 tsize = mTileSize;
1397 var
1398 wx0, wy0, wx1, wy1: Integer; // window coordinates
1399 stx, sty: Integer; // "steps" for x and y axes
1400 dsx, dsy: Integer; // "lengthes" for x and y axes
1401 dx2, dy2: Integer; // "double lengthes" for x and y axes
1402 xd, yd: Integer; // current coord
1403 e: Integer; // "error" (as in bresenham algo)
1404 rem: Integer;
1405 term: Integer;
1406 xptr, yptr: PInteger;
1407 xfixed: Boolean;
1408 temp: Integer;
1409 prevx, prevy: Integer;
1410 lastDistSq: Integer;
1411 ccidx, curci: Integer;
1412 hasUntried: Boolean;
1413 lastGA: Integer = -1;
1414 ga, x, y: Integer;
1415 lastObj: ITP;
1416 wasHit: Boolean = false;
1417 gw, gh, minx, miny, maxx, maxy: Integer;
1418 cc: PGridCell;
1419 px: PBodyProxyRec;
1420 lq: LongWord;
1421 f, ptag, distSq: Integer;
1422 x0, y0, x1, y1: Integer;
1423 //swapped: Boolean = false; // true: xd is yd, and vice versa
1424 // horizontal walker
1425 {$IFDEF GRID_USE_ORTHO_ACCEL}
1426 wklen, wkstep: Integer;
1427 //wksign: Integer;
1428 hopt: Boolean;
1429 {$ENDIF}
1430 // skipper
1431 xdist, ydist: Integer;
1432 begin
1433 result := Default(ITP);
1434 lastObj := Default(ITP);
1435 tagmask := tagmask and TagFullMask;
1436 ex := ax1; // why not?
1437 ey := ay1; // why not?
1438 if (tagmask = 0) then exit;
1440 if (ax0 = ax1) and (ay0 = ay1) then
1441 begin
1442 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1443 if (result <> nil) then
1444 begin
1445 if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
1446 end;
1447 exit;
1448 end;
1450 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1452 gw := mWidth;
1453 gh := mHeight;
1454 minx := mMinX;
1455 miny := mMinY;
1456 maxx := gw*tsize-1;
1457 maxy := gh*tsize-1;
1459 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1460 if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format('TRACING: (%d,%d)-(%d,%d) [(%d,%d)-(%d,%d)]; maxdistsq=%d', [ax0, ay0, ax1, ay1, minx, miny, maxx, maxy, lastDistSq]), MSG_NOTIFY);
1461 {$ENDIF}
1463 x0 := ax0;
1464 y0 := ay0;
1465 x1 := ax1;
1466 y1 := ay1;
1468 // offset query coords to (0,0)-based
1469 Dec(x0, minx);
1470 Dec(y0, miny);
1471 Dec(x1, minx);
1472 Dec(y1, miny);
1474 // clip rectange
1475 wx0 := 0;
1476 wy0 := 0;
1477 wx1 := maxx;
1478 wy1 := maxy;
1480 // horizontal setup
1481 if (x0 < x1) then
1482 begin
1483 // from left to right
1484 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1485 stx := 1; // going right
1486 end
1487 else
1488 begin
1489 // from right to left
1490 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1491 stx := -1; // going left
1492 x0 := -x0;
1493 x1 := -x1;
1494 wx0 := -wx0;
1495 wx1 := -wx1;
1496 swapInt(wx0, wx1);
1497 end;
1499 // vertical setup
1500 if (y0 < y1) then
1501 begin
1502 // from top to bottom
1503 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1504 sty := 1; // going down
1505 end
1506 else
1507 begin
1508 // from bottom to top
1509 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1510 sty := -1; // going up
1511 y0 := -y0;
1512 y1 := -y1;
1513 wy0 := -wy0;
1514 wy1 := -wy1;
1515 swapInt(wy0, wy1);
1516 end;
1518 dsx := x1-x0;
1519 dsy := y1-y0;
1521 if (dsx < dsy) then
1522 begin
1523 //swapped := true;
1524 xptr := @yd;
1525 yptr := @xd;
1526 swapInt(x0, y0);
1527 swapInt(x1, y1);
1528 swapInt(dsx, dsy);
1529 swapInt(wx0, wy0);
1530 swapInt(wx1, wy1);
1531 swapInt(stx, sty);
1532 end
1533 else
1534 begin
1535 xptr := @xd;
1536 yptr := @yd;
1537 end;
1539 dx2 := 2*dsx;
1540 dy2 := 2*dsy;
1541 xd := x0;
1542 yd := y0;
1543 e := 2*dsy-dsx;
1544 term := x1;
1546 xfixed := false;
1547 if (y0 < wy0) then
1548 begin
1549 // clip at top
1550 temp := dx2*(wy0-y0)-dsx;
1551 xd += temp div dy2;
1552 rem := temp mod dy2;
1553 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1554 if (xd+1 >= wx0) then
1555 begin
1556 yd := wy0;
1557 e -= rem+dsx;
1558 if (rem > 0) then begin Inc(xd); e += dy2; end;
1559 xfixed := true;
1560 end;
1561 end;
1563 if (not xfixed) and (x0 < wx0) then
1564 begin
1565 // clip at left
1566 temp := dy2*(wx0-x0);
1567 yd += temp div dx2;
1568 rem := temp mod dx2;
1569 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1570 xd := wx0;
1571 e += rem;
1572 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1573 end;
1575 if (y1 > wy1) then
1576 begin
1577 // clip at bottom
1578 temp := dx2*(wy1-y0)+dsx;
1579 term := x0+temp div dy2;
1580 rem := temp mod dy2;
1581 if (rem = 0) then Dec(term);
1582 end;
1584 if (term > wx1) then term := wx1; // clip at right
1586 Inc(term); // draw last point
1587 //if (term = xd) then exit; // this is the only point, get out of here
1589 if (sty = -1) then yd := -yd;
1590 if (stx = -1) then begin xd := -xd; term := -term; end;
1591 dx2 -= dy2;
1593 // first move, to skip starting point
1594 // DON'T DO THIS! loop will take care of that
1595 if (xd = term) then
1596 begin
1597 //FIXME!
1598 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1599 if (result <> nil) then
1600 begin
1601 if assigned(cb) then
1602 begin
1603 if cb(result, ptag, ax0, ay0, ax0, ay0) then
1604 begin
1605 ex := ax0;
1606 ey := ay0;
1607 end
1608 else
1609 begin
1610 result := nil;
1611 end;
1612 end
1613 else
1614 begin
1615 ex := ax0;
1616 ey := ay0;
1617 end;
1618 end;
1619 exit;
1620 end;
1622 prevx := xptr^+minx;
1623 prevy := yptr^+miny;
1624 (*
1625 // move coords
1626 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1627 xd += stx;
1628 // done?
1629 if (xd = term) then exit;
1630 *)
1632 {$IF DEFINED(D2F_DEBUG)}
1633 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1634 {$ENDIF}
1635 // DON'T DO THIS! loop will take care of that
1636 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1637 //ccidx := mGrid[lastGA];
1639 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1640 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1641 {$ENDIF}
1643 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1645 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1646 mInQuery := true;
1648 // increase query counter
1649 Inc(mLastQuery);
1650 if (mLastQuery = 0) then
1651 begin
1652 // just in case of overflow
1653 mLastQuery := 1;
1654 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1655 end;
1656 lq := mLastQuery;
1658 {$IFDEF GRID_USE_ORTHO_ACCEL}
1659 // if this is strict horizontal/vertical trace, use optimized codepath
1660 if (ax0 = ax1) or (ay0 = ay1) then
1661 begin
1662 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
1663 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
1664 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
1665 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
1666 hopt := (ay0 = ay1); // horizontal?
1667 if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
1668 {$IF DEFINED(D2F_DEBUG)}
1669 if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
1670 {$ENDIF}
1671 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1672 // one of those will never change
1673 x := xptr^+minx;
1674 y := yptr^+miny;
1675 while (wklen > 0) do
1676 begin
1677 {$IF DEFINED(D2F_DEBUG)}
1678 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1679 {$ENDIF}
1680 // new tile?
1681 if (ga <> lastGA) then
1682 begin
1683 lastGA := ga;
1684 ccidx := mGrid[lastGA];
1685 // convert coords to map (to avoid ajdusting coords inside the loop)
1686 if hopt then x := xptr^+minx else y := yptr^+miny;
1687 while (ccidx <> -1) do
1688 begin
1689 cc := @mCells[ccidx];
1690 for f := 0 to GridCellBucketSize-1 do
1691 begin
1692 if (cc.bodies[f] = -1) then break;
1693 px := @mProxies[cc.bodies[f]];
1694 ptag := px.mTag;
1695 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
1696 // constant coord should be inside
1697 ((hopt and (y >= px.y0) and (y <= px.y1)) or
1698 ((not hopt) and (x >= px.x0) and (x <= px.x1))) then
1699 begin
1700 px.mQueryMark := lq; // mark as processed
1701 // inside the proxy?
1702 if (hopt and (x > px.x0) and (x < px.x1)) or
1703 ((not hopt) and (y > px.y0) and (y < px.y1)) then
1704 begin
1705 // setup prev[xy]
1706 if assigned(cb) then
1707 begin
1708 if cb(px.mObj, ptag, x, y, x, y) then
1709 begin
1710 result := px.mObj;
1711 ex := x;
1712 ey := y;
1713 mInQuery := false;
1714 exit;
1715 end;
1716 end
1717 else
1718 begin
1719 distSq := distanceSq(ax0, ay0, x, y);
1720 {$IF DEFINED(D2F_DEBUG)}
1721 if dbgShowTraceLog then e_LogWritefln(' EMBEDDED hhit(%d): a=(%d,%d), h=(%d,%d), distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, distSq, lastDistSq]);
1722 {$ENDIF}
1723 if (distSq < lastDistSq) then
1724 begin
1725 ex := x;
1726 ey := y;
1727 result := px.mObj;
1728 mInQuery := false;
1729 exit;
1730 end;
1731 end;
1732 continue;
1733 end;
1734 // remember this hitpoint if it is nearer than an old one
1735 // setup prev[xy]
1736 if hopt then
1737 begin
1738 // horizontal trace
1739 prevy := y;
1740 y := yptr^+miny;
1741 if (stx < 0) then
1742 begin
1743 // going left
1744 if (x < px.x1) then continue; // not on the right edge
1745 x := px.x1;
1746 prevx := x+1;
1747 end
1748 else
1749 begin
1750 // going right
1751 if (x > px.x0) then continue; // not on the left edge
1752 x := px.x0;
1753 prevx := x-1;
1754 end;
1755 end
1756 else
1757 begin
1758 // vertical trace
1759 prevx := x;
1760 x := xptr^+minx;
1761 if (stx < 0) then
1762 begin
1763 // going up
1764 if (y < px.y1) then continue; // not on the bottom edge
1765 y := px.y1;
1766 prevy := x+1;
1767 end
1768 else
1769 begin
1770 // going down
1771 if (y > px.y0) then continue; // not on the top edge
1772 y := px.y0;
1773 prevy := y-1;
1774 end;
1775 end;
1776 if assigned(cb) then
1777 begin
1778 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1779 begin
1780 result := px.mObj;
1781 ex := prevx;
1782 ey := prevy;
1783 mInQuery := false;
1784 exit;
1785 end;
1786 end
1787 else
1788 begin
1789 distSq := distanceSq(ax0, ay0, prevx, prevy);
1790 {$IF DEFINED(D2F_DEBUG)}
1791 if dbgShowTraceLog then e_LogWritefln(' hhit(%d): a=(%d,%d), h=(%d,%d), p=(%d,%d), distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, prevx, prevy, distSq, lastDistSq]);
1792 {$ENDIF}
1793 if (distSq < lastDistSq) then
1794 begin
1795 wasHit := true;
1796 lastDistSq := distSq;
1797 ex := prevx;
1798 ey := prevy;
1799 lastObj := px.mObj;
1800 end;
1801 end;
1802 end;
1803 end;
1804 // next cell
1805 ccidx := cc.next;
1806 end;
1807 if wasHit and not assigned(cb) then begin result := lastObj; mInQuery := false; exit; end;
1808 if assigned(cb) and cb(nil, 0, x, y, x, y) then begin result := lastObj; mInQuery := false; exit; end;
1809 end;
1810 // skip to next tile
1811 if hopt then
1812 begin
1813 if (stx > 0) then
1814 begin
1815 // to the right
1816 wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
1817 {$IF DEFINED(D2F_DEBUG)}
1818 if dbgShowTraceLog then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1819 {$ENDIF}
1820 if (wkstep >= wklen) then break;
1821 Inc(xptr^, wkstep);
1822 Inc(ga);
1823 end
1824 else
1825 begin
1826 // to the left
1827 wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
1828 {$IF DEFINED(D2F_DEBUG)}
1829 if dbgShowTraceLog then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1830 {$ENDIF}
1831 if (wkstep >= wklen) then break;
1832 Dec(xptr^, wkstep);
1833 Dec(ga);
1834 end;
1835 end
1836 else
1837 begin
1838 if (stx > 0) then
1839 begin
1840 // to the down
1841 wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
1842 {$IF DEFINED(D2F_DEBUG)}
1843 if dbgShowTraceLog then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1844 {$ENDIF}
1845 if (wkstep >= wklen) then break;
1846 Inc(yptr^, wkstep);
1847 Inc(ga, mWidth);
1848 end
1849 else
1850 begin
1851 // to the up
1852 wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
1853 {$IF DEFINED(D2F_DEBUG)}
1854 if dbgShowTraceLog then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1855 {$ENDIF}
1856 if (wkstep >= wklen) then break;
1857 Dec(yptr^, wkstep);
1858 Dec(ga, mWidth);
1859 end;
1860 end;
1861 Dec(wklen, wkstep);
1862 end;
1863 // we can travel less than one cell
1864 if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
1865 mInQuery := false;
1866 exit;
1867 end;
1868 {$ENDIF}
1870 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1871 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1872 {$ENDIF}
1874 //e_LogWritefln('*********************', []);
1875 ccidx := -1;
1876 // can omit checks
1877 while (xd <> term) do
1878 begin
1879 // check cell(s)
1880 {$IF DEFINED(D2F_DEBUG)}
1881 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1882 {$ENDIF}
1883 // new tile?
1884 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1885 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1886 if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' xd=%d; term=%d; gx=%d; gy=%d; ga=%d; lastga=%d', [xd, term, xptr^, yptr^, ga, lastGA]), MSG_NOTIFY);
1887 {$ENDIF}
1888 if (ga <> lastGA) then
1889 begin
1890 // yes
1891 {$IF DEFINED(D2F_DEBUG)}
1892 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1893 {$ENDIF}
1894 if (ccidx <> -1) then
1895 begin
1896 // signal cell completion
1897 if assigned(cb) then
1898 begin
1899 if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
1900 end
1901 else if wasHit then
1902 begin
1903 result := lastObj;
1904 mInQuery := false;
1905 exit;
1906 end;
1907 end;
1908 lastGA := ga;
1909 ccidx := mGrid[lastGA];
1910 end;
1911 // has something to process in this tile?
1912 if (ccidx <> -1) then
1913 begin
1914 // process cell
1915 curci := ccidx;
1916 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1917 // convert coords to map (to avoid ajdusting coords inside the loop)
1918 x := xptr^+minx;
1919 y := yptr^+miny;
1920 // process cell list
1921 while (curci <> -1) do
1922 begin
1923 cc := @mCells[curci];
1924 for f := 0 to GridCellBucketSize-1 do
1925 begin
1926 if (cc.bodies[f] = -1) then break;
1927 px := @mProxies[cc.bodies[f]];
1928 ptag := px.mTag;
1929 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1930 begin
1931 // can we process this proxy?
1932 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1933 begin
1934 px.mQueryMark := lq; // mark as processed
1935 if assigned(cb) then
1936 begin
1937 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1938 begin
1939 result := px.mObj;
1940 ex := prevx;
1941 ey := prevy;
1942 mInQuery := false;
1943 exit;
1944 end;
1945 end
1946 else
1947 begin
1948 // remember this hitpoint if it is nearer than an old one
1949 distSq := distanceSq(ax0, ay0, prevx, prevy);
1950 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1951 if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' hit(%d): a=(%d,%d), h=(%d,%d), p=(%d,%d); distsq=%d; lastsq=%d', [cc.bodies[f], ax0, ay0, x, y, prevx, prevy, distSq, lastDistSq]), MSG_NOTIFY);
1952 {$ENDIF}
1953 if (distSq < lastDistSq) then
1954 begin
1955 wasHit := true;
1956 lastDistSq := distSq;
1957 ex := prevx;
1958 ey := prevy;
1959 lastObj := px.mObj;
1960 end;
1961 end;
1962 end
1963 else
1964 begin
1965 // this is possibly interesting proxy, set "has more to check" flag
1966 hasUntried := true;
1967 end;
1968 end;
1969 end;
1970 // next cell
1971 curci := cc.next;
1972 end;
1973 // still has something interesting in this cell?
1974 if not hasUntried then
1975 begin
1976 // nope, don't process this cell anymore; signal cell completion
1977 ccidx := -1;
1978 if assigned(cb) then
1979 begin
1980 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
1981 end
1982 else if wasHit then
1983 begin
1984 result := lastObj;
1985 mInQuery := false;
1986 exit;
1987 end;
1988 end;
1989 end;
1990 if (ccidx = -1) then
1991 begin
1992 // move to cell edge, as we have nothing to trace here anymore
1993 if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
1994 if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
1995 //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
1996 while (xd <> xdist) and (yd <> ydist) do
1997 begin
1998 // step
1999 xd += stx;
2000 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2001 //e_LogWritefln(' xd=%d; yd=%d', [xd, yd]);
2002 if (xd = term) then break;
2003 end;
2004 //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2005 if (xd = term) then break;
2006 end;
2007 //putPixel(xptr^, yptr^);
2008 // move coords
2009 prevx := xptr^+minx;
2010 prevy := yptr^+miny;
2011 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2012 xd += stx;
2013 end;
2014 // we can travel less than one cell
2015 if wasHit and not assigned(cb) then
2016 begin
2017 result := lastObj;
2018 end
2019 else
2020 begin
2021 ex := ax1; // why not?
2022 ey := ay1; // why not?
2023 end;
2025 mInQuery := false;
2026 end;
2029 // ////////////////////////////////////////////////////////////////////////// //
2030 //FIXME! optimize this with real tile walking
2031 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
2032 const
2033 tsize = mTileSize;
2034 var
2035 wx0, wy0, wx1, wy1: Integer; // window coordinates
2036 stx, sty: Integer; // "steps" for x and y axes
2037 dsx, dsy: Integer; // "lengthes" for x and y axes
2038 dx2, dy2: Integer; // "double lengthes" for x and y axes
2039 xd, yd: Integer; // current coord
2040 e: Integer; // "error" (as in bresenham algo)
2041 rem: Integer;
2042 term: Integer;
2043 xptr, yptr: PInteger;
2044 xfixed: Boolean;
2045 temp: Integer;
2046 ccidx, curci: Integer;
2047 lastGA: Integer = -1;
2048 ga: Integer;
2049 gw, gh, minx, miny, maxx, maxy: Integer;
2050 cc: PGridCell;
2051 px: PBodyProxyRec;
2052 lq: LongWord;
2053 f, ptag: Integer;
2054 x0, y0, x1, y1: Integer;
2055 //swapped: Boolean = false; // true: xd is yd, and vice versa
2056 // horizontal walker
2057 {$IFDEF GRID_USE_ORTHO_ACCEL}
2058 wklen, wkstep: Integer;
2059 //wksign: Integer;
2060 hopt: Boolean;
2061 {$ENDIF}
2062 // skipper
2063 xdist, ydist: Integer;
2064 begin
2065 log := false;
2066 result := Default(ITP);
2067 tagmask := tagmask and TagFullMask;
2068 if (tagmask = 0) or not assigned(cb) then exit;
2070 if (ax0 = ax1) and (ay0 = ay1) then
2071 begin
2072 result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2073 exit;
2074 end;
2076 gw := mWidth;
2077 gh := mHeight;
2078 minx := mMinX;
2079 miny := mMinY;
2080 maxx := gw*tsize-1;
2081 maxy := gh*tsize-1;
2083 x0 := ax0;
2084 y0 := ay0;
2085 x1 := ax1;
2086 y1 := ay1;
2088 // offset query coords to (0,0)-based
2089 Dec(x0, minx);
2090 Dec(y0, miny);
2091 Dec(x1, minx);
2092 Dec(y1, miny);
2094 // clip rectange
2095 wx0 := 0;
2096 wy0 := 0;
2097 wx1 := maxx;
2098 wy1 := maxy;
2100 // horizontal setup
2101 if (x0 < x1) then
2102 begin
2103 // from left to right
2104 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2105 stx := 1; // going right
2106 end
2107 else
2108 begin
2109 // from right to left
2110 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2111 stx := -1; // going left
2112 x0 := -x0;
2113 x1 := -x1;
2114 wx0 := -wx0;
2115 wx1 := -wx1;
2116 swapInt(wx0, wx1);
2117 end;
2119 // vertical setup
2120 if (y0 < y1) then
2121 begin
2122 // from top to bottom
2123 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2124 sty := 1; // going down
2125 end
2126 else
2127 begin
2128 // from bottom to top
2129 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2130 sty := -1; // going up
2131 y0 := -y0;
2132 y1 := -y1;
2133 wy0 := -wy0;
2134 wy1 := -wy1;
2135 swapInt(wy0, wy1);
2136 end;
2138 dsx := x1-x0;
2139 dsy := y1-y0;
2141 if (dsx < dsy) then
2142 begin
2143 //swapped := true;
2144 xptr := @yd;
2145 yptr := @xd;
2146 swapInt(x0, y0);
2147 swapInt(x1, y1);
2148 swapInt(dsx, dsy);
2149 swapInt(wx0, wy0);
2150 swapInt(wx1, wy1);
2151 swapInt(stx, sty);
2152 end
2153 else
2154 begin
2155 xptr := @xd;
2156 yptr := @yd;
2157 end;
2159 dx2 := 2*dsx;
2160 dy2 := 2*dsy;
2161 xd := x0;
2162 yd := y0;
2163 e := 2*dsy-dsx;
2164 term := x1;
2166 xfixed := false;
2167 if (y0 < wy0) then
2168 begin
2169 // clip at top
2170 temp := dx2*(wy0-y0)-dsx;
2171 xd += temp div dy2;
2172 rem := temp mod dy2;
2173 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2174 if (xd+1 >= wx0) then
2175 begin
2176 yd := wy0;
2177 e -= rem+dsx;
2178 if (rem > 0) then begin Inc(xd); e += dy2; end;
2179 xfixed := true;
2180 end;
2181 end;
2183 if (not xfixed) and (x0 < wx0) then
2184 begin
2185 // clip at left
2186 temp := dy2*(wx0-x0);
2187 yd += temp div dx2;
2188 rem := temp mod dx2;
2189 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2190 xd := wx0;
2191 e += rem;
2192 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2193 end;
2195 if (y1 > wy1) then
2196 begin
2197 // clip at bottom
2198 temp := dx2*(wy1-y0)+dsx;
2199 term := x0+temp div dy2;
2200 rem := temp mod dy2;
2201 if (rem = 0) then Dec(term);
2202 end;
2204 if (term > wx1) then term := wx1; // clip at right
2206 Inc(term); // draw last point
2207 //if (term = xd) then exit; // this is the only point, get out of here
2209 if (sty = -1) then yd := -yd;
2210 if (stx = -1) then begin xd := -xd; term := -term; end;
2211 dx2 -= dy2;
2213 // first move, to skip starting point
2214 // DON'T DO THIS! loop will take care of that
2215 if (xd = term) then
2216 begin
2217 result := forEachAtPoint(ax0, ay0, cb, tagmask, @ptag);
2218 exit;
2219 end;
2221 (*
2222 // move coords
2223 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2224 xd += stx;
2225 // done?
2226 if (xd = term) then exit;
2227 *)
2229 {$IF DEFINED(D2F_DEBUG)}
2230 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2231 {$ENDIF}
2232 // DON'T DO THIS! loop will take care of that
2233 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2234 //ccidx := mGrid[lastGA];
2236 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2237 mInQuery := true;
2239 // increase query counter
2240 Inc(mLastQuery);
2241 if (mLastQuery = 0) then
2242 begin
2243 // just in case of overflow
2244 mLastQuery := 1;
2245 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2246 end;
2247 lq := mLastQuery;
2249 {$IFDEF GRID_USE_ORTHO_ACCEL}
2250 // if this is strict horizontal/vertical trace, use optimized codepath
2251 if (ax0 = ax1) or (ay0 = ay1) then
2252 begin
2253 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2254 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
2255 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2256 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
2257 hopt := (ay0 = ay1); // horizontal?
2258 if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
2259 {$IF DEFINED(D2F_DEBUG)}
2260 if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
2261 {$ENDIF}
2262 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2263 while (wklen > 0) do
2264 begin
2265 {$IF DEFINED(D2F_DEBUG)}
2266 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; ay0=%d', [ga, xptr^+minx, yptr^+miny, ay0]);
2267 {$ENDIF}
2268 // new tile?
2269 if (ga <> lastGA) then
2270 begin
2271 lastGA := ga;
2272 ccidx := mGrid[lastGA];
2273 // convert coords to map (to avoid ajdusting coords inside the loop)
2274 while (ccidx <> -1) do
2275 begin
2276 cc := @mCells[ccidx];
2277 for f := 0 to GridCellBucketSize-1 do
2278 begin
2279 if (cc.bodies[f] = -1) then break;
2280 px := @mProxies[cc.bodies[f]];
2281 ptag := px.mTag;
2282 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2283 begin
2284 px.mQueryMark := lq; // mark as processed
2285 if assigned(cb) then
2286 begin
2287 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2288 end
2289 else
2290 begin
2291 result := px.mObj;
2292 mInQuery := false;
2293 exit;
2294 end;
2295 end;
2296 end;
2297 // next cell
2298 ccidx := cc.next;
2299 end;
2300 end;
2301 // skip to next tile
2302 if hopt then
2303 begin
2304 if (stx > 0) then
2305 begin
2306 // to the right
2307 wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
2308 {$IF DEFINED(D2F_DEBUG)}
2309 if dbgShowTraceLog then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2310 {$ENDIF}
2311 if (wkstep >= wklen) then break;
2312 Inc(xptr^, wkstep);
2313 Inc(ga);
2314 end
2315 else
2316 begin
2317 // to the left
2318 wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
2319 {$IF DEFINED(D2F_DEBUG)}
2320 if dbgShowTraceLog then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2321 {$ENDIF}
2322 if (wkstep >= wklen) then break;
2323 Dec(xptr^, wkstep);
2324 Dec(ga);
2325 end;
2326 end
2327 else
2328 begin
2329 if (stx > 0) then
2330 begin
2331 // to the down
2332 wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
2333 {$IF DEFINED(D2F_DEBUG)}
2334 if dbgShowTraceLog then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2335 {$ENDIF}
2336 if (wkstep >= wklen) then break;
2337 Inc(yptr^, wkstep);
2338 Inc(ga, mWidth);
2339 end
2340 else
2341 begin
2342 // to the up
2343 wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
2344 {$IF DEFINED(D2F_DEBUG)}
2345 if dbgShowTraceLog then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2346 {$ENDIF}
2347 if (wkstep >= wklen) then break;
2348 Dec(yptr^, wkstep);
2349 Dec(ga, mWidth);
2350 end;
2351 end;
2352 Dec(wklen, wkstep);
2353 end;
2354 mInQuery := false;
2355 exit;
2356 end;
2357 {$ENDIF}
2359 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2360 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2361 {$ENDIF}
2363 ccidx := -1;
2364 // can omit checks
2365 while (xd <> term) do
2366 begin
2367 // check cell(s)
2368 {$IF DEFINED(D2F_DEBUG)}
2369 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
2370 {$ENDIF}
2371 // new tile?
2372 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2373 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2374 if assigned(dbgRayTraceTileHitCB) then e_WriteLog(Format(' xd=%d; term=%d; gx=%d; gy=%d; ga=%d; lastga=%d', [xd, term, xptr^, yptr^, ga, lastGA]), MSG_NOTIFY);
2375 {$ENDIF}
2376 if (ga <> lastGA) then
2377 begin
2378 // yes
2379 {$IF DEFINED(D2F_DEBUG)}
2380 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
2381 {$ENDIF}
2382 lastGA := ga;
2383 ccidx := mGrid[lastGA];
2384 end;
2385 // has something to process in this tile?
2386 if (ccidx <> -1) then
2387 begin
2388 // process cell
2389 curci := ccidx;
2390 // process cell list
2391 while (curci <> -1) do
2392 begin
2393 cc := @mCells[curci];
2394 for f := 0 to GridCellBucketSize-1 do
2395 begin
2396 if (cc.bodies[f] = -1) then break;
2397 px := @mProxies[cc.bodies[f]];
2398 ptag := px.mTag;
2399 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2400 begin
2401 px.mQueryMark := lq; // mark as processed
2402 if assigned(cb) then
2403 begin
2404 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
2405 end
2406 else
2407 begin
2408 result := px.mObj;
2409 mInQuery := false;
2410 exit;
2411 end;
2412 end;
2413 end;
2414 // next cell
2415 curci := cc.next;
2416 end;
2417 // nothing more interesting in this cell
2418 ccidx := -1;
2419 end;
2420 // move to cell edge, as we have nothing to trace here anymore
2421 if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2422 if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2423 //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2424 while (xd <> xdist) and (yd <> ydist) do
2425 begin
2426 // step
2427 xd += stx;
2428 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2429 //e_LogWritefln(' xd=%d; yd=%d', [xd, yd]);
2430 if (xd = term) then break;
2431 end;
2432 //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2433 if (xd = term) then break;
2434 //putPixel(xptr^, yptr^);
2435 // move coords
2436 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2437 xd += stx;
2438 end;
2440 mInQuery := false;
2441 end;
2444 end.