DEADSOFTWARE

temporarily turned off raytracing ortho-accelerator (it is buggy)
[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
36 type TGridAlongQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
38 type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
40 const TagDisabled = $40000000;
41 const TagFullMask = $3fffffff;
43 private
44 const
45 GridDefaultTileSize = 32; // must be power of two!
46 GridCellBucketSize = 8; // WARNING! can't be less than 2!
48 private
49 type
50 PBodyProxyRec = ^TBodyProxyRec;
51 TBodyProxyRec = record
52 private
53 mX, mY, mWidth, mHeight: Integer; // aabb
54 mQueryMark: LongWord; // was this object visited at this query?
55 mObj: ITP;
56 mTag: Integer; // `TagDisabled` set: disabled ;-)
57 nextLink: TBodyProxyId; // next free or nothing
59 private
60 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
61 end;
63 PGridCell = ^TGridCell;
64 TGridCell = record
65 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
66 next: Integer; // in this cell; index in mCells
67 end;
69 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
71 private
72 //mTileSize: Integer;
73 const mTileSize = GridDefaultTileSize;
75 public
76 const tileSize = mTileSize;
78 private
79 mMinX, mMinY: Integer; // so grids can start at any origin
80 mWidth, mHeight: Integer; // in tiles
81 mGrid: array of Integer; // mWidth*mHeight, index in mCells
82 mCells: array of TGridCell; // cell pool
83 mFreeCell: Integer; // first free cell index or -1
84 mLastQuery: LongWord;
85 mUsedCells: Integer;
86 mProxies: array of TBodyProxyRec;
87 mProxyFree: TBodyProxyId; // free
88 mProxyCount: Integer; // currently used
89 mProxyMaxCount: Integer;
91 public
92 dbgShowTraceLog: Boolean;
93 {$IF DEFINED(D2F_DEBUG)}
94 dbgRayTraceTileHitCB: TCellQueryCB;
95 {$ENDIF}
97 private
98 function allocCell (): Integer;
99 procedure freeCell (idx: Integer); // `next` is simply overwritten
101 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
102 procedure freeProxy (body: TBodyProxyId);
104 procedure insertInternal (body: TBodyProxyId);
105 procedure removeInternal (body: TBodyProxyId);
107 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
109 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
110 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
112 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
113 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
115 function getGridWidthPx (): Integer; inline;
116 function getGridHeightPx (): Integer; inline;
118 public
119 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
120 destructor Destroy (); override;
122 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
123 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
125 procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
126 procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
127 procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
129 function insideGrid (x, y: Integer): Boolean; inline;
131 // `false` if `body` is surely invalid
132 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
133 function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
134 function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
136 //WARNING: don't modify grid while any query is in progress (no checks are made!)
137 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
138 // no callback: return `true` on the first hit
139 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
141 //WARNING: don't modify grid while any query is in progress (no checks are made!)
142 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
143 // no callback: return object on the first hit or nil
144 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
146 //WARNING: don't modify grid while any query is in progress (no checks are made!)
147 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
148 // cb with `(nil)` will be called before processing new tile
149 // no callback: return object of the nearest hit or nil
150 // if `inverted` is true, trace will register bodies *exluding* tagmask
151 //WARNING: don't change tags in callbacks here!
152 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
153 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
155 //function traceOrthoRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
156 //function traceOrthoRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
158 //WARNING: don't modify grid while any query is in progress (no checks are made!)
159 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
160 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
161 //WARNING: don't change tags in callbacks here!
162 function forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
164 // debug
165 procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
166 function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
167 procedure dumpStats ();
169 //WARNING! no sanity checks!
170 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
172 property gridX0: Integer read mMinX;
173 property gridY0: Integer read mMinY;
174 property gridWidth: Integer read getGridWidthPx; // in pixels
175 property gridHeight: Integer read getGridHeightPx; // in pixels
176 end;
179 // you are not supposed to understand this
180 // returns `true` if there is an intersection, and enter coords
181 // enter coords will be equal to (x0, y0) if starting point is inside the box
182 // if result is `false`, `inx` and `iny` are undefined
183 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
185 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
187 procedure swapInt (var a: Integer; var b: Integer); inline;
188 function minInt (a, b: Integer): Integer; inline;
189 function maxInt (a, b: Integer): Integer; inline;
192 implementation
194 uses
195 SysUtils, e_log;
198 // ////////////////////////////////////////////////////////////////////////// //
199 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
200 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
201 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
203 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
206 // ////////////////////////////////////////////////////////////////////////// //
207 // you are not supposed to understand this
208 // returns `true` if there is an intersection, and enter coords
209 // enter coords will be equal to (x0, y0) if starting point is inside the box
210 // if result is `false`, `inx` and `iny` are undefined
211 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
212 var
213 wx0, wy0, wx1, wy1: Integer; // window coordinates
214 stx, sty: Integer; // "steps" for x and y axes
215 dsx, dsy: Integer; // "lengthes" for x and y axes
216 dx2, dy2: Integer; // "double lengthes" for x and y axes
217 xd, yd: Integer; // current coord
218 e: Integer; // "error" (as in bresenham algo)
219 rem: Integer;
220 //!term: Integer;
221 d0, d1: PInteger;
222 xfixed: Boolean;
223 temp: Integer;
224 begin
225 result := false;
226 // why not
227 inx := x0;
228 iny := y0;
229 if (bw < 1) or (bh < 1) then exit; // impossible box
231 if (x0 = x1) and (y0 = y1) then
232 begin
233 // check this point
234 result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
235 exit;
236 end;
238 // check if staring point is inside the box
239 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
241 // clip rectange
242 wx0 := bx;
243 wy0 := by;
244 wx1 := bx+bw-1;
245 wy1 := by+bh-1;
247 // horizontal setup
248 if (x0 < x1) then
249 begin
250 // from left to right
251 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
252 stx := 1; // going right
253 end
254 else
255 begin
256 // from right to left
257 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
258 stx := -1; // going left
259 x0 := -x0;
260 x1 := -x1;
261 wx0 := -wx0;
262 wx1 := -wx1;
263 swapInt(wx0, wx1);
264 end;
266 // vertical setup
267 if (y0 < y1) then
268 begin
269 // from top to bottom
270 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
271 sty := 1; // going down
272 end
273 else
274 begin
275 // from bottom to top
276 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
277 sty := -1; // going up
278 y0 := -y0;
279 y1 := -y1;
280 wy0 := -wy0;
281 wy1 := -wy1;
282 swapInt(wy0, wy1);
283 end;
285 dsx := x1-x0;
286 dsy := y1-y0;
288 if (dsx < dsy) then
289 begin
290 d0 := @yd;
291 d1 := @xd;
292 swapInt(x0, y0);
293 swapInt(x1, y1);
294 swapInt(dsx, dsy);
295 swapInt(wx0, wy0);
296 swapInt(wx1, wy1);
297 swapInt(stx, sty);
298 end
299 else
300 begin
301 d0 := @xd;
302 d1 := @yd;
303 end;
305 dx2 := 2*dsx;
306 dy2 := 2*dsy;
307 xd := x0;
308 yd := y0;
309 e := 2*dsy-dsx;
310 //!term := x1;
312 xfixed := false;
313 if (y0 < wy0) then
314 begin
315 // clip at top
316 temp := dx2*(wy0-y0)-dsx;
317 xd += temp div dy2;
318 rem := temp mod dy2;
319 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
320 if (xd+1 >= wx0) then
321 begin
322 yd := wy0;
323 e -= rem+dsx;
324 if (rem > 0) then begin Inc(xd); e += dy2; end;
325 xfixed := true;
326 end;
327 end;
329 if (not xfixed) and (x0 < wx0) then
330 begin
331 // clip at left
332 temp := dy2*(wx0-x0);
333 yd += temp div dx2;
334 rem := temp mod dx2;
335 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
336 xd := wx0;
337 e += rem;
338 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
339 end;
341 (*
342 if (y1 > wy1) then
343 begin
344 // clip at bottom
345 temp := dx2*(wy1-y0)+dsx;
346 term := x0+temp div dy2;
347 rem := temp mod dy2;
348 if (rem = 0) then Dec(term);
349 end;
351 if (term > wx1) then term := wx1; // clip at right
353 Inc(term); // draw last point
354 //if (term = xd) then exit; // this is the only point, get out of here
355 *)
357 if (sty = -1) then yd := -yd;
358 if (stx = -1) then begin xd := -xd; {!term := -term;} end;
359 //!dx2 -= dy2;
361 inx := d0^;
362 iny := d1^;
363 result := true;
364 end;
367 // ////////////////////////////////////////////////////////////////////////// //
368 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
369 begin
370 mX := aX;
371 mY := aY;
372 mWidth := aWidth;
373 mHeight := aHeight;
374 mQueryMark := 0;
375 mObj := aObj;
376 mTag := aTag;
377 nextLink := -1;
378 end;
381 // ////////////////////////////////////////////////////////////////////////// //
382 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
383 var
384 idx: Integer;
385 begin
386 dbgShowTraceLog := false;
387 {$IF DEFINED(D2F_DEBUG)}
388 dbgRayTraceTileHitCB := nil;
389 {$ENDIF}
391 if aTileSize < 1 then aTileSize := 1;
392 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
393 mTileSize := aTileSize;
395 if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
396 if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
397 mMinX := aMinPixX;
398 mMinY := aMinPixY;
399 mWidth := (aPixWidth+mTileSize-1) div mTileSize;
400 mHeight := (aPixHeight+mTileSize-1) div mTileSize;
401 SetLength(mGrid, mWidth*mHeight);
402 SetLength(mCells, mWidth*mHeight);
403 SetLength(mProxies, 8192);
404 mFreeCell := 0;
405 // init free list
406 for idx := 0 to High(mCells) do
407 begin
408 mCells[idx].bodies[0] := -1;
409 mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
410 mCells[idx].next := idx+1;
411 end;
412 mCells[High(mCells)].next := -1; // last cell
413 // init grid
414 for idx := 0 to High(mGrid) do mGrid[idx] := -1;
415 // init proxies
416 for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
417 mProxies[High(mProxies)].nextLink := -1;
418 mLastQuery := 0;
419 mUsedCells := 0;
420 mProxyFree := 0;
421 mProxyCount := 0;
422 mProxyMaxCount := 0;
423 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
424 end;
427 destructor TBodyGridBase.Destroy ();
428 begin
429 mCells := nil;
430 mGrid := nil;
431 mProxies := nil;
432 inherited;
433 end;
436 // ////////////////////////////////////////////////////////////////////////// //
437 procedure TBodyGridBase.dumpStats ();
438 var
439 idx, mcb, cidx, cnt: Integer;
440 begin
441 mcb := 0;
442 for idx := 0 to High(mGrid) do
443 begin
444 cidx := mGrid[idx];
445 cnt := 0;
446 while cidx >= 0 do
447 begin
448 Inc(cnt);
449 cidx := mCells[cidx].next;
450 end;
451 if (mcb < cnt) then mcb := cnt;
452 end;
453 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);
454 end;
457 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
458 var
459 g, f, cidx: Integer;
460 cc: PGridCell;
461 begin
462 if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
463 for g := 0 to High(mGrid) do
464 begin
465 cidx := mGrid[g];
466 while (cidx <> -1) do
467 begin
468 cc := @mCells[cidx];
469 for f := 0 to GridCellBucketSize-1 do
470 begin
471 if (cc.bodies[f] = -1) then break;
472 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
473 end;
474 // next cell
475 cidx := cc.next;
476 end;
477 end;
478 end;
481 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
482 var
483 f, cidx: Integer;
484 cc: PGridCell;
485 begin
486 result := Default(ITP);
487 if not assigned(cb) then exit;
488 Dec(x, mMinX);
489 Dec(y, mMinY);
490 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
491 cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
492 while (cidx <> -1) do
493 begin
494 cc := @mCells[cidx];
495 for f := 0 to GridCellBucketSize-1 do
496 begin
497 if (cc.bodies[f] = -1) then break;
498 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
499 end;
500 // next cell
501 cidx := cc.next;
502 end;
503 end;
506 // ////////////////////////////////////////////////////////////////////////// //
507 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
508 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
511 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
512 begin
513 // fix coords
514 Dec(x, mMinX);
515 Dec(y, mMinY);
516 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
517 end;
520 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
521 begin
522 if (body >= 0) and (body < Length(mProxies)) then
523 begin
524 with mProxies[body] do begin rx := mX; ry := mY; end;
525 result := true;
526 end
527 else
528 begin
529 rx := 0;
530 ry := 0;
531 result := false;
532 end;
533 end;
536 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
537 begin
538 if (body >= 0) and (body < Length(mProxies)) then
539 begin
540 with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
541 result := true;
542 end
543 else
544 begin
545 rw := 0;
546 rh := 0;
547 result := false;
548 end;
549 end;
552 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
553 begin
554 if (body >= 0) and (body < Length(mProxies)) then
555 begin
556 with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
557 result := true;
558 end
559 else
560 begin
561 rx := 0;
562 ry := 0;
563 rw := 0;
564 rh := 0;
565 result := false;
566 end;
567 end;
571 // ////////////////////////////////////////////////////////////////////////// //
572 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
573 begin
574 if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
575 end;
578 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
579 begin
580 if (pid >= 0) then
581 begin
582 if val then
583 begin
584 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
585 end
586 else
587 begin
588 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
589 end;
590 end;
591 end;
594 // ////////////////////////////////////////////////////////////////////////// //
595 function TBodyGridBase.allocCell (): Integer;
596 var
597 idx: Integer;
598 pc: PGridCell;
599 begin
600 if (mFreeCell < 0) then
601 begin
602 // no free cells, want more
603 mFreeCell := Length(mCells);
604 SetLength(mCells, mFreeCell+32768); // arbitrary number
605 for idx := mFreeCell to High(mCells) do
606 begin
607 mCells[idx].bodies[0] := -1;
608 mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
609 mCells[idx].next := idx+1;
610 end;
611 mCells[High(mCells)].next := -1; // last cell
612 end;
613 result := mFreeCell;
614 pc := @mCells[result];
615 mFreeCell := pc.next;
616 pc.next := -1;
617 Inc(mUsedCells);
618 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
619 end;
622 procedure TBodyGridBase.freeCell (idx: Integer);
623 begin
624 if (idx >= 0) and (idx < Length(mCells)) then
625 begin
626 with mCells[idx] do
627 begin
628 bodies[0] := -1;
629 bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
630 next := mFreeCell;
631 end;
632 mFreeCell := idx;
633 Dec(mUsedCells);
634 end;
635 end;
638 // ////////////////////////////////////////////////////////////////////////// //
639 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
640 var
641 olen, idx: Integer;
642 px: PBodyProxyRec;
643 begin
644 if (mProxyFree = -1) then
645 begin
646 // no free proxies, resize list
647 olen := Length(mProxies);
648 SetLength(mProxies, olen+8192); // arbitrary number
649 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
650 mProxies[High(mProxies)].nextLink := -1;
651 mProxyFree := olen;
652 end;
653 // get one from list
654 result := mProxyFree;
655 px := @mProxies[result];
656 mProxyFree := px.nextLink;
657 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
658 // add to used list
659 px.nextLink := -1;
660 // statistics
661 Inc(mProxyCount);
662 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
663 end;
665 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
666 begin
667 if (body < 0) or (body > High(mProxies)) then exit; // just in case
668 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
669 // add to free list
670 mProxies[body].mObj := nil;
671 mProxies[body].nextLink := mProxyFree;
672 mProxyFree := body;
673 Dec(mProxyCount);
674 end;
677 // ////////////////////////////////////////////////////////////////////////// //
678 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
679 const
680 tsize = mTileSize;
681 var
682 gx, gy: Integer;
683 gw, gh: Integer;
684 begin
685 result := false;
686 if (w < 1) or (h < 1) or not assigned(cb) then exit;
687 // fix coords
688 Dec(x, mMinX);
689 Dec(y, mMinY);
690 // go on
691 if (x+w <= 0) or (y+h <= 0) then exit;
692 gw := mWidth;
693 gh := mHeight;
694 //tsize := mTileSize;
695 if (x >= gw*tsize) or (y >= gh*tsize) then exit;
696 for gy := y div tsize to (y+h-1) div tsize do
697 begin
698 if (gy < 0) then continue;
699 if (gy >= gh) then break;
700 for gx := x div tsize to (x+w-1) div tsize do
701 begin
702 if (gx < 0) then continue;
703 if (gx >= gw) then break;
704 result := cb(gy*gw+gx, bodyId);
705 if result then exit;
706 end;
707 end;
708 end;
711 // ////////////////////////////////////////////////////////////////////////// //
712 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
713 var
714 cidx: Integer;
715 pc: Integer;
716 pi: PGridCell;
717 f: Integer;
718 begin
719 result := false; // never stop
720 // add body to the given grid cell
721 pc := mGrid[grida];
722 if (pc <> -1) then
723 begin
724 {$IF DEFINED(D2F_DEBUG)}
725 cidx := pc;
726 while (cidx <> -1) do
727 begin
728 pi := @mCells[cidx];
729 for f := 0 to GridCellBucketSize-1 do
730 begin
731 if (pi.bodies[f] = -1) then break;
732 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
733 end;
734 cidx := pi.next;
735 end;
736 {$ENDIF}
737 cidx := pc;
738 while (cidx <> -1) do
739 begin
740 pi := @mCells[cidx];
741 // check "has room" flag
742 if (pi.bodies[GridCellBucketSize-1] = -1) then
743 begin
744 // can add here
745 for f := 0 to GridCellBucketSize-1 do
746 begin
747 if (pi.bodies[f] = -1) then
748 begin
749 pi.bodies[f] := bodyId;
750 if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
751 exit;
752 end;
753 end;
754 raise Exception.Create('internal error in grid inserter');
755 end;
756 // no room, go to next cell in list (if there is any)
757 cidx := pi.next;
758 end;
759 // no room in cells, add new cell to list
760 end;
761 // either no room, or no cell at all
762 cidx := allocCell();
763 pi := @mCells[cidx];
764 pi.bodies[0] := bodyId;
765 pi.bodies[1] := -1;
766 pi.next := pc;
767 mGrid[grida] := cidx;
768 end;
770 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
771 var
772 px: PBodyProxyRec;
773 begin
774 if (body < 0) or (body > High(mProxies)) then exit; // just in case
775 px := @mProxies[body];
776 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
777 end;
780 // assume that we cannot have one object added to bucket twice
781 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
782 var
783 f, c: Integer;
784 pidx, cidx: Integer;
785 pc: PGridCell;
786 begin
787 result := false; // never stop
788 // find and remove cell
789 pidx := -1; // previous cell index
790 cidx := mGrid[grida]; // current cell index
791 while (cidx <> -1) do
792 begin
793 pc := @mCells[cidx];
794 for f := 0 to GridCellBucketSize-1 do
795 begin
796 if (pc.bodies[f] = bodyId) then
797 begin
798 // i found her!
799 if (f = 0) and (pc.bodies[1] = -1) then
800 begin
801 // this cell contains no elements, remove it
802 if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
803 freeCell(cidx);
804 exit;
805 end;
806 // remove element from bucket
807 for c := f to GridCellBucketSize-2 do
808 begin
809 pc.bodies[c] := pc.bodies[c+1];
810 if (pc.bodies[c] = -1) then break;
811 end;
812 pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
813 exit;
814 end;
815 end;
816 pidx := cidx;
817 cidx := pc.next;
818 end;
819 end;
821 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
822 var
823 px: PBodyProxyRec;
824 begin
825 if (body < 0) or (body > High(mProxies)) then exit; // just in case
826 px := @mProxies[body];
827 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
828 end;
831 // ////////////////////////////////////////////////////////////////////////// //
832 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
833 begin
834 aTag := aTag and TagFullMask;
835 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
836 insertInternal(result);
837 end;
840 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
841 begin
842 if (body < 0) or (body > High(mProxies)) then exit; // just in case
843 removeInternal(body);
844 freeProxy(body);
845 end;
848 // ////////////////////////////////////////////////////////////////////////// //
849 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
850 var
851 px: PBodyProxyRec;
852 x0, y0, w, h: Integer;
853 begin
854 if (body < 0) or (body > High(mProxies)) then exit; // just in case
855 px := @mProxies[body];
856 x0 := px.mX;
857 y0 := px.mY;
858 w := px.mWidth;
859 h := px.mHeight;
860 {$IF DEFINED(D2F_DEBUG_MOVER)}
861 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);
862 {$ENDIF}
863 if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
864 // map -> grid
865 Dec(x0, mMinX);
866 Dec(y0, mMinY);
867 Dec(nx, mMinX);
868 Dec(ny, mMinY);
869 // did any corner crossed tile boundary?
870 if (x0 div mTileSize <> nx div mTileSize) or
871 (y0 div mTileSize <> ny div mTileSize) or
872 ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
873 ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
874 begin
875 removeInternal(body);
876 px.mX := nx+mMinX;
877 px.mY := ny+mMinY;
878 px.mWidth := nw;
879 px.mHeight := nh;
880 insertInternal(body);
881 end
882 else
883 begin
884 px.mX := nx+mMinX;
885 px.mY := ny+mMinY;
886 px.mWidth := nw;
887 px.mHeight := nh;
888 end;
889 end;
891 //TODO: optimize for horizontal/vertical moves
892 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
893 var
894 px: PBodyProxyRec;
895 x0, y0: Integer;
896 ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
897 ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
898 gx, gy: Integer;
899 gw, gh: Integer;
900 pw, ph: Integer;
901 begin
902 if (body < 0) or (body > High(mProxies)) then exit; // just in case
903 // check if tile coords was changed
904 px := @mProxies[body];
905 x0 := px.mX;
906 y0 := px.mY;
907 if (nx = x0) and (ny = y0) then exit;
908 // map -> grid
909 Dec(x0, mMinX);
910 Dec(y0, mMinY);
911 Dec(nx, mMinX);
912 Dec(ny, mMinY);
913 // check for heavy work
914 pw := px.mWidth;
915 ph := px.mHeight;
916 ogx0 := x0 div mTileSize;
917 ogy0 := y0 div mTileSize;
918 ngx0 := nx div mTileSize;
919 ngy0 := ny div mTileSize;
920 ogx1 := (x0+pw-1) div mTileSize;
921 ogy1 := (y0+ph-1) div mTileSize;
922 ngx1 := (nx+pw-1) div mTileSize;
923 ngy1 := (ny+ph-1) div mTileSize;
924 {$IF DEFINED(D2F_DEBUG_MOVER)}
925 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);
926 {$ENDIF}
927 if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
928 begin
929 // crossed tile boundary, do heavy work
930 gw := mWidth;
931 gh := mHeight;
932 // cycle with old rect, remove body where it is necessary
933 // optimized for horizontal moves
934 {$IF DEFINED(D2F_DEBUG_MOVER)}
935 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);
936 {$ENDIF}
937 // remove stale marks
938 if not ((ogy0 >= gh) or (ogy1 < 0)) and
939 not ((ogx0 >= gw) or (ogx1 < 0)) then
940 begin
941 if (ogx0 < 0) then ogx0 := 0;
942 if (ogy0 < 0) then ogy0 := 0;
943 if (ogx1 > gw-1) then ogx1 := gw-1;
944 if (ogy1 > gh-1) then ogy1 := gh-1;
945 {$IF DEFINED(D2F_DEBUG_MOVER)}
946 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
947 {$ENDIF}
948 for gx := ogx0 to ogx1 do
949 begin
950 if (gx < ngx0) or (gx > ngx1) then
951 begin
952 // this column is completely outside of new rect
953 for gy := ogy0 to ogy1 do
954 begin
955 {$IF DEFINED(D2F_DEBUG_MOVER)}
956 e_WriteLog(Format(' remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
957 {$ENDIF}
958 remover(gy*gw+gx, body);
959 end;
960 end
961 else
962 begin
963 // heavy checks
964 for gy := ogy0 to ogy1 do
965 begin
966 if (gy < ngy0) or (gy > ngy1) then
967 begin
968 {$IF DEFINED(D2F_DEBUG_MOVER)}
969 e_WriteLog(Format(' remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
970 {$ENDIF}
971 remover(gy*gw+gx, body);
972 end;
973 end;
974 end;
975 end;
976 end;
977 // cycle with new rect, add body where it is necessary
978 if not ((ngy0 >= gh) or (ngy1 < 0)) and
979 not ((ngx0 >= gw) or (ngx1 < 0)) then
980 begin
981 if (ngx0 < 0) then ngx0 := 0;
982 if (ngy0 < 0) then ngy0 := 0;
983 if (ngx1 > gw-1) then ngx1 := gw-1;
984 if (ngy1 > gh-1) then ngy1 := gh-1;
985 {$IF DEFINED(D2F_DEBUG_MOVER)}
986 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
987 {$ENDIF}
988 for gx := ngx0 to ngx1 do
989 begin
990 if (gx < ogx0) or (gx > ogx1) then
991 begin
992 // this column is completely outside of old rect
993 for gy := ngy0 to ngy1 do
994 begin
995 {$IF DEFINED(D2F_DEBUG_MOVER)}
996 e_WriteLog(Format(' insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
997 {$ENDIF}
998 inserter(gy*gw+gx, body);
999 end;
1000 end
1001 else
1002 begin
1003 // heavy checks
1004 for gy := ngy0 to ngy1 do
1005 begin
1006 if (gy < ogy0) or (gy > ogy1) then
1007 begin
1008 {$IF DEFINED(D2F_DEBUG_MOVER)}
1009 e_WriteLog(Format(' insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1010 {$ENDIF}
1011 inserter(gy*gw+gx, body);
1012 end;
1013 end;
1014 end;
1015 end;
1016 end;
1017 // done
1018 end
1019 else
1020 begin
1021 {$IF DEFINED(D2F_DEBUG_MOVER)}
1022 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);
1023 {$ENDIF}
1024 end;
1025 // update coordinates
1026 px.mX := nx+mMinX;
1027 px.mY := ny+mMinY;
1028 end;
1030 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1031 var
1032 px: PBodyProxyRec;
1033 x0, y0, w, h: Integer;
1034 begin
1035 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1036 // check if tile coords was changed
1037 px := @mProxies[body];
1038 x0 := px.mX-mMinX;
1039 y0 := px.mY-mMinY;
1040 w := px.mWidth;
1041 h := px.mHeight;
1042 {$IF DEFINED(D2F_DEBUG_MOVER)}
1043 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);
1044 {$ENDIF}
1045 if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1046 ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1047 begin
1048 // crossed tile boundary, do heavy work
1049 removeInternal(body);
1050 px.mWidth := nw;
1051 px.mHeight := nh;
1052 insertInternal(body);
1053 end
1054 else
1055 begin
1056 // nothing to do with the grid, just fix size
1057 px.mWidth := nw;
1058 px.mHeight := nh;
1059 end;
1060 end;
1063 // ////////////////////////////////////////////////////////////////////////// //
1064 // no callback: return `true` on the first hit
1065 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1066 var
1067 f: Integer;
1068 idx, curci: Integer;
1069 cc: PGridCell = nil;
1070 px: PBodyProxyRec;
1071 lq: LongWord;
1072 ptag: Integer;
1073 begin
1074 result := Default(ITP);
1075 if (exittag <> nil) then exittag^ := 0;
1076 tagmask := tagmask and TagFullMask;
1077 if (tagmask = 0) then exit;
1079 {$IF DEFINED(D2F_DEBUG_XXQ)}
1080 if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1081 {$ENDIF}
1083 // make coords (0,0)-based
1084 Dec(x, mMinX);
1085 Dec(y, mMinY);
1086 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1088 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1090 {$IF DEFINED(D2F_DEBUG_XXQ)}
1091 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);
1092 {$ENDIF}
1094 // restore coords
1095 Inc(x, mMinX);
1096 Inc(y, mMinY);
1098 // increase query counter
1099 Inc(mLastQuery);
1100 if (mLastQuery = 0) then
1101 begin
1102 // just in case of overflow
1103 mLastQuery := 1;
1104 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1105 end;
1106 lq := mLastQuery;
1108 {$IF DEFINED(D2F_DEBUG_XXQ)}
1109 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1110 {$ENDIF}
1112 while (curci <> -1) do
1113 begin
1114 {$IF DEFINED(D2F_DEBUG_XXQ)}
1115 if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1116 {$ENDIF}
1117 cc := @mCells[curci];
1118 for f := 0 to GridCellBucketSize-1 do
1119 begin
1120 if (cc.bodies[f] = -1) then break;
1121 px := @mProxies[cc.bodies[f]];
1122 {$IF DEFINED(D2F_DEBUG_XXQ)}
1123 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);
1124 {$ENDIF}
1125 // shit. has to do it this way, so i can change tag in callback
1126 if (px.mQueryMark <> lq) then
1127 begin
1128 px.mQueryMark := lq;
1129 ptag := px.mTag;
1130 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1131 (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1132 begin
1133 if assigned(cb) then
1134 begin
1135 if cb(px.mObj, ptag) then
1136 begin
1137 result := px.mObj;
1138 if (exittag <> nil) then exittag^ := ptag;
1139 exit;
1140 end;
1141 end
1142 else
1143 begin
1144 result := px.mObj;
1145 if (exittag <> nil) then exittag^ := ptag;
1146 exit;
1147 end;
1148 end;
1149 end;
1150 end;
1151 curci := cc.next;
1152 end;
1153 end;
1156 // ////////////////////////////////////////////////////////////////////////// //
1157 // no callback: return `true` on the first hit
1158 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1159 const
1160 tsize = mTileSize;
1161 var
1162 idx: Integer;
1163 gx, gy: Integer;
1164 curci: Integer;
1165 f: Integer;
1166 cc: PGridCell = nil;
1167 px: PBodyProxyRec;
1168 lq: LongWord;
1169 gw: Integer;
1170 x0, y0: Integer;
1171 ptag: Integer;
1172 begin
1173 result := Default(ITP);
1174 if (w < 1) or (h < 1) then exit;
1175 tagmask := tagmask and TagFullMask;
1176 if (tagmask = 0) then exit;
1178 x0 := x;
1179 y0 := y;
1181 // fix coords
1182 Dec(x, mMinX);
1183 Dec(y, mMinY);
1185 gw := mWidth;
1186 //tsize := mTileSize;
1188 if (x+w <= 0) or (y+h <= 0) then exit;
1189 if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
1191 // increase query counter
1192 Inc(mLastQuery);
1193 if (mLastQuery = 0) then
1194 begin
1195 // just in case of overflow
1196 mLastQuery := 1;
1197 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1198 end;
1199 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1200 lq := mLastQuery;
1202 // go on
1203 for gy := y div tsize to (y+h-1) div tsize do
1204 begin
1205 if (gy < 0) then continue;
1206 if (gy >= mHeight) then break;
1207 for gx := x div tsize to (x+w-1) div tsize do
1208 begin
1209 if (gx < 0) then continue;
1210 if (gx >= gw) then break;
1211 // process cells
1212 curci := mGrid[gy*gw+gx];
1213 while (curci <> -1) do
1214 begin
1215 cc := @mCells[curci];
1216 for f := 0 to GridCellBucketSize-1 do
1217 begin
1218 if (cc.bodies[f] = -1) then break;
1219 px := @mProxies[cc.bodies[f]];
1220 // shit. has to do it this way, so i can change tag in callback
1221 if (px.mQueryMark = lq) then continue;
1222 px.mQueryMark := lq;
1223 ptag := px.mTag;
1224 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1225 if ((ptag and tagmask) = 0) then continue;
1226 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1227 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1228 if assigned(cb) then
1229 begin
1230 if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1231 end
1232 else
1233 begin
1234 result := px.mObj;
1235 exit;
1236 end;
1237 end;
1238 curci := cc.next;
1239 end;
1240 end;
1241 end;
1242 end;
1245 // ////////////////////////////////////////////////////////////////////////// //
1246 // no callback: return `true` on the nearest hit
1247 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1248 var
1249 ex, ey: Integer;
1250 begin
1251 result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1252 end;
1255 // no callback: return `true` on the nearest hit
1256 // you are not supposed to understand this
1257 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1258 const
1259 tsize = mTileSize;
1260 var
1261 wx0, wy0, wx1, wy1: Integer; // window coordinates
1262 stx, sty: Integer; // "steps" for x and y axes
1263 dsx, dsy: Integer; // "lengthes" for x and y axes
1264 dx2, dy2: Integer; // "double lengthes" for x and y axes
1265 xd, yd: Integer; // current coord
1266 e: Integer; // "error" (as in bresenham algo)
1267 rem: Integer;
1268 term: Integer;
1269 xptr, yptr: PInteger;
1270 xfixed: Boolean;
1271 temp: Integer;
1272 prevx, prevy: Integer;
1273 lastDistSq: Integer;
1274 ccidx, curci: Integer;
1275 hasUntried: Boolean;
1276 lastGA: Integer = -1;
1277 ga, x, y: Integer;
1278 lastObj: ITP;
1279 wasHit: Boolean = false;
1280 gw, gh, minx, miny, maxx, maxy: Integer;
1281 cc: PGridCell;
1282 px: PBodyProxyRec;
1283 lq: LongWord;
1284 f, ptag, distSq: Integer;
1285 x0, y0, x1, y1: Integer;
1286 // horizontal walker
1287 wklen, wkstep: Integer;
1288 hopt: Boolean;
1289 begin
1290 result := Default(ITP);
1291 lastObj := Default(ITP);
1292 tagmask := tagmask and TagFullMask;
1293 ex := ax1; // why not?
1294 ey := ay1; // why not?
1295 if (tagmask = 0) then exit;
1297 if (ax0 = ax1) and (ay0 = ay1) then
1298 begin
1299 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1300 if (result <> nil) then
1301 begin
1302 if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
1303 end;
1304 exit;
1305 end;
1307 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1309 gw := mWidth;
1310 gh := mHeight;
1311 minx := mMinX;
1312 miny := mMinY;
1313 maxx := gw*tsize-1;
1314 maxy := gh*tsize-1;
1316 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1317 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);
1318 {$ENDIF}
1320 x0 := ax0;
1321 y0 := ay0;
1322 x1 := ax1;
1323 y1 := ay1;
1325 // offset query coords to (0,0)-based
1326 Dec(x0, minx);
1327 Dec(y0, miny);
1328 Dec(x1, minx);
1329 Dec(y1, miny);
1331 // clip rectange
1332 wx0 := 0;
1333 wy0 := 0;
1334 wx1 := maxx;
1335 wy1 := maxy;
1337 // horizontal setup
1338 if (x0 < x1) then
1339 begin
1340 // from left to right
1341 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1342 stx := 1; // going right
1343 end
1344 else
1345 begin
1346 // from right to left
1347 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1348 stx := -1; // going left
1349 x0 := -x0;
1350 x1 := -x1;
1351 wx0 := -wx0;
1352 wx1 := -wx1;
1353 swapInt(wx0, wx1);
1354 end;
1356 // vertical setup
1357 if (y0 < y1) then
1358 begin
1359 // from top to bottom
1360 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1361 sty := 1; // going down
1362 end
1363 else
1364 begin
1365 // from bottom to top
1366 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1367 sty := -1; // going up
1368 y0 := -y0;
1369 y1 := -y1;
1370 wy0 := -wy0;
1371 wy1 := -wy1;
1372 swapInt(wy0, wy1);
1373 end;
1375 dsx := x1-x0;
1376 dsy := y1-y0;
1378 if (dsx < dsy) then
1379 begin
1380 xptr := @yd;
1381 yptr := @xd;
1382 swapInt(x0, y0);
1383 swapInt(x1, y1);
1384 swapInt(dsx, dsy);
1385 swapInt(wx0, wy0);
1386 swapInt(wx1, wy1);
1387 swapInt(stx, sty);
1388 end
1389 else
1390 begin
1391 xptr := @xd;
1392 yptr := @yd;
1393 end;
1395 dx2 := 2*dsx;
1396 dy2 := 2*dsy;
1397 xd := x0;
1398 yd := y0;
1399 e := 2*dsy-dsx;
1400 term := x1;
1402 xfixed := false;
1403 if (y0 < wy0) then
1404 begin
1405 // clip at top
1406 temp := dx2*(wy0-y0)-dsx;
1407 xd += temp div dy2;
1408 rem := temp mod dy2;
1409 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1410 if (xd+1 >= wx0) then
1411 begin
1412 yd := wy0;
1413 e -= rem+dsx;
1414 if (rem > 0) then begin Inc(xd); e += dy2; end;
1415 xfixed := true;
1416 end;
1417 end;
1419 if (not xfixed) and (x0 < wx0) then
1420 begin
1421 // clip at left
1422 temp := dy2*(wx0-x0);
1423 yd += temp div dx2;
1424 rem := temp mod dx2;
1425 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1426 xd := wx0;
1427 e += rem;
1428 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1429 end;
1431 if (y1 > wy1) then
1432 begin
1433 // clip at bottom
1434 temp := dx2*(wy1-y0)+dsx;
1435 term := x0+temp div dy2;
1436 rem := temp mod dy2;
1437 if (rem = 0) then Dec(term);
1438 end;
1440 if (term > wx1) then term := wx1; // clip at right
1442 Inc(term); // draw last point
1443 //if (term = xd) then exit; // this is the only point, get out of here
1445 if (sty = -1) then yd := -yd;
1446 if (stx = -1) then begin xd := -xd; term := -term; end;
1447 dx2 -= dy2;
1449 // first move, to skip starting point
1450 // DON'T DO THIS! loop will take care of that
1451 if (xd = term) then
1452 begin
1453 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
1454 if (result <> nil) then
1455 begin
1456 if assigned(cb) then
1457 begin
1458 if cb(result, ptag, ax0, ay0, ax0, ay0) then
1459 begin
1460 ex := ax0;
1461 ey := ay0;
1462 end
1463 else
1464 begin
1465 result := nil;
1466 end;
1467 end
1468 else
1469 begin
1470 ex := ax0;
1471 ey := ay0;
1472 end;
1473 end;
1474 exit;
1475 end;
1477 prevx := xptr^+minx;
1478 prevy := yptr^+miny;
1479 (*
1480 // move coords
1481 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1482 xd += stx;
1483 // done?
1484 if (xd = term) then exit;
1485 *)
1487 {$IF DEFINED(D2F_DEBUG)}
1488 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1489 {$ENDIF}
1490 // DON'T DO THIS! loop will take care of that
1491 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1492 //ccidx := mGrid[lastGA];
1494 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1495 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1496 {$ENDIF}
1498 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1500 // increase query counter
1501 Inc(mLastQuery);
1502 if (mLastQuery = 0) then
1503 begin
1504 // just in case of overflow
1505 mLastQuery := 1;
1506 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1507 end;
1508 lq := mLastQuery;
1510 {$IFDEF GRID_USE_ORTHO_ACCEL}
1511 // if this is strict horizontal trace, use optimized codepath
1512 if (ax0 = ax1) or (ay0 = ay1) then
1513 begin
1514 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
1515 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
1516 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
1517 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
1518 hopt := (ay0 = ay1); // horizontal?
1519 if (stx < 0) then wklen := -(term-xd) else wklen := term-xd;
1520 {$IF DEFINED(D2F_DEBUG)}
1521 if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
1522 {$ENDIF}
1523 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1524 // one of those will never change
1525 x := xptr^+minx;
1526 y := yptr^+miny;
1527 {$IF DEFINED(D2F_DEBUG)}
1528 if hopt then
1529 begin
1530 if (y <> ay0) then raise Exception.Create('htrace fatal internal error');
1531 end
1532 else
1533 begin
1534 if (x <> ax0) then raise Exception.Create('vtrace fatal internal error');
1535 end;
1536 {$ENDIF}
1537 while (wklen > 0) do
1538 begin
1539 {$IF DEFINED(D2F_DEBUG)}
1540 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1541 {$ENDIF}
1542 // new tile?
1543 if (ga <> lastGA) then
1544 begin
1545 lastGA := ga;
1546 ccidx := mGrid[lastGA];
1547 // convert coords to map (to avoid ajdusting coords inside the loop)
1548 if hopt then x := xptr^+minx else y := yptr^+miny;
1549 while (ccidx <> -1) do
1550 begin
1551 cc := @mCells[ccidx];
1552 for f := 0 to GridCellBucketSize-1 do
1553 begin
1554 if (cc.bodies[f] = -1) then break;
1555 px := @mProxies[cc.bodies[f]];
1556 ptag := px.mTag;
1557 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
1558 // constant coord should be inside
1559 ((hopt and (y >= px.mY) and (y < px.mY+px.mHeight)) or
1560 ((not hopt) and (x >= px.mX) and (x < px.mX+px.mWidth))) then
1561 begin
1562 px.mQueryMark := lq; // mark as processed
1563 // inside the proxy?
1564 if (hopt and (x > px.mX) and (x < px.mX+px.mWidth-1)) or
1565 ((not hopt) and (y > px.mY) and (y < px.mY+px.mHeight-1)) then
1566 begin
1567 if assigned(cb) then
1568 begin
1569 if cb(px.mObj, ptag, x, y, x, y) then
1570 begin
1571 result := lastObj;
1572 ex := prevx;
1573 ey := prevy;
1574 exit;
1575 end;
1576 x := xptr^+minx;
1577 end
1578 else
1579 begin
1580 distSq := distanceSq(ax0, ay0, x, y);
1581 {$IF DEFINED(D2F_DEBUG)}
1582 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]);
1583 {$ENDIF}
1584 if (distSq < lastDistSq) then
1585 begin
1586 ex := x;
1587 ey := y;
1588 result := px.mObj;
1589 exit;
1590 end;
1591 end;
1592 continue;
1593 end;
1594 // remember this hitpoint if it is nearer than an old one
1595 if hopt then
1596 begin
1597 prevy := y;
1598 if (stx < 0) then
1599 begin
1600 // going left
1601 if (x < px.mX) then continue;
1602 prevx := px.mX+px.mWidth;
1603 end
1604 else
1605 begin
1606 // going right
1607 if (x > px.mX{+px.mWidth}) then continue;
1608 prevx := px.mX-1;
1609 end;
1610 end
1611 else
1612 begin
1613 prevx := x;
1614 if (stx < 0) then
1615 begin
1616 // going up
1617 if (y < px.mY) then continue;
1618 prevy := px.mY+px.mHeight;
1619 end
1620 else
1621 begin
1622 // going down
1623 if (y > px.mY{+px.mHeight}) then continue;
1624 prevy := px.mY-1;
1625 end;
1626 end;
1627 if assigned(cb) then
1628 begin
1629 if (stx < 0) then
1630 begin
1631 if hopt then x := prevx-1 else y := prevy-1;
1632 end
1633 else
1634 begin
1635 if hopt then x := prevx+1 else y := prevy+1;
1636 end;
1637 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1638 begin
1639 result := lastObj;
1640 ex := prevx;
1641 ey := prevy;
1642 exit;
1643 end;
1644 x := xptr^+minx;
1645 y := yptr^+miny;
1646 end
1647 else
1648 begin
1649 distSq := distanceSq(ax0, ay0, prevx, prevy);
1650 {$IF DEFINED(D2F_DEBUG)}
1651 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]);
1652 {$ENDIF}
1653 if (distSq < lastDistSq) then
1654 begin
1655 wasHit := true;
1656 lastDistSq := distSq;
1657 ex := prevx;
1658 ey := prevy;
1659 lastObj := px.mObj;
1660 end;
1661 end;
1662 end;
1663 end;
1664 // next cell
1665 ccidx := cc.next;
1666 end;
1667 if wasHit and not assigned(cb) then begin result := lastObj; exit; end;
1668 end;
1669 // skip to next tile
1670 if hopt then
1671 begin
1672 if (stx > 0) then
1673 begin
1674 // to the right
1675 wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
1676 {$IF DEFINED(D2F_DEBUG)}
1677 if dbgShowTraceLog then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1678 {$ENDIF}
1679 if (wkstep >= wklen) then break;
1680 Inc(xptr^, wkstep);
1681 Inc(ga);
1682 end
1683 else
1684 begin
1685 // to the left
1686 wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
1687 {$IF DEFINED(D2F_DEBUG)}
1688 if dbgShowTraceLog then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1689 {$ENDIF}
1690 if (wkstep >= wklen) then break;
1691 Dec(xptr^, wkstep);
1692 Dec(ga);
1693 end;
1694 end
1695 else
1696 begin
1697 if (stx > 0) then
1698 begin
1699 // to the down
1700 wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
1701 {$IF DEFINED(D2F_DEBUG)}
1702 if dbgShowTraceLog then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1703 {$ENDIF}
1704 if (wkstep >= wklen) then break;
1705 Inc(yptr^, wkstep);
1706 Inc(ga, mHeight);
1707 end
1708 else
1709 begin
1710 // to the up
1711 wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
1712 {$IF DEFINED(D2F_DEBUG)}
1713 if dbgShowTraceLog then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
1714 {$ENDIF}
1715 if (wkstep >= wklen) then break;
1716 Dec(yptr^, wkstep);
1717 Dec(ga, mHeight);
1718 end;
1719 end;
1720 Dec(wklen, wkstep);
1721 end;
1722 // we can travel less than one cell
1723 if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
1724 exit;
1725 end;
1726 {$ENDIF}
1728 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1729 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1730 {$ENDIF}
1732 ccidx := -1;
1733 // can omit checks
1734 while (xd <> term) do
1735 begin
1736 // check cell(s)
1737 {$IF DEFINED(D2F_DEBUG)}
1738 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1739 {$ENDIF}
1740 // new tile?
1741 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1742 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1743 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);
1744 {$ENDIF}
1745 if (ga <> lastGA) then
1746 begin
1747 // yes
1748 {$IF DEFINED(D2F_DEBUG)}
1749 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1750 {$ENDIF}
1751 if (ccidx <> -1) then
1752 begin
1753 // signal cell completion
1754 if assigned(cb) then
1755 begin
1756 if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; exit; end;
1757 end
1758 else if wasHit then
1759 begin
1760 result := lastObj;
1761 exit;
1762 end;
1763 end;
1764 lastGA := ga;
1765 ccidx := mGrid[lastGA];
1766 end;
1767 // has something to process in this tile?
1768 if (ccidx <> -1) then
1769 begin
1770 // process cell
1771 curci := ccidx;
1772 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1773 // convert coords to map (to avoid ajdusting coords inside the loop)
1774 x := xptr^+minx;
1775 y := yptr^+miny;
1776 // process cell list
1777 while (curci <> -1) do
1778 begin
1779 cc := @mCells[curci];
1780 for f := 0 to GridCellBucketSize-1 do
1781 begin
1782 if (cc.bodies[f] = -1) then break;
1783 px := @mProxies[cc.bodies[f]];
1784 ptag := px.mTag;
1785 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1786 begin
1787 // can we process this proxy?
1788 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1789 begin
1790 px.mQueryMark := lq; // mark as processed
1791 if assigned(cb) then
1792 begin
1793 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1794 begin
1795 result := lastObj;
1796 ex := prevx;
1797 ey := prevy;
1798 exit;
1799 end;
1800 (*
1801 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1802 distSq := distanceSq(ax0, ay0, prevx, prevy);
1803 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);
1804 if (distSq < lastDistSq) then
1805 begin
1806 wasHit := true;
1807 lastDistSq := distSq;
1808 ex := prevx;
1809 ey := prevy;
1810 lastObj := px.mObj;
1811 end;
1812 {$ENDIF}
1813 *)
1814 end
1815 else
1816 begin
1817 // remember this hitpoint if it is nearer than an old one
1818 distSq := distanceSq(ax0, ay0, prevx, prevy);
1819 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1820 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);
1821 {$ENDIF}
1822 if (distSq < lastDistSq) then
1823 begin
1824 wasHit := true;
1825 lastDistSq := distSq;
1826 ex := prevx;
1827 ey := prevy;
1828 lastObj := px.mObj;
1829 end;
1830 end;
1831 end
1832 else
1833 begin
1834 // this is possibly interesting proxy, set "has more to check" flag
1835 hasUntried := true;
1836 end;
1837 end;
1838 end;
1839 // next cell
1840 curci := cc.next;
1841 end;
1842 // still has something interesting in this cell?
1843 if not hasUntried then
1844 begin
1845 // nope, don't process this cell anymore; signal cell completion
1846 ccidx := -1;
1847 if assigned(cb) then
1848 begin
1849 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
1850 end
1851 else if wasHit then
1852 begin
1853 result := lastObj;
1854 exit;
1855 end;
1856 end;
1857 end;
1858 //putPixel(xptr^, yptr^);
1859 // move coords
1860 prevx := xptr^+minx;
1861 prevy := yptr^+miny;
1862 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1863 xd += stx;
1864 end;
1865 // we can travel less than one cell
1866 if wasHit and not assigned(cb) then
1867 begin
1868 result := lastObj;
1869 end
1870 else
1871 begin
1872 ex := ax1; // why not?
1873 ey := ay1; // why not?
1874 end;
1875 end;
1878 // ////////////////////////////////////////////////////////////////////////// //
1879 //FIXME! optimize this with real tile walking
1880 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1881 const
1882 tsize = mTileSize;
1883 var
1884 i: Integer;
1885 dx, dy, d: Integer;
1886 xerr, yerr: Integer;
1887 incx, incy: Integer;
1888 stepx, stepy: Integer;
1889 x, y: Integer;
1890 maxx, maxy: Integer;
1891 gw, gh: Integer;
1892 ccidx: Integer;
1893 curci: Integer;
1894 cc: PGridCell;
1895 px: PBodyProxyRec;
1896 lq: LongWord;
1897 minx, miny: Integer;
1898 ptag: Integer;
1899 lastWasInGrid: Boolean;
1900 tbcross: Boolean;
1901 f: Integer;
1902 //tedist: Integer;
1903 begin
1904 log := false;
1905 result := Default(ITP);
1906 tagmask := tagmask and TagFullMask;
1907 if (tagmask = 0) or not assigned(cb) then exit;
1909 minx := mMinX;
1910 miny := mMinY;
1912 dx := x1-x0;
1913 dy := y1-y0;
1915 if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1916 if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1918 if (incx = 0) and (incy = 0) then exit; // just incase
1920 dx := abs(dx);
1921 dy := abs(dy);
1923 if (dx > dy) then d := dx else d := dy;
1925 // `x` and `y` will be in grid coords
1926 x := x0-minx;
1927 y := y0-miny;
1929 // increase query counter
1930 Inc(mLastQuery);
1931 if (mLastQuery = 0) then
1932 begin
1933 // just in case of overflow
1934 mLastQuery := 1;
1935 for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1936 end;
1937 lq := mLastQuery;
1939 // cache various things
1940 //tsize := mTileSize;
1941 gw := mWidth;
1942 gh := mHeight;
1943 maxx := gw*tsize-1;
1944 maxy := gh*tsize-1;
1946 // setup distance and flags
1947 lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1949 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1950 if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1952 // it is slightly faster this way
1953 xerr := -d;
1954 yerr := -d;
1956 if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1958 // now trace
1959 i := 0;
1960 while (i < d) do
1961 begin
1962 Inc(i);
1963 // do one step
1964 xerr += dx;
1965 yerr += dy;
1966 // invariant: one of those always changed
1967 {$IF DEFINED(D2F_DEBUG)}
1968 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1969 {$ENDIF}
1970 if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1971 if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1972 // invariant: we always doing a step
1973 {$IF DEFINED(D2F_DEBUG)}
1974 if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1975 {$ENDIF}
1976 begin
1977 // check for crossing tile/grid boundary
1978 if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1979 begin
1980 // we're still in grid
1981 lastWasInGrid := true;
1982 // check for tile edge crossing
1983 if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1984 else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1985 else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1986 else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1987 else tbcross := false;
1988 // crossed tile edge?
1989 if tbcross then
1990 begin
1991 // setup new cell index
1992 ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1993 if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1994 end
1995 else
1996 if (ccidx = -1) then
1997 begin
1998 // we have nothing interesting here anymore, jump directly to tile edge
1999 (*
2000 if (incx = 0) then
2001 begin
2002 // vertical line
2003 if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
2004 if (tedist > 1) then
2005 begin
2006 if (log) then e_WriteLog(Format(' doing vertical jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2007 y += incy*tedist;
2008 Inc(i, tedist);
2009 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2010 end;
2011 end
2012 else if (incy = 0) then
2013 begin
2014 // horizontal line
2015 if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
2016 if (tedist > 1) then
2017 begin
2018 if (log) then e_WriteLog(Format(' doing horizontal jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2019 x += incx*tedist;
2020 Inc(i, tedist);
2021 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2022 end;
2023 end;
2024 *)
2025 (*
2026 else if (
2027 // get minimal distance to tile edges
2028 if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
2029 {$IF DEFINED(D2F_DEBUG)}
2030 if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
2031 {$ENDIF}
2032 if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
2033 {$IF DEFINED(D2F_DEBUG)}
2034 if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
2035 {$ENDIF}
2036 if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
2037 // do jump
2038 if (tedist > 1) then
2039 begin
2040 if (log) then e_WriteLog(Format(' doing jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2041 xerr += dx*tedist;
2042 yerr += dy*tedist;
2043 if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
2044 if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
2045 Inc(i, tedist);
2046 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
2047 end;
2048 *)
2049 end;
2050 end
2051 else
2052 begin
2053 // out of grid
2054 if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
2055 end;
2056 end;
2058 // has something to process in the current cell?
2059 if (ccidx <> -1) then
2060 begin
2061 // process cell
2062 curci := ccidx;
2063 // convert coords to map (to avoid ajdusting coords inside the loop)
2064 //Inc(x, minx);
2065 //Inc(y, miny);
2066 // process cell list
2067 while (curci <> -1) do
2068 begin
2069 cc := @mCells[curci];
2070 for f := 0 to GridCellBucketSize-1 do
2071 begin
2072 if (cc.bodies[f] = -1) then break;
2073 px := @mProxies[cc.bodies[f]];
2074 ptag := px.mTag;
2075 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2076 begin
2077 px.mQueryMark := lq; // mark as processed
2078 if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
2079 end;
2080 end;
2081 // next cell
2082 curci := cc.next;
2083 end;
2084 ccidx := -1; // don't process this anymore
2085 // convert coords to grid
2086 //Dec(x, minx);
2087 //Dec(y, miny);
2088 end;
2089 end;
2090 end;
2093 end.