DEADSOFTWARE

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