DEADSOFTWARE

`forEachAlongLine()` switched to `TLineWalker`
[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
28 const
29 GridTileSize = 32; // must be power of two!
31 type
32 TBodyProxyId = Integer;
34 generic TBodyGridBase<ITP> = class(TObject)
35 public
36 type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
37 type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: 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 GridCellBucketSize = 8; // WARNING! can't be less than 2!
47 public
48 type
49 PBodyProxyRec = ^TBodyProxyRec;
50 TBodyProxyRec = record
51 private
52 mX, mY, mWidth, mHeight: Integer; // aabb
53 mQueryMark: LongWord; // was this object visited at this query?
54 mObj: ITP;
55 mTag: Integer; // `TagDisabled` set: disabled ;-)
56 nextLink: TBodyProxyId; // next free or nothing
58 private
59 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
61 function getTag (): Integer; inline;
62 procedure setTag (v: Integer); inline;
64 function getEnabled (): Boolean; inline;
65 procedure setEnabled (v: Boolean); inline;
67 function getX1 (): Integer; inline;
68 function getY1 (): Integer; inline;
70 public
71 property x: Integer read mX;
72 property y: Integer read mY;
73 property width: Integer read mWidth;
74 property height: Integer read mHeight;
75 property tag: Integer read getTag write setTag;
76 property enabled: Boolean read getEnabled write setEnabled;
77 property obj: ITP read mObj;
79 property x0: Integer read mX;
80 property y0: Integer read mY;
81 property x1: Integer read getX1;
82 property y1: Integer read getY1;
83 end;
85 private
86 type
87 PGridCell = ^TGridCell;
88 TGridCell = record
89 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
90 next: Integer; // in this cell; index in mCells
91 end;
93 TCellArray = array of TGridCell;
95 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
97 private
98 //mTileSize: Integer;
99 const mTileSize = GridTileSize;
100 type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
102 public
103 const tileSize = mTileSize;
105 type
106 TAtPointEnumerator = record
107 private
108 mCells: TCellArray;
109 curidx, curbki: Integer;
110 getpx: TGetProxyFn;
111 public
112 constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
113 function MoveNext (): Boolean; inline;
114 function getCurrent (): PBodyProxyRec; inline;
115 property Current: PBodyProxyRec read getCurrent;
116 end;
118 private
119 mMinX, mMinY: Integer; // so grids can start at any origin
120 mWidth, mHeight: Integer; // in tiles
121 mGrid: array of Integer; // mWidth*mHeight, index in mCells
122 mCells: TCellArray; // cell pool
123 mFreeCell: Integer; // first free cell index or -1
124 mLastQuery: LongWord;
125 mUsedCells: Integer;
126 mProxies: array of TBodyProxyRec;
127 mProxyFree: TBodyProxyId; // free
128 mProxyCount: Integer; // currently used
129 mProxyMaxCount: Integer;
130 mInQuery: Boolean;
132 public
133 dbgShowTraceLog: Boolean;
134 {$IF DEFINED(D2F_DEBUG)}
135 dbgRayTraceTileHitCB: TCellQueryCB;
136 {$ENDIF}
138 private
139 function allocCell (): Integer;
140 procedure freeCell (idx: Integer); // `next` is simply overwritten
142 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
143 procedure freeProxy (body: TBodyProxyId);
145 procedure insertInternal (body: TBodyProxyId);
146 procedure removeInternal (body: TBodyProxyId);
148 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
150 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
151 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
153 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
154 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
156 function getGridWidthPx (): Integer; inline;
157 function getGridHeightPx (): Integer; inline;
159 function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
161 public
162 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
163 destructor Destroy (); override;
165 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
166 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
168 procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
169 procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
170 procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
172 function insideGrid (x, y: Integer): Boolean; inline;
174 // `false` if `body` is surely invalid
175 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
176 function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
177 function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
179 //WARNING: don't modify grid while any query is in progress (no checks are made!)
180 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
181 // no callback: return `true` on the first hit
182 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
184 //WARNING: don't modify grid while any query is in progress (no checks are made!)
185 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
186 // no callback: return object on the first hit or nil
187 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
189 function atCellInPoint (x, y: Integer): TAtPointEnumerator;
191 //WARNING: don't modify grid while any query is in progress (no checks are made!)
192 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
193 // cb with `(nil)` will be called before processing new tile
194 // no callback: return object of the nearest hit or nil
195 // if `inverted` is true, trace will register bodies *exluding* tagmask
196 //WARNING: don't change tags in callbacks here!
197 function traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
198 function traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
200 //WARNING: don't modify grid while any query is in progress (no checks are made!)
201 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
202 // cb with `(nil)` will be called before processing new tile
203 // no callback: return object of the nearest hit or nil
204 // if `inverted` is true, trace will register bodies *exluding* tagmask
205 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
206 //WARNING: don't change tags in callbacks here!
207 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; overload;
208 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
210 // return `false` if we're still inside at the end
211 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
212 // `true`: endpoint will point at the last "inside" pixel
213 // `false`: endpoint will be (ax1, ay1)
214 //WARNING: don't change tags in callbacks here!
215 function traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
217 //WARNING: don't modify grid while any query is in progress (no checks are made!)
218 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
219 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
220 //WARNING: don't change tags in callbacks here!
221 function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
223 // trace box with the given velocity; return object hit (if any)
224 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
225 //WARNING: don't change tags in callbacks here!
226 function traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
228 // debug
229 procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
230 function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
231 procedure dumpStats ();
233 public
234 //WARNING! no sanity checks!
235 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
237 property gridX0: Integer read mMinX;
238 property gridY0: Integer read mMinY;
239 property gridWidth: Integer read getGridWidthPx; // in pixels
240 property gridHeight: Integer read getGridHeightPx; // in pixels
242 property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
243 end;
246 type
247 // common structure for all line tracers
248 TLineWalker = record
249 public
250 const TileSize = GridTileSize;
252 private
253 wx0, wy0, wx1, wy1: Integer; // window coordinates
254 stx, sty: Integer; // "steps" for x and y axes
255 dx2, dy2: Integer; // "double lengthes" for x and y axes
256 xd, yd: Integer; // current coord
257 e: Integer; // "error" (as in bresenham algo)
258 term: Integer; // end for xd (xd = term: done)
259 //xptr, yptr: PInteger;
260 xyswapped: Boolean; // true: xd is y
262 public
263 // call `setyp` after this
264 constructor Create (minx, miny, maxx, maxy: Integer);
266 procedure setClip (minx, miny, maxx, maxy: Integer); inline;
268 // this will use `w[xy][01]` to clip coords
269 // return `false` if the whole line was clipped away
270 // on `true`, you should process first point, and go on
271 function setup (x0, y0, x1, y1: Integer): Boolean;
273 // call this *after* doing a step
274 // WARNING! if you will do a step when this returns `true`, you will fall into limbo
275 function done (): Boolean; inline;
277 // as you will prolly call `done()` after doing a step anyway, this will do it for you
278 // move to next point, return `true` when the line is complete (i.e. you should stop)
279 function step (): Boolean; inline;
281 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
282 function stepToNextTile (): Boolean; inline;
284 // hack for line-vs-aabb; NOT PROPERLY TESTED!
285 procedure getPrevXY (out ox, oy: Integer); inline;
287 // current coords
288 function x (): Integer; inline;
289 function y (): Integer; inline;
291 procedure getXY (out ox, oy: Integer); inline;
293 // move directions; always [-1..1] (can be zero!)
294 function dx (): Integer; inline;
295 function dy (): Integer; inline;
296 end;
299 // you are not supposed to understand this
300 // returns `true` if there is an intersection, and enter coords
301 // enter coords will be equal to (x0, y0) if starting point is inside the box
302 // if result is `false`, `inx` and `iny` are undefined
303 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
305 // sweep two AABB's to see if and when they are overlapping
306 // returns `true` if collision was detected (but boxes doesn't overlap)
307 // u1 and u1 has no sense if no collision was detected
308 // u0 = normalized time of first collision (i.e. collision starts at myMove*u0)
309 // u1 = normalized time of second collision (i.e. collision stops after myMove*u1)
310 // hitedge for `it`: 0: top; 1: right; 2: bottom; 3: left
311 // enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision)
312 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
313 u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean;
315 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
317 procedure swapInt (var a: Integer; var b: Integer); inline;
318 //function minInt (a, b: Integer): Integer; inline;
319 //function maxInt (a, b: Integer): Integer; inline;
322 implementation
324 uses
325 SysUtils, e_log, g_console, utils;
328 // ////////////////////////////////////////////////////////////////////////// //
329 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
330 //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
331 //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
333 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
336 // ////////////////////////////////////////////////////////////////////////// //
337 constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer);
338 begin
339 setClip(minx, miny, maxx, maxy);
340 end;
342 procedure TLineWalker.setClip (minx, miny, maxx, maxy: Integer); inline;
343 begin
344 // clip rectange
345 wx0 := minx;
346 wy0 := miny;
347 wx1 := maxx;
348 wy1 := maxy;
349 end;
351 function TLineWalker.done (): Boolean; inline; begin result := (xd = term); end;
353 function TLineWalker.step (): Boolean; inline;
354 begin
355 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
356 xd += stx;
357 result := (xd = term);
358 end;
360 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
361 function TLineWalker.stepToNextTile (): Boolean; inline;
362 var
363 ex, ey, wklen, f: Integer;
364 begin
365 result := false;
367 //writeln('stx=', stx, '; sty=', sty);
369 // ortho?
370 if (sty = 0) then
371 begin
372 // only xd
373 assert(sty <> 0);
374 if (stx < 0) then
375 begin
376 // xd: to left edge
377 xd := (xd and (not (TileSize-1)))-1;
378 result := (xd <= term);
379 exit;
380 end
381 else
382 begin
383 // xd: to right edge
384 xd := (xd or (TileSize-1))+1;
385 result := (xd >= term);
386 exit;
387 end;
388 end;
390 assert(stx <> 0); // invariant
392 // not ortho
393 if (sty < 0) then ey := (yd and (not (TileSize-1)))-1 else ey := (yd or (TileSize-1))+1;
395 //FIXME: do some math to avoid single-stepping
396 if (stx < 0) then
397 begin
398 // xd: to left edge
399 ex := (xd and (not (TileSize-1)))-1;
400 if (ex <= term) then begin result := true; exit; end;
401 wklen := xd-ex;
402 end
403 else
404 begin
405 // xd: to right edge
406 ex := (xd or (TileSize-1))+1;
407 if (ex >= term) then begin result := true; exit; end;
408 wklen := ex-xd;
409 end;
411 //writeln('xd=', xd, '; yd=', yd, '; ex=', ex, '; ey=', ey, '; term=', term, '; wklen=', wklen);
413 for f := wklen downto 1 do
414 begin
415 // do step
416 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
417 xd += stx;
418 if (xd = term) then begin result := true; exit; end;
419 if (xd = ex) or (yd = ey) then exit; // done
420 end;
422 raise Exception.Create('TLineWalker.stepToNextTile: the thing that should not be!');
423 end;
425 // NOT TESTED!
426 procedure TLineWalker.getPrevXY (out ox, oy: Integer); inline;
427 begin
428 //writeln('e=', e, '; dx2=', dx2, '; dy2=', dy2);
429 if xyswapped then
430 begin
431 if (e >= 0) then ox := yd-sty else ox := yd;
432 oy := xd-stx;
433 end
434 else
435 begin
436 if (e >= 0) then oy := yd-sty else oy := yd;
437 ox := xd-stx;
438 end;
439 end;
441 function TLineWalker.x (): Integer; inline; begin if xyswapped then result := yd else result := xd; end;
442 function TLineWalker.y (): Integer; inline; begin if xyswapped then result := xd else result := yd; end;
443 procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin if xyswapped then begin ox := yd; oy := xd; end else begin ox := xd; oy := yd; end; end;
445 function TLineWalker.dx (): Integer; inline; begin if xyswapped then result := stx else result := sty; end;
446 function TLineWalker.dy (): Integer; inline; begin if xyswapped then result := sty else result := stx; end;
448 function TLineWalker.setup (x0, y0, x1, y1: Integer): Boolean;
449 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
450 var
451 dsx, dsy: Integer; // "lengthes" for x and y axes
452 rem: Integer;
453 xfixed: Boolean;
454 temp: Integer;
455 begin
456 result := false;
457 xyswapped := false;
459 // horizontal setup
460 if (x0 < x1) then
461 begin
462 // from left to right
463 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
464 stx := 1; // going right
465 end
466 else
467 begin
468 // from right to left
469 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
470 stx := -1; // going left
471 x0 := -x0;
472 x1 := -x1;
473 wx0 := -wx0;
474 wx1 := -wx1;
475 swapInt(wx0, wx1);
476 end;
478 // vertical setup
479 if (y0 < y1) then
480 begin
481 // from top to bottom
482 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
483 sty := 1; // going down
484 end
485 else
486 begin
487 // from bottom to top
488 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
489 sty := -1; // going up
490 y0 := -y0;
491 y1 := -y1;
492 wy0 := -wy0;
493 wy1 := -wy1;
494 swapInt(wy0, wy1);
495 end;
497 dsx := x1-x0;
498 dsy := y1-y0;
500 if (dsx < dsy) then
501 begin
502 xyswapped := true;
503 //xptr := @yd;
504 //yptr := @xd;
505 swapInt(x0, y0);
506 swapInt(x1, y1);
507 swapInt(dsx, dsy);
508 swapInt(wx0, wy0);
509 swapInt(wx1, wy1);
510 swapInt(stx, sty);
511 end
512 else
513 begin
514 //xptr := @xd;
515 //yptr := @yd;
516 end;
518 dx2 := 2*dsx;
519 dy2 := 2*dsy;
520 xd := x0;
521 yd := y0;
522 e := 2*dsy-dsx;
523 term := x1;
525 xfixed := false;
526 if (y0 < wy0) then
527 begin
528 // clip at top
529 temp := dx2*(wy0-y0)-dsx;
530 xd += temp div dy2;
531 rem := temp mod dy2;
532 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
533 if (xd+1 >= wx0) then
534 begin
535 yd := wy0;
536 e -= rem+dsx;
537 if (rem > 0) then begin Inc(xd); e += dy2; end;
538 xfixed := true;
539 end;
540 end;
542 if (not xfixed) and (x0 < wx0) then
543 begin
544 // clip at left
545 temp := dy2*(wx0-x0);
546 yd += temp div dx2;
547 rem := temp mod dx2;
548 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
549 xd := wx0;
550 e += rem;
551 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
552 end;
554 if (y1 > wy1) then
555 begin
556 // clip at bottom
557 temp := dx2*(wy1-y0)+dsx;
558 term := x0+temp div dy2;
559 rem := temp mod dy2;
560 if (rem = 0) then Dec(term);
561 end;
563 if (term > wx1) then term := wx1; // clip at right
565 Inc(term); // draw last point (it is ok to inc here, as `term` sign will be changed later
566 //if (term = xd) then exit; // this is the only point, get out of here
568 if (sty = -1) then yd := -yd;
569 if (stx = -1) then begin xd := -xd; term := -term; end;
570 dx2 -= dy2;
572 result := true;
573 end;
576 // ////////////////////////////////////////////////////////////////////////// //
577 // you are not supposed to understand this
578 // returns `true` if there is an intersection, and enter coords
579 // enter coords will be equal to (x0, y0) if starting point is inside the box
580 // if result is `false`, `inx` and `iny` are undefined
581 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
582 var
583 wx0, wy0, wx1, wy1: Integer; // window coordinates
584 stx, sty: Integer; // "steps" for x and y axes
585 dsx, dsy: Integer; // "lengthes" for x and y axes
586 dx2, dy2: Integer; // "double lengthes" for x and y axes
587 xd, yd: Integer; // current coord
588 e: Integer; // "error" (as in bresenham algo)
589 rem: Integer;
590 //!term: Integer;
591 d0, d1: PInteger;
592 xfixed: Boolean;
593 temp: Integer;
594 begin
595 result := false;
596 // why not
597 inx := x0;
598 iny := y0;
599 if (bw < 1) or (bh < 1) then exit; // impossible box
601 if (x0 = x1) and (y0 = y1) then
602 begin
603 // check this point
604 result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
605 exit;
606 end;
608 // check if staring point is inside the box
609 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
611 // clip rectange
612 wx0 := bx;
613 wy0 := by;
614 wx1 := bx+bw-1;
615 wy1 := by+bh-1;
617 // horizontal setup
618 if (x0 < x1) then
619 begin
620 // from left to right
621 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
622 stx := 1; // going right
623 end
624 else
625 begin
626 // from right to left
627 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
628 stx := -1; // going left
629 x0 := -x0;
630 x1 := -x1;
631 wx0 := -wx0;
632 wx1 := -wx1;
633 swapInt(wx0, wx1);
634 end;
636 // vertical setup
637 if (y0 < y1) then
638 begin
639 // from top to bottom
640 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
641 sty := 1; // going down
642 end
643 else
644 begin
645 // from bottom to top
646 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
647 sty := -1; // going up
648 y0 := -y0;
649 y1 := -y1;
650 wy0 := -wy0;
651 wy1 := -wy1;
652 swapInt(wy0, wy1);
653 end;
655 dsx := x1-x0;
656 dsy := y1-y0;
658 if (dsx < dsy) then
659 begin
660 d0 := @yd;
661 d1 := @xd;
662 swapInt(x0, y0);
663 swapInt(x1, y1);
664 swapInt(dsx, dsy);
665 swapInt(wx0, wy0);
666 swapInt(wx1, wy1);
667 swapInt(stx, sty);
668 end
669 else
670 begin
671 d0 := @xd;
672 d1 := @yd;
673 end;
675 dx2 := 2*dsx;
676 dy2 := 2*dsy;
677 xd := x0;
678 yd := y0;
679 e := 2*dsy-dsx;
680 //!term := x1;
682 xfixed := false;
683 if (y0 < wy0) then
684 begin
685 // clip at top
686 temp := dx2*(wy0-y0)-dsx;
687 xd += temp div dy2;
688 rem := temp mod dy2;
689 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
690 if (xd+1 >= wx0) then
691 begin
692 yd := wy0;
693 e -= rem+dsx;
694 if (rem > 0) then begin Inc(xd); e += dy2; end;
695 xfixed := true;
696 end;
697 end;
699 if (not xfixed) and (x0 < wx0) then
700 begin
701 // clip at left
702 temp := dy2*(wx0-x0);
703 yd += temp div dx2;
704 rem := temp mod dx2;
705 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
706 xd := wx0;
707 e += rem;
708 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
709 end;
711 (*
712 if (y1 > wy1) then
713 begin
714 // clip at bottom
715 temp := dx2*(wy1-y0)+dsx;
716 term := x0+temp div dy2;
717 rem := temp mod dy2;
718 if (rem = 0) then Dec(term);
719 end;
721 if (term > wx1) then term := wx1; // clip at right
723 Inc(term); // draw last point
724 //if (term = xd) then exit; // this is the only point, get out of here
725 *)
727 if (sty = -1) then yd := -yd;
728 if (stx = -1) then begin xd := -xd; {!term := -term;} end;
729 //!dx2 -= dy2;
731 inx := d0^;
732 iny := d1^;
733 result := true;
734 end;
737 // ////////////////////////////////////////////////////////////////////////// //
738 function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer;
739 u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean;
740 var
741 tin, tout: Single;
743 function axisOverlap (me0, me1, it0, it1, d, he0, he1: Integer): Boolean; inline;
744 var
745 t: Single;
746 begin
747 result := false;
749 if (me1 < it0) then
750 begin
751 if (d >= 0) then exit; // oops, no hit
752 t := (me1-it0+1)/d;
753 if (t > tin) then begin tin := t; hitedge^ := he1; end;
754 end
755 else if (it1 < me0) then
756 begin
757 if (d <= 0) then exit; // oops, no hit
758 t := (me0-it1-1)/d;
759 if (t > tin) then begin tin := t; hitedge^ := he0; end;
760 end;
762 if (d < 0) and (it1 > me0) then
763 begin
764 t := (me0-it1-1)/d;
765 if (t < tout) then tout := t;
766 end
767 else if (d > 0) and (me1 > it0) then
768 begin
769 t := (me1-it0+1)/d;
770 if (t < tout) then tout := t;
771 end;
773 result := true;
774 end;
776 var
777 mex1, mey1, itx1, ity1, vx, vy: Integer;
778 htt: Integer = -1;
779 begin
780 result := false;
781 if (u0 <> nil) then u0^ := -1.0;
782 if (u1 <> nil) then u1^ := -1.0;
783 if (hitedge = nil) then hitedge := @htt else hitedge^ := -1;
785 if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit;
787 mex1 := mex0+mew-1;
788 mey1 := mey0+meh-1;
789 itx1 := itx0+itw-1;
790 ity1 := ity0+ith-1;
792 // check if they are overlapping right now (SAT)
793 //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end;
795 if (medx = 0) and (medy = 0) then exit; // both boxes are sationary
797 // treat b as stationary, so invert v to get relative velocity
798 vx := -medx;
799 vy := -medy;
801 tin := -100000000.0;
802 tout := 100000000.0;
804 if not axisOverlap(mex0, mex1, itx0, itx1, vx, 1, 3) then exit;
805 if not axisOverlap(mey0, mey1, ity0, ity1, vy, 2, 0) then exit;
807 if (u0 <> nil) then u0^ := tin;
808 if (u1 <> nil) then u1^ := tout;
810 if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then
811 begin
812 result := true;
813 end;
814 end;
817 // ////////////////////////////////////////////////////////////////////////// //
818 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
819 begin
820 mX := aX;
821 mY := aY;
822 mWidth := aWidth;
823 mHeight := aHeight;
824 mQueryMark := 0;
825 mObj := aObj;
826 mTag := aTag;
827 nextLink := -1;
828 end;
831 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
832 begin
833 result := mTag and TagFullMask;
834 end;
836 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
837 begin
838 mTag := (mTag and TagDisabled) or (v and TagFullMask);
839 end;
841 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
842 begin
843 result := ((mTag and TagDisabled) = 0);
844 end;
846 procedure TBodyGridBase.TBodyProxyRec.setEnabled (v: Boolean); inline;
847 begin
848 if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled;
849 end;
851 function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline;
852 begin
853 result := mX+mWidth-1;
854 end;
856 function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline;
857 begin
858 result := mY+mHeight-1;
859 end;
862 // ////////////////////////////////////////////////////////////////////////// //
863 constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
864 begin
865 mCells := acells;
866 curidx := aidx;
867 curbki := -1;
868 getpx := agetpx;
869 end;
872 function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline;
873 begin
874 while (curidx <> -1) do
875 begin
876 while (curbki < GridCellBucketSize) do
877 begin
878 Inc(curbki);
879 if (mCells[curidx].bodies[curbki] = -1) then break;
880 result := true;
881 exit;
882 end;
883 curidx := mCells[curidx].next;
884 curbki := -1;
885 end;
886 result := false;
887 end;
890 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
891 begin
892 result := getpx(mCells[curidx].bodies[curbki]);
893 end;
896 // ////////////////////////////////////////////////////////////////////////// //
897 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
898 var
899 idx: Integer;
900 begin
901 dbgShowTraceLog := false;
902 {$IF DEFINED(D2F_DEBUG)}
903 dbgRayTraceTileHitCB := nil;
904 {$ENDIF}
906 if aTileSize < 1 then aTileSize := 1;
907 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
908 mTileSize := aTileSize;
910 if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
911 if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
912 mMinX := aMinPixX;
913 mMinY := aMinPixY;
914 mWidth := (aPixWidth+mTileSize-1) div mTileSize;
915 mHeight := (aPixHeight+mTileSize-1) div mTileSize;
916 SetLength(mGrid, mWidth*mHeight);
917 SetLength(mCells, mWidth*mHeight);
918 SetLength(mProxies, 8192);
919 mFreeCell := 0;
920 // init free list
921 for idx := 0 to High(mCells) do
922 begin
923 mCells[idx].bodies[0] := -1;
924 mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
925 mCells[idx].next := idx+1;
926 end;
927 mCells[High(mCells)].next := -1; // last cell
928 // init grid
929 for idx := 0 to High(mGrid) do mGrid[idx] := -1;
930 // init proxies
931 for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
932 mProxies[High(mProxies)].nextLink := -1;
933 mLastQuery := 0;
934 mUsedCells := 0;
935 mProxyFree := 0;
936 mProxyCount := 0;
937 mProxyMaxCount := 0;
938 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
939 end;
942 destructor TBodyGridBase.Destroy ();
943 begin
944 mCells := nil;
945 mGrid := nil;
946 mProxies := nil;
947 inherited;
948 end;
951 // ////////////////////////////////////////////////////////////////////////// //
952 procedure TBodyGridBase.dumpStats ();
953 var
954 idx, mcb, ccidx, cnt: Integer;
955 begin
956 mcb := 0;
957 for idx := 0 to High(mGrid) do
958 begin
959 ccidx := mGrid[idx];
960 cnt := 0;
961 while ccidx >= 0 do
962 begin
963 Inc(cnt);
964 ccidx := mCells[ccidx].next;
965 end;
966 if (mcb < cnt) then mcb := cnt;
967 end;
968 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);
969 end;
972 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
973 var
974 g, f, ccidx: Integer;
975 cc: PGridCell;
976 begin
977 if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
978 for g := 0 to High(mGrid) do
979 begin
980 ccidx := mGrid[g];
981 while (ccidx <> -1) do
982 begin
983 cc := @mCells[ccidx];
984 for f := 0 to GridCellBucketSize-1 do
985 begin
986 if (cc.bodies[f] = -1) then break;
987 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
988 end;
989 // next cell
990 ccidx := cc.next;
991 end;
992 end;
993 end;
996 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
997 var
998 f, ccidx: Integer;
999 cc: PGridCell;
1000 begin
1001 result := Default(ITP);
1002 if not assigned(cb) then exit;
1003 Dec(x, mMinX);
1004 Dec(y, mMinY);
1005 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
1006 ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1007 while (ccidx <> -1) do
1008 begin
1009 cc := @mCells[ccidx];
1010 for f := 0 to GridCellBucketSize-1 do
1011 begin
1012 if (cc.bodies[f] = -1) then break;
1013 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
1014 end;
1015 // next cell
1016 ccidx := cc.next;
1017 end;
1018 end;
1021 // ////////////////////////////////////////////////////////////////////////// //
1022 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
1023 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
1026 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
1027 begin
1028 // fix coords
1029 Dec(x, mMinX);
1030 Dec(y, mMinY);
1031 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
1032 end;
1035 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
1036 begin
1037 if (body >= 0) and (body < Length(mProxies)) then
1038 begin
1039 with mProxies[body] do begin rx := mX; ry := mY; end;
1040 result := true;
1041 end
1042 else
1043 begin
1044 rx := 0;
1045 ry := 0;
1046 result := false;
1047 end;
1048 end;
1051 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
1052 begin
1053 if (body >= 0) and (body < Length(mProxies)) then
1054 begin
1055 with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
1056 result := true;
1057 end
1058 else
1059 begin
1060 rw := 0;
1061 rh := 0;
1062 result := false;
1063 end;
1064 end;
1067 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
1068 begin
1069 if (body >= 0) and (body < Length(mProxies)) then
1070 begin
1071 with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
1072 result := true;
1073 end
1074 else
1075 begin
1076 rx := 0;
1077 ry := 0;
1078 rw := 0;
1079 rh := 0;
1080 result := false;
1081 end;
1082 end;
1086 // ////////////////////////////////////////////////////////////////////////// //
1087 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
1088 begin
1089 if (pid >= 0) and (pid < Length(mProxies)) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
1090 end;
1093 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
1094 begin
1095 if (pid >= 0) and (pid < Length(mProxies)) then
1096 begin
1097 if val then
1098 begin
1099 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
1100 end
1101 else
1102 begin
1103 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
1104 end;
1105 end;
1106 end;
1109 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
1110 begin
1111 if (idx >= 0) and (idx < Length(mProxies)) then result := @mProxies[idx] else result := nil;
1112 end;
1115 // ////////////////////////////////////////////////////////////////////////// //
1116 function TBodyGridBase.allocCell (): Integer;
1117 var
1118 idx: Integer;
1119 pc: PGridCell;
1120 begin
1121 if (mFreeCell < 0) then
1122 begin
1123 // no free cells, want more
1124 mFreeCell := Length(mCells);
1125 SetLength(mCells, mFreeCell+32768); // arbitrary number
1126 for idx := mFreeCell to High(mCells) do
1127 begin
1128 mCells[idx].bodies[0] := -1;
1129 mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
1130 mCells[idx].next := idx+1;
1131 end;
1132 mCells[High(mCells)].next := -1; // last cell
1133 end;
1134 result := mFreeCell;
1135 pc := @mCells[result];
1136 mFreeCell := pc.next;
1137 pc.next := -1;
1138 Inc(mUsedCells);
1139 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
1140 end;
1143 procedure TBodyGridBase.freeCell (idx: Integer);
1144 begin
1145 if (idx >= 0) and (idx < Length(mCells)) then
1146 begin
1147 with mCells[idx] do
1148 begin
1149 bodies[0] := -1;
1150 bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
1151 next := mFreeCell;
1152 end;
1153 mFreeCell := idx;
1154 Dec(mUsedCells);
1155 end;
1156 end;
1159 // ////////////////////////////////////////////////////////////////////////// //
1160 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
1161 var
1162 olen, idx: Integer;
1163 px: PBodyProxyRec;
1164 begin
1165 if (mProxyFree = -1) then
1166 begin
1167 // no free proxies, resize list
1168 olen := Length(mProxies);
1169 SetLength(mProxies, olen+8192); // arbitrary number
1170 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
1171 mProxies[High(mProxies)].nextLink := -1;
1172 mProxyFree := olen;
1173 end;
1174 // get one from list
1175 result := mProxyFree;
1176 px := @mProxies[result];
1177 mProxyFree := px.nextLink;
1178 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
1179 // add to used list
1180 px.nextLink := -1;
1181 // statistics
1182 Inc(mProxyCount);
1183 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
1184 end;
1186 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
1187 begin
1188 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1189 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
1190 // add to free list
1191 mProxies[body].mObj := nil;
1192 mProxies[body].nextLink := mProxyFree;
1193 mProxyFree := body;
1194 Dec(mProxyCount);
1195 end;
1198 // ////////////////////////////////////////////////////////////////////////// //
1199 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
1200 var
1201 gx, gy: Integer;
1202 gw, gh: Integer;
1203 begin
1204 result := false;
1205 if (w < 1) or (h < 1) or not assigned(cb) then exit;
1206 // fix coords
1207 Dec(x, mMinX);
1208 Dec(y, mMinY);
1209 // go on
1210 if (x+w <= 0) or (y+h <= 0) then exit;
1211 gw := mWidth;
1212 gh := mHeight;
1213 //tsize := mTileSize;
1214 if (x >= gw*mTileSize) or (y >= gh*mTileSize) then exit;
1215 for gy := y div mTileSize to (y+h-1) div mTileSize do
1216 begin
1217 if (gy < 0) then continue;
1218 if (gy >= gh) then break;
1219 for gx := x div mTileSize to (x+w-1) div mTileSize do
1220 begin
1221 if (gx < 0) then continue;
1222 if (gx >= gw) then break;
1223 result := cb(gy*gw+gx, bodyId);
1224 if result then exit;
1225 end;
1226 end;
1227 end;
1230 // ////////////////////////////////////////////////////////////////////////// //
1231 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
1232 var
1233 ccidx: Integer;
1234 pc: Integer;
1235 pi: PGridCell;
1236 f: Integer;
1237 begin
1238 result := false; // never stop
1239 // add body to the given grid cell
1240 pc := mGrid[grida];
1241 if (pc <> -1) then
1242 begin
1243 {$IF DEFINED(D2F_DEBUG)}
1244 ccidx := pc;
1245 while (ccidx <> -1) do
1246 begin
1247 pi := @mCells[ccidx];
1248 for f := 0 to GridCellBucketSize-1 do
1249 begin
1250 if (pi.bodies[f] = -1) then break;
1251 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
1252 end;
1253 ccidx := pi.next;
1254 end;
1255 {$ENDIF}
1256 ccidx := pc;
1257 while (ccidx <> -1) do
1258 begin
1259 pi := @mCells[ccidx];
1260 // check "has room" flag
1261 if (pi.bodies[GridCellBucketSize-1] = -1) then
1262 begin
1263 // can add here
1264 for f := 0 to GridCellBucketSize-1 do
1265 begin
1266 if (pi.bodies[f] = -1) then
1267 begin
1268 pi.bodies[f] := bodyId;
1269 if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
1270 exit;
1271 end;
1272 end;
1273 raise Exception.Create('internal error in grid inserter');
1274 end;
1275 // no room, go to next cell in list (if there is any)
1276 ccidx := pi.next;
1277 end;
1278 // no room in cells, add new cell to list
1279 end;
1280 // either no room, or no cell at all
1281 ccidx := allocCell();
1282 pi := @mCells[ccidx];
1283 pi.bodies[0] := bodyId;
1284 pi.bodies[1] := -1;
1285 pi.next := pc;
1286 mGrid[grida] := ccidx;
1287 end;
1289 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
1290 var
1291 px: PBodyProxyRec;
1292 begin
1293 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1294 px := @mProxies[body];
1295 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
1296 end;
1299 // assume that we cannot have one object added to bucket twice
1300 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
1301 var
1302 f, c: Integer;
1303 pidx, ccidx: Integer;
1304 pc: PGridCell;
1305 begin
1306 result := false; // never stop
1307 // find and remove cell
1308 pidx := -1; // previous cell index
1309 ccidx := mGrid[grida]; // current cell index
1310 while (ccidx <> -1) do
1311 begin
1312 pc := @mCells[ccidx];
1313 for f := 0 to GridCellBucketSize-1 do
1314 begin
1315 if (pc.bodies[f] = bodyId) then
1316 begin
1317 // i found her!
1318 if (f = 0) and (pc.bodies[1] = -1) then
1319 begin
1320 // this cell contains no elements, remove it
1321 if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
1322 freeCell(ccidx);
1323 exit;
1324 end;
1325 // remove element from bucket
1326 for c := f to GridCellBucketSize-2 do
1327 begin
1328 pc.bodies[c] := pc.bodies[c+1];
1329 if (pc.bodies[c] = -1) then break;
1330 end;
1331 pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
1332 exit;
1333 end;
1334 end;
1335 pidx := ccidx;
1336 ccidx := pc.next;
1337 end;
1338 end;
1340 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
1341 var
1342 px: PBodyProxyRec;
1343 begin
1344 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1345 px := @mProxies[body];
1346 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1347 end;
1350 // ////////////////////////////////////////////////////////////////////////// //
1351 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
1352 begin
1353 aTag := aTag and TagFullMask;
1354 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
1355 insertInternal(result);
1356 end;
1359 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
1360 begin
1361 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1362 removeInternal(body);
1363 freeProxy(body);
1364 end;
1367 // ////////////////////////////////////////////////////////////////////////// //
1368 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
1369 var
1370 px: PBodyProxyRec;
1371 x0, y0, w, h: Integer;
1372 begin
1373 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1374 px := @mProxies[body];
1375 x0 := px.mX;
1376 y0 := px.mY;
1377 w := px.mWidth;
1378 h := px.mHeight;
1379 {$IF DEFINED(D2F_DEBUG_MOVER)}
1380 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);
1381 {$ENDIF}
1382 if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
1383 // map -> grid
1384 Dec(x0, mMinX);
1385 Dec(y0, mMinY);
1386 Dec(nx, mMinX);
1387 Dec(ny, mMinY);
1388 // did any corner crossed tile boundary?
1389 if (x0 div mTileSize <> nx div mTileSize) or
1390 (y0 div mTileSize <> ny div mTileSize) or
1391 ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
1392 ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
1393 begin
1394 removeInternal(body);
1395 px.mX := nx+mMinX;
1396 px.mY := ny+mMinY;
1397 px.mWidth := nw;
1398 px.mHeight := nh;
1399 insertInternal(body);
1400 end
1401 else
1402 begin
1403 px.mX := nx+mMinX;
1404 px.mY := ny+mMinY;
1405 px.mWidth := nw;
1406 px.mHeight := nh;
1407 end;
1408 end;
1410 //TODO: optimize for horizontal/vertical moves
1411 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
1412 var
1413 px: PBodyProxyRec;
1414 x0, y0: Integer;
1415 ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
1416 ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
1417 gx, gy: Integer;
1418 gw, gh: Integer;
1419 pw, ph: Integer;
1420 begin
1421 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1422 // check if tile coords was changed
1423 px := @mProxies[body];
1424 x0 := px.mX;
1425 y0 := px.mY;
1426 if (nx = x0) and (ny = y0) then exit;
1427 // map -> grid
1428 Dec(x0, mMinX);
1429 Dec(y0, mMinY);
1430 Dec(nx, mMinX);
1431 Dec(ny, mMinY);
1432 // check for heavy work
1433 pw := px.mWidth;
1434 ph := px.mHeight;
1435 ogx0 := x0 div mTileSize;
1436 ogy0 := y0 div mTileSize;
1437 ngx0 := nx div mTileSize;
1438 ngy0 := ny div mTileSize;
1439 ogx1 := (x0+pw-1) div mTileSize;
1440 ogy1 := (y0+ph-1) div mTileSize;
1441 ngx1 := (nx+pw-1) div mTileSize;
1442 ngy1 := (ny+ph-1) div mTileSize;
1443 {$IF DEFINED(D2F_DEBUG_MOVER)}
1444 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);
1445 {$ENDIF}
1446 if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1447 begin
1448 // crossed tile boundary, do heavy work
1449 gw := mWidth;
1450 gh := mHeight;
1451 // cycle with old rect, remove body where it is necessary
1452 // optimized for horizontal moves
1453 {$IF DEFINED(D2F_DEBUG_MOVER)}
1454 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);
1455 {$ENDIF}
1456 // remove stale marks
1457 if not ((ogy0 >= gh) or (ogy1 < 0)) and
1458 not ((ogx0 >= gw) or (ogx1 < 0)) then
1459 begin
1460 if (ogx0 < 0) then ogx0 := 0;
1461 if (ogy0 < 0) then ogy0 := 0;
1462 if (ogx1 > gw-1) then ogx1 := gw-1;
1463 if (ogy1 > gh-1) then ogy1 := gh-1;
1464 {$IF DEFINED(D2F_DEBUG_MOVER)}
1465 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1466 {$ENDIF}
1467 for gx := ogx0 to ogx1 do
1468 begin
1469 if (gx < ngx0) or (gx > ngx1) then
1470 begin
1471 // this column is completely outside of new rect
1472 for gy := ogy0 to ogy1 do
1473 begin
1474 {$IF DEFINED(D2F_DEBUG_MOVER)}
1475 e_WriteLog(Format(' remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1476 {$ENDIF}
1477 remover(gy*gw+gx, body);
1478 end;
1479 end
1480 else
1481 begin
1482 // heavy checks
1483 for gy := ogy0 to ogy1 do
1484 begin
1485 if (gy < ngy0) or (gy > ngy1) then
1486 begin
1487 {$IF DEFINED(D2F_DEBUG_MOVER)}
1488 e_WriteLog(Format(' remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1489 {$ENDIF}
1490 remover(gy*gw+gx, body);
1491 end;
1492 end;
1493 end;
1494 end;
1495 end;
1496 // cycle with new rect, add body where it is necessary
1497 if not ((ngy0 >= gh) or (ngy1 < 0)) and
1498 not ((ngx0 >= gw) or (ngx1 < 0)) then
1499 begin
1500 if (ngx0 < 0) then ngx0 := 0;
1501 if (ngy0 < 0) then ngy0 := 0;
1502 if (ngx1 > gw-1) then ngx1 := gw-1;
1503 if (ngy1 > gh-1) then ngy1 := gh-1;
1504 {$IF DEFINED(D2F_DEBUG_MOVER)}
1505 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1506 {$ENDIF}
1507 for gx := ngx0 to ngx1 do
1508 begin
1509 if (gx < ogx0) or (gx > ogx1) then
1510 begin
1511 // this column is completely outside of old rect
1512 for gy := ngy0 to ngy1 do
1513 begin
1514 {$IF DEFINED(D2F_DEBUG_MOVER)}
1515 e_WriteLog(Format(' insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1516 {$ENDIF}
1517 inserter(gy*gw+gx, body);
1518 end;
1519 end
1520 else
1521 begin
1522 // heavy checks
1523 for gy := ngy0 to ngy1 do
1524 begin
1525 if (gy < ogy0) or (gy > ogy1) then
1526 begin
1527 {$IF DEFINED(D2F_DEBUG_MOVER)}
1528 e_WriteLog(Format(' insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1529 {$ENDIF}
1530 inserter(gy*gw+gx, body);
1531 end;
1532 end;
1533 end;
1534 end;
1535 end;
1536 // done
1537 end
1538 else
1539 begin
1540 {$IF DEFINED(D2F_DEBUG_MOVER)}
1541 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);
1542 {$ENDIF}
1543 end;
1544 // update coordinates
1545 px.mX := nx+mMinX;
1546 px.mY := ny+mMinY;
1547 end;
1549 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1550 var
1551 px: PBodyProxyRec;
1552 x0, y0, w, h: Integer;
1553 begin
1554 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1555 // check if tile coords was changed
1556 px := @mProxies[body];
1557 x0 := px.mX-mMinX;
1558 y0 := px.mY-mMinY;
1559 w := px.mWidth;
1560 h := px.mHeight;
1561 {$IF DEFINED(D2F_DEBUG_MOVER)}
1562 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);
1563 {$ENDIF}
1564 if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
1565 ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
1566 begin
1567 // crossed tile boundary, do heavy work
1568 removeInternal(body);
1569 px.mWidth := nw;
1570 px.mHeight := nh;
1571 insertInternal(body);
1572 end
1573 else
1574 begin
1575 // nothing to do with the grid, just fix size
1576 px.mWidth := nw;
1577 px.mHeight := nh;
1578 end;
1579 end;
1582 // ////////////////////////////////////////////////////////////////////////// //
1583 function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator;
1584 var
1585 ccidx: Integer = -1;
1586 begin
1587 Dec(x, mMinX);
1588 Dec(y, mMinY);
1589 if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1590 result := TAtPointEnumerator.Create(mCells, ccidx, getProxyById);
1591 end;
1594 // ////////////////////////////////////////////////////////////////////////// //
1595 // no callback: return `true` on the first hit
1596 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1597 var
1598 f: Integer;
1599 idx, curci: Integer;
1600 cc: PGridCell = nil;
1601 px: PBodyProxyRec;
1602 lq: LongWord;
1603 ptag: Integer;
1604 begin
1605 result := Default(ITP);
1606 if (exittag <> nil) then exittag^ := 0;
1607 tagmask := tagmask and TagFullMask;
1608 if (tagmask = 0) then exit;
1610 {$IF DEFINED(D2F_DEBUG_XXQ)}
1611 if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1612 {$ENDIF}
1614 // make coords (0,0)-based
1615 Dec(x, mMinX);
1616 Dec(y, mMinY);
1617 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1619 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1621 {$IF DEFINED(D2F_DEBUG_XXQ)}
1622 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);
1623 {$ENDIF}
1625 // restore coords
1626 Inc(x, mMinX);
1627 Inc(y, mMinY);
1629 // increase query counter
1630 Inc(mLastQuery);
1631 if (mLastQuery = 0) then
1632 begin
1633 // just in case of overflow
1634 mLastQuery := 1;
1635 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1636 end;
1637 lq := mLastQuery;
1639 {$IF DEFINED(D2F_DEBUG_XXQ)}
1640 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1641 {$ENDIF}
1643 while (curci <> -1) do
1644 begin
1645 {$IF DEFINED(D2F_DEBUG_XXQ)}
1646 if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1647 {$ENDIF}
1648 cc := @mCells[curci];
1649 for f := 0 to GridCellBucketSize-1 do
1650 begin
1651 if (cc.bodies[f] = -1) then break;
1652 px := @mProxies[cc.bodies[f]];
1653 {$IF DEFINED(D2F_DEBUG_XXQ)}
1654 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);
1655 {$ENDIF}
1656 // shit. has to do it this way, so i can change tag in callback
1657 if (px.mQueryMark <> lq) then
1658 begin
1659 px.mQueryMark := lq;
1660 ptag := px.mTag;
1661 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1662 (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1663 begin
1664 if assigned(cb) then
1665 begin
1666 if cb(px.mObj, ptag) then
1667 begin
1668 result := px.mObj;
1669 if (exittag <> nil) then exittag^ := ptag;
1670 exit;
1671 end;
1672 end
1673 else
1674 begin
1675 result := px.mObj;
1676 if (exittag <> nil) then exittag^ := ptag;
1677 exit;
1678 end;
1679 end;
1680 end;
1681 end;
1682 curci := cc.next;
1683 end;
1684 end;
1687 // ////////////////////////////////////////////////////////////////////////// //
1688 // no callback: return `true` on the first hit
1689 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1690 var
1691 idx: Integer;
1692 gx, gy: Integer;
1693 curci: Integer;
1694 f: Integer;
1695 cc: PGridCell = nil;
1696 px: PBodyProxyRec;
1697 lq: LongWord;
1698 gw: Integer;
1699 x0, y0: Integer;
1700 ptag: Integer;
1701 begin
1702 result := Default(ITP);
1703 if (w < 1) or (h < 1) then exit;
1704 tagmask := tagmask and TagFullMask;
1705 if (tagmask = 0) then exit;
1707 x0 := x;
1708 y0 := y;
1710 // fix coords
1711 Dec(x, mMinX);
1712 Dec(y, mMinY);
1714 gw := mWidth;
1715 //tsize := mTileSize;
1717 if (x+w <= 0) or (y+h <= 0) then exit;
1718 if (x >= gw*mTileSize) or (y >= mHeight*mTileSize) then exit;
1720 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1721 mInQuery := true;
1723 // increase query counter
1724 Inc(mLastQuery);
1725 if (mLastQuery = 0) then
1726 begin
1727 // just in case of overflow
1728 mLastQuery := 1;
1729 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1730 end;
1731 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1732 lq := mLastQuery;
1734 // go on
1735 for gy := y div mTileSize to (y+h-1) div mTileSize do
1736 begin
1737 if (gy < 0) then continue;
1738 if (gy >= mHeight) then break;
1739 for gx := x div mTileSize to (x+w-1) div mTileSize do
1740 begin
1741 if (gx < 0) then continue;
1742 if (gx >= gw) then break;
1743 // process cells
1744 curci := mGrid[gy*gw+gx];
1745 while (curci <> -1) do
1746 begin
1747 cc := @mCells[curci];
1748 for f := 0 to GridCellBucketSize-1 do
1749 begin
1750 if (cc.bodies[f] = -1) then break;
1751 px := @mProxies[cc.bodies[f]];
1752 // shit. has to do it this way, so i can change tag in callback
1753 if (px.mQueryMark = lq) then continue;
1754 px.mQueryMark := lq;
1755 ptag := px.mTag;
1756 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1757 if ((ptag and tagmask) = 0) then continue;
1758 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1759 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1760 if assigned(cb) then
1761 begin
1762 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
1763 end
1764 else
1765 begin
1766 result := px.mObj;
1767 mInQuery := false;
1768 exit;
1769 end;
1770 end;
1771 curci := cc.next;
1772 end;
1773 end;
1774 end;
1776 mInQuery := false;
1777 end;
1780 // ////////////////////////////////////////////////////////////////////////// //
1781 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1782 var
1783 lw: TLineWalker;
1784 ccidx: Integer;
1785 cc: PGridCell;
1786 px: PBodyProxyRec;
1787 lq: LongWord;
1788 f, ptag: Integer;
1789 gw, gh, minx, miny: Integer;
1790 x0, y0: Integer;
1791 x1, y1: Integer;
1792 cx, cy: Integer;
1793 //px0, py0, px1, py1: Integer;
1794 begin
1795 log := false;
1796 result := Default(ITP);
1797 tagmask := tagmask and TagFullMask;
1798 if (tagmask = 0) or not assigned(cb) then exit;
1800 gw := mWidth;
1801 gh := mHeight;
1802 minx := mMinX;
1803 miny := mMinY;
1805 // make query coords (0,0)-based
1806 x0 := ax0-minx;
1807 y0 := ay0-miny;
1808 x1 := ax1-minx;
1809 y1 := ay1-miny;
1811 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
1812 if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
1814 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1815 mInQuery := true;
1817 // increase query counter
1818 Inc(mLastQuery);
1819 if (mLastQuery = 0) then
1820 begin
1821 // just in case of overflow
1822 mLastQuery := 1;
1823 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1824 end;
1825 lq := mLastQuery;
1827 repeat
1828 lw.getXY(cx, cy);
1829 // check tile
1830 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
1831 // process cells
1832 while (ccidx <> -1) do
1833 begin
1834 cc := @mCells[ccidx];
1835 for f := 0 to GridCellBucketSize-1 do
1836 begin
1837 if (cc.bodies[f] = -1) then break;
1838 px := @mProxies[cc.bodies[f]];
1839 ptag := px.mTag;
1840 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1841 begin
1842 px.mQueryMark := lq; // mark as processed
1843 if cb(px.mObj, ptag) then
1844 begin
1845 result := px.mObj;
1846 mInQuery := false;
1847 exit;
1848 end;
1849 end;
1850 end;
1851 // next cell
1852 ccidx := cc.next;
1853 end;
1854 // done processing cells, move to next tile
1855 until lw.stepToNextTile();
1857 mInQuery := false;
1858 end;
1861 // ////////////////////////////////////////////////////////////////////////// //
1862 // trace box with the given velocity; return object hit (if any)
1863 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
1864 function TBodyGridBase.traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
1865 var
1866 gx, gy: Integer;
1867 ccidx: Integer;
1868 cc: PGridCell;
1869 px: PBodyProxyRec;
1870 lq: LongWord;
1871 f, ptag: Integer;
1872 minu0: Single = 100000.0;
1873 u0: Single;
1874 cx0, cy0, cx1, cy1: Integer;
1875 hitpx: PBodyProxyRec = nil;
1876 begin
1877 result := Default(ITP);
1878 ex := ax0+dx;
1879 ey := ay0+dy;
1880 if (aw < 1) or (ah < 1) then exit;
1882 cx0 := nmin(ax0, ax0+dx);
1883 cy0 := nmin(ay0, ay0+dy);
1884 cx1 := nmax(ax0+aw-1, ax0+aw-1+dx);
1885 cy1 := nmax(ay0+ah-1, ay0+ah-1+dy);
1887 cx0 -= mMinX; cy0 -= mMinY;
1888 cx1 -= mMinX; cy1 -= mMinY;
1890 if (cx1 < 0) or (cy1 < 0) or (cx0 >= mWidth*mTileSize) or (cy0 >= mHeight*mTileSize) then exit;
1892 if (cx0 < 0) then cx0 := 0;
1893 if (cy0 < 0) then cy0 := 0;
1894 if (cx1 >= mWidth*mTileSize) then cx1 := mWidth*mTileSize-1;
1895 if (cy1 >= mHeight*mTileSize) then cy1 := mHeight*mTileSize-1;
1896 // just in case
1897 if (cx0 > cx1) or (cy0 > cy1) then exit;
1899 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1900 mInQuery := true;
1902 // increase query counter
1903 Inc(mLastQuery);
1904 if (mLastQuery = 0) then
1905 begin
1906 // just in case of overflow
1907 mLastQuery := 1;
1908 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1909 end;
1910 lq := mLastQuery;
1912 for gy := cy0 div mTileSize to cy1 div mTileSize do
1913 begin
1914 for gx := cx0 div mTileSize to cx1 div mTileSize do
1915 begin
1916 ccidx := mGrid[gy*mWidth+gx];
1917 while (ccidx <> -1) do
1918 begin
1919 cc := @mCells[ccidx];
1920 for f := 0 to GridCellBucketSize-1 do
1921 begin
1922 if (cc.bodies[f] = -1) then break;
1923 px := @mProxies[cc.bodies[f]];
1924 ptag := px.mTag;
1925 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1926 begin
1927 px.mQueryMark := lq; // mark as processed
1928 if assigned(cb) then
1929 begin
1930 if not cb(px.mObj, ptag) then continue;
1931 end;
1932 if not sweepAABB(ax0, ay0, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0) then continue;
1933 if (minu0 > u0) then
1934 begin
1935 hitpx := px;
1936 result := px.mObj;
1937 minu0 := u0;
1938 if (u0 = 0.0) then
1939 begin
1940 ex := ax0;
1941 ey := ay0;
1942 mInQuery := false;
1943 exit;
1944 end;
1945 end;
1946 end;
1947 end;
1948 // next cell
1949 ccidx := cc.next;
1950 end;
1951 end;
1952 end;
1954 if (minu0 <= 1.0) then
1955 begin
1956 ex := ax0+round(dx*minu0);
1957 ey := ay0+round(dy*minu0);
1958 // just in case, compensate for floating point inexactness
1959 if (ex >= hitpx.mX) and (ey >= hitpx.mY) and (ex < hitpx.mX+hitpx.mWidth) and (ey < hitpx.mY+hitpx.mHeight) then
1960 begin
1961 ex := ax0+trunc(dx*minu0);
1962 ey := ay0+trunc(dy*minu0);
1963 end;
1964 end;
1966 mInQuery := false;
1967 end;
1970 // ////////////////////////////////////////////////////////////////////////// //
1971 {.$DEFINE D2F_DEBUG_OTR}
1972 function TBodyGridBase.traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
1973 var
1974 ccidx: Integer;
1975 cc: PGridCell;
1976 px: PBodyProxyRec;
1977 ptag: Integer;
1978 minx, miny: Integer;
1979 f, c0, c1: Integer;
1980 x0, y0, x1, y1: Integer;
1981 celly0, celly1: Integer;
1982 dy: Integer;
1983 filled: array[0..mTileSize-1] of Byte;
1984 {$IF DEFINED(D2F_DEBUG_OTR)}
1985 s: AnsiString = '';
1986 {$ENDIF}
1987 begin
1988 result := false;
1989 ex := ax1;
1990 ey := ay1;
1991 if not ((ax0 = ax1) or (ay0 = ay1)) then raise Exception.Create('orthoray is not orthogonal');
1993 tagmask := tagmask and TagFullMask;
1994 if (tagmask = 0) then exit;
1996 if (forEachAtPoint(ax0, ay0, nil, tagmask) = nil) then exit;
1998 minx := mMinX;
1999 miny := mMinY;
2001 // offset query coords to (0,0)-based
2002 x0 := ax0-minx;
2003 y0 := ay0-miny;
2004 x1 := ax1-minx;
2005 y1 := ay1-miny;
2007 if (x0 = x1) then
2008 begin
2009 if (x0 < 0) or (x0 >= mWidth*mTileSize) then exit; // oops
2010 // vertical
2011 if (y0 < y1) then
2012 begin
2013 // down
2014 if (y1 < 0) or (y0 >= mHeight*mTileSize) then exit;
2015 //if (ay0 < 0) then ay0 := 0;
2016 if (y0 < 0) then exit;
2017 if (y1 >= mHeight*mTileSize) then y1 := mHeight*mTileSize-1;
2018 dy := 1;
2019 end
2020 else
2021 begin
2022 // up
2023 if (y0 < 0) or (y1 >= mHeight*mTileSize) then exit;
2024 //if (ay1 < 0) then ay1 := 0;
2025 if (y1 < 0) then exit;
2026 if (y0 >= mHeight*mTileSize) then y0 := mHeight*mTileSize-1;
2027 dy := -1;
2028 end;
2029 // check tile
2030 while true do
2031 begin
2032 ccidx := mGrid[(y0 div mTileSize)*mWidth+(x0 div mTileSize)];
2033 FillChar(filled, sizeof(filled), 0);
2034 celly0 := y0 and (not (mTileSize-1));
2035 celly1 := celly0+mTileSize-1;
2036 while (ccidx <> -1) do
2037 begin
2038 cc := @mCells[ccidx];
2039 for f := 0 to GridCellBucketSize-1 do
2040 begin
2041 if (cc.bodies[f] = -1) then break;
2042 px := @mProxies[cc.bodies[f]];
2043 ptag := px.mTag;
2044 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
2045 (ax0 >= px.x0) and (ax0 <= px.x1) then
2046 begin
2047 // bound c0 and c1 to cell
2048 c0 := nclamp(px.y0-miny, celly0, celly1);
2049 c1 := nclamp(px.y1-miny, celly0, celly1);
2050 // fill the thing
2051 {$IF DEFINED(D2F_DEBUG_OTR)}
2052 e_LogWritefln('**px.y0=%s; px.y1=%s; c0=%s; c1=%s; celly0=%s; celly1=%s; [%s..%s]', [px.y0-miny, px.y1-miny, c0, c1, celly0, celly1, c0-celly0, (c0-celly0)+(c1-c0)]);
2053 {$ENDIF}
2054 //assert(c0 <= c1);
2055 FillChar(filled[c0-celly0], c1-c0+1, 1);
2056 end;
2057 end;
2058 // next cell
2059 ccidx := cc.next;
2060 end;
2061 {$IF DEFINED(D2F_DEBUG_OTR)}
2062 s := formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0, ay0, ay1, y0, celly0, celly1, dy]);
2063 for f := 0 to High(filled) do if (filled[f] <> 0) then s += '1' else s += '0';
2064 s += ']';
2065 e_LogWriteln(s);
2066 {$ENDIF}
2067 // now go till we hit cell boundary or empty space
2068 if (dy < 0) then
2069 begin
2070 // up
2071 while (y0 >= celly0) and (filled[y0-celly0] <> 0) do
2072 begin
2073 {$IF DEFINED(D2F_DEBUG_OTR)}
2074 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
2075 {$ENDIF}
2076 Dec(y0);
2077 Dec(ay0);
2078 end;
2079 {$IF DEFINED(D2F_DEBUG_OTR)}
2080 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
2081 {$ENDIF}
2082 if (ay0 <= ay1) then begin ey := ay1; result := false; exit; end;
2083 if (y0 >= celly0) then begin ey := ay0+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result := true; exit; end;
2084 end
2085 else
2086 begin
2087 // down
2088 while (y0 <= celly1) and (filled[y0-celly0] <> 0) do begin Inc(y0); Inc(ay0); end;
2089 if (ay0 >= ay1) then begin ey := ay1; result := false; exit; end;
2090 if (y0 <= celly1) then begin ey := ay0-1; result := true; exit; end;
2091 end;
2092 end;
2093 end
2094 else
2095 begin
2096 // horizontal
2097 assert(false);
2098 end;
2099 end;
2102 // ////////////////////////////////////////////////////////////////////////// //
2103 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
2104 var
2105 ex, ey: Integer;
2106 begin
2107 result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
2108 end;
2111 // no callback: return `true` on the nearest hit
2112 // you are not supposed to understand this
2113 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
2114 var
2115 lw, sweepw: TLineWalker;
2116 ccidx: Integer;
2117 cc: PGridCell;
2118 px: PBodyProxyRec;
2119 lq: LongWord;
2120 f, ptag: Integer;
2121 gw, gh, minx, miny: Integer;
2122 x0, y0: Integer;
2123 x1, y1: Integer;
2124 cx, cy: Integer;
2125 px0, py0, px1, py1: Integer;
2126 lastDistSq, distSq, hx, hy: Integer;
2127 firstCell: Boolean = true;
2128 wasHit: Boolean;
2129 begin
2130 result := Default(ITP);
2131 tagmask := tagmask and TagFullMask;
2132 if (tagmask = 0) then exit;
2134 gw := mWidth;
2135 gh := mHeight;
2136 minx := mMinX;
2137 miny := mMinY;
2139 // make query coords (0,0)-based
2140 x0 := ax0-minx;
2141 y0 := ay0-miny;
2142 x1 := ax1-minx;
2143 y1 := ay1-miny;
2145 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
2146 if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
2148 sweepw := TLineWalker.Create(0, 0, 1, 1); // doesn't matter, just shut ups the compiler
2150 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
2152 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2153 mInQuery := true;
2155 // increase query counter
2156 Inc(mLastQuery);
2157 if (mLastQuery = 0) then
2158 begin
2159 // just in case of overflow
2160 mLastQuery := 1;
2161 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2162 end;
2163 lq := mLastQuery;
2165 repeat
2166 lw.getXY(cx, cy);
2167 // check tile
2168 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
2169 // process cells
2170 wasHit := false;
2171 while (ccidx <> -1) do
2172 begin
2173 cc := @mCells[ccidx];
2174 for f := 0 to GridCellBucketSize-1 do
2175 begin
2176 if (cc.bodies[f] = -1) then break;
2177 px := @mProxies[cc.bodies[f]];
2178 ptag := px.mTag;
2179 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2180 begin
2181 px.mQueryMark := lq; // mark as processed
2182 if assigned(cb) then
2183 begin
2184 if not cb(px.mObj, ptag) then continue;
2185 end;
2186 // get adjusted proxy coords
2187 px0 := px.mX-minx;
2188 py0 := px.mY-miny;
2189 px1 := px0+px.mWidth-1;
2190 py1 := py0+px.mHeight-1;
2191 // inside?
2192 if firstCell and (x0 >= px0) and (y0 >= py0) and (x0 <= px1) and (y0 <= py1) then
2193 begin
2194 // oops
2195 ex := ax0;
2196 ey := ay0;
2197 result := px.mObj;
2198 mInQuery := false;
2199 exit;
2200 end;
2201 // do line-vs-aabb test
2202 sweepw.setClip(px0, py0, px1, py1);
2203 if sweepw.setup(x0, y0, x1, y1) then
2204 begin
2205 // hit detected
2206 sweepw.getPrevXY(hx, hy);
2207 distSq := distanceSq(x0, y0, hx, hy);
2208 if (distSq < lastDistSq) then
2209 begin
2210 lastDistSq := distSq;
2211 ex := hx+minx;
2212 ey := hy+miny;
2213 result := px.mObj;
2214 // if this is not a first cell, get outta here
2215 if not firstCell then begin mInQuery := false; exit; end;
2216 wasHit := true;
2217 end;
2218 end;
2219 end;
2220 end;
2221 // next cell
2222 ccidx := cc.next;
2223 end;
2224 // done processing cells; exit if we registered a hit
2225 // next cells can't have better candidates, obviously
2226 if wasHit then begin mInQuery := false; exit; end;
2227 firstCell := false;
2228 // move to next tile
2229 until lw.stepToNextTile();
2231 mInQuery := false;
2232 end;
2235 // ////////////////////////////////////////////////////////////////////////// //
2236 // no callback: return `true` on the nearest hit
2237 function TBodyGridBase.traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
2238 var
2239 ex, ey: Integer;
2240 begin
2241 result := traceRayOld(ex, ey, x0, y0, x1, y1, cb, tagmask);
2242 end;
2245 // no callback: return `true` on the nearest hit
2246 // you are not supposed to understand this
2247 function TBodyGridBase.traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
2248 var
2249 wx0, wy0, wx1, wy1: Integer; // window coordinates
2250 stx, sty: Integer; // "steps" for x and y axes
2251 dsx, dsy: Integer; // "lengthes" for x and y axes
2252 dx2, dy2: Integer; // "double lengthes" for x and y axes
2253 xd, yd: Integer; // current coord
2254 e: Integer; // "error" (as in bresenham algo)
2255 rem: Integer;
2256 term: Integer;
2257 xptr, yptr: PInteger;
2258 xfixed: Boolean;
2259 temp: Integer;
2260 prevx, prevy: Integer;
2261 lastDistSq: Integer;
2262 ccidx, curci: Integer;
2263 hasUntried: Boolean;
2264 lastGA: Integer = -1;
2265 ga, x, y: Integer;
2266 lastObj: ITP;
2267 wasHit: Boolean = false;
2268 gw, gh, minx, miny, maxx, maxy: Integer;
2269 cc: PGridCell;
2270 px: PBodyProxyRec;
2271 lq: LongWord;
2272 f, ptag, distSq: Integer;
2273 x0, y0, x1, y1: Integer;
2274 //swapped: Boolean = false; // true: xd is yd, and vice versa
2275 // horizontal walker
2276 {$IFDEF GRID_USE_ORTHO_ACCEL}
2277 wklen, wkstep: Integer;
2278 //wksign: Integer;
2279 hopt: Boolean;
2280 {$ENDIF}
2281 // skipper
2282 xdist, ydist: Integer;
2283 begin
2284 result := Default(ITP);
2285 lastObj := Default(ITP);
2286 tagmask := tagmask and TagFullMask;
2287 ex := ax1; // why not?
2288 ey := ay1; // why not?
2289 if (tagmask = 0) then exit;
2291 if (ax0 = ax1) and (ay0 = ay1) then
2292 begin
2293 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2294 if (result <> nil) then
2295 begin
2296 if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
2297 end;
2298 exit;
2299 end;
2301 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
2303 gw := mWidth;
2304 gh := mHeight;
2305 minx := mMinX;
2306 miny := mMinY;
2307 maxx := gw*mTileSize-1;
2308 maxy := gh*mTileSize-1;
2310 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2311 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);
2312 {$ENDIF}
2314 x0 := ax0;
2315 y0 := ay0;
2316 x1 := ax1;
2317 y1 := ay1;
2319 // offset query coords to (0,0)-based
2320 Dec(x0, minx);
2321 Dec(y0, miny);
2322 Dec(x1, minx);
2323 Dec(y1, miny);
2325 // clip rectange
2326 wx0 := 0;
2327 wy0 := 0;
2328 wx1 := maxx;
2329 wy1 := maxy;
2331 // horizontal setup
2332 if (x0 < x1) then
2333 begin
2334 // from left to right
2335 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2336 stx := 1; // going right
2337 end
2338 else
2339 begin
2340 // from right to left
2341 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2342 stx := -1; // going left
2343 x0 := -x0;
2344 x1 := -x1;
2345 wx0 := -wx0;
2346 wx1 := -wx1;
2347 swapInt(wx0, wx1);
2348 end;
2350 // vertical setup
2351 if (y0 < y1) then
2352 begin
2353 // from top to bottom
2354 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2355 sty := 1; // going down
2356 end
2357 else
2358 begin
2359 // from bottom to top
2360 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2361 sty := -1; // going up
2362 y0 := -y0;
2363 y1 := -y1;
2364 wy0 := -wy0;
2365 wy1 := -wy1;
2366 swapInt(wy0, wy1);
2367 end;
2369 dsx := x1-x0;
2370 dsy := y1-y0;
2372 if (dsx < dsy) then
2373 begin
2374 //swapped := true;
2375 xptr := @yd;
2376 yptr := @xd;
2377 swapInt(x0, y0);
2378 swapInt(x1, y1);
2379 swapInt(dsx, dsy);
2380 swapInt(wx0, wy0);
2381 swapInt(wx1, wy1);
2382 swapInt(stx, sty);
2383 end
2384 else
2385 begin
2386 xptr := @xd;
2387 yptr := @yd;
2388 end;
2390 dx2 := 2*dsx;
2391 dy2 := 2*dsy;
2392 xd := x0;
2393 yd := y0;
2394 e := 2*dsy-dsx;
2395 term := x1;
2397 xfixed := false;
2398 if (y0 < wy0) then
2399 begin
2400 // clip at top
2401 temp := dx2*(wy0-y0)-dsx;
2402 xd += temp div dy2;
2403 rem := temp mod dy2;
2404 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2405 if (xd+1 >= wx0) then
2406 begin
2407 yd := wy0;
2408 e -= rem+dsx;
2409 if (rem > 0) then begin Inc(xd); e += dy2; end;
2410 xfixed := true;
2411 end;
2412 end;
2414 if (not xfixed) and (x0 < wx0) then
2415 begin
2416 // clip at left
2417 temp := dy2*(wx0-x0);
2418 yd += temp div dx2;
2419 rem := temp mod dx2;
2420 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2421 xd := wx0;
2422 e += rem;
2423 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2424 end;
2426 if (y1 > wy1) then
2427 begin
2428 // clip at bottom
2429 temp := dx2*(wy1-y0)+dsx;
2430 term := x0+temp div dy2;
2431 rem := temp mod dy2;
2432 if (rem = 0) then Dec(term);
2433 end;
2435 if (term > wx1) then term := wx1; // clip at right
2437 Inc(term); // draw last point
2438 //if (term = xd) then exit; // this is the only point, get out of here
2440 if (sty = -1) then yd := -yd;
2441 if (stx = -1) then begin xd := -xd; term := -term; end;
2442 dx2 -= dy2;
2444 // first move, to skip starting point
2445 // DON'T DO THIS! loop will take care of that
2446 if (xd = term) then
2447 begin
2448 //FIXME!
2449 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2450 if (result <> nil) then
2451 begin
2452 if assigned(cb) then
2453 begin
2454 if cb(result, ptag, ax0, ay0, ax0, ay0) then
2455 begin
2456 ex := ax0;
2457 ey := ay0;
2458 end
2459 else
2460 begin
2461 result := nil;
2462 end;
2463 end
2464 else
2465 begin
2466 ex := ax0;
2467 ey := ay0;
2468 end;
2469 end;
2470 exit;
2471 end;
2473 prevx := xptr^+minx;
2474 prevy := yptr^+miny;
2475 (*
2476 // move coords
2477 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2478 xd += stx;
2479 // done?
2480 if (xd = term) then exit;
2481 *)
2483 {$IF DEFINED(D2F_DEBUG)}
2484 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*mTileSize) and (yptr^ >= gh*mTileSize) then raise Exception.Create('raycaster internal error (0)');
2485 {$ENDIF}
2486 // DON'T DO THIS! loop will take care of that
2487 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2488 //ccidx := mGrid[lastGA];
2490 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2491 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
2492 {$ENDIF}
2494 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
2496 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2497 mInQuery := true;
2499 // increase query counter
2500 Inc(mLastQuery);
2501 if (mLastQuery = 0) then
2502 begin
2503 // just in case of overflow
2504 mLastQuery := 1;
2505 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2506 end;
2507 lq := mLastQuery;
2509 {$IFDEF GRID_USE_ORTHO_ACCEL}
2510 // if this is strict horizontal/vertical trace, use optimized codepath
2511 if (ax0 = ax1) or (ay0 = ay1) then
2512 begin
2513 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2514 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
2515 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2516 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
2517 hopt := (ay0 = ay1); // horizontal?
2518 if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
2519 {$IF DEFINED(D2F_DEBUG)}
2520 if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
2521 {$ENDIF}
2522 ga := (yptr^ div mTileSize)*gw+(xptr^ div mTileSize);
2523 // one of those will never change
2524 x := xptr^+minx;
2525 y := yptr^+miny;
2526 while (wklen > 0) do
2527 begin
2528 {$IF DEFINED(D2F_DEBUG)}
2529 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
2530 {$ENDIF}
2531 // new tile?
2532 if (ga <> lastGA) then
2533 begin
2534 lastGA := ga;
2535 ccidx := mGrid[lastGA];
2536 // convert coords to map (to avoid ajdusting coords inside the loop)
2537 if hopt then x := xptr^+minx else y := yptr^+miny;
2538 while (ccidx <> -1) do
2539 begin
2540 cc := @mCells[ccidx];
2541 for f := 0 to GridCellBucketSize-1 do
2542 begin
2543 if (cc.bodies[f] = -1) then break;
2544 px := @mProxies[cc.bodies[f]];
2545 ptag := px.mTag;
2546 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
2547 // constant coord should be inside
2548 ((hopt and (y >= px.y0) and (y <= px.y1)) or
2549 ((not hopt) and (x >= px.x0) and (x <= px.x1))) then
2550 begin
2551 px.mQueryMark := lq; // mark as processed
2552 // inside the proxy?
2553 if (hopt and (x > px.x0) and (x < px.x1)) or
2554 ((not hopt) and (y > px.y0) and (y < px.y1)) then
2555 begin
2556 // setup prev[xy]
2557 if assigned(cb) then
2558 begin
2559 if cb(px.mObj, ptag, x, y, x, y) then
2560 begin
2561 result := px.mObj;
2562 ex := x;
2563 ey := y;
2564 mInQuery := false;
2565 exit;
2566 end;
2567 end
2568 else
2569 begin
2570 distSq := distanceSq(ax0, ay0, x, y);
2571 {$IF DEFINED(D2F_DEBUG)}
2572 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]);
2573 {$ENDIF}
2574 if (distSq < lastDistSq) then
2575 begin
2576 ex := x;
2577 ey := y;
2578 result := px.mObj;
2579 mInQuery := false;
2580 exit;
2581 end;
2582 end;
2583 continue;
2584 end;
2585 // remember this hitpoint if it is nearer than an old one
2586 // setup prev[xy]
2587 if hopt then
2588 begin
2589 // horizontal trace
2590 prevy := y;
2591 y := yptr^+miny;
2592 if (stx < 0) then
2593 begin
2594 // going left
2595 if (x < px.x1) then continue; // not on the right edge
2596 x := px.x1;
2597 prevx := x+1;
2598 end
2599 else
2600 begin
2601 // going right
2602 if (x > px.x0) then continue; // not on the left edge
2603 x := px.x0;
2604 prevx := x-1;
2605 end;
2606 end
2607 else
2608 begin
2609 // vertical trace
2610 prevx := x;
2611 x := xptr^+minx;
2612 if (stx < 0) then
2613 begin
2614 // going up
2615 if (y < px.y1) then continue; // not on the bottom edge
2616 y := px.y1;
2617 prevy := x+1;
2618 end
2619 else
2620 begin
2621 // going down
2622 if (y > px.y0) then continue; // not on the top edge
2623 y := px.y0;
2624 prevy := y-1;
2625 end;
2626 end;
2627 if assigned(cb) then
2628 begin
2629 if cb(px.mObj, ptag, x, y, prevx, prevy) then
2630 begin
2631 result := px.mObj;
2632 ex := prevx;
2633 ey := prevy;
2634 mInQuery := false;
2635 exit;
2636 end;
2637 end
2638 else
2639 begin
2640 distSq := distanceSq(ax0, ay0, prevx, prevy);
2641 {$IF DEFINED(D2F_DEBUG)}
2642 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]);
2643 {$ENDIF}
2644 if (distSq < lastDistSq) then
2645 begin
2646 wasHit := true;
2647 lastDistSq := distSq;
2648 ex := prevx;
2649 ey := prevy;
2650 lastObj := px.mObj;
2651 end;
2652 end;
2653 end;
2654 end;
2655 // next cell
2656 ccidx := cc.next;
2657 end;
2658 if wasHit and not assigned(cb) then begin result := lastObj; mInQuery := false; exit; end;
2659 if assigned(cb) and cb(nil, 0, x, y, x, y) then begin result := lastObj; mInQuery := false; exit; end;
2660 end;
2661 // skip to next tile
2662 if hopt then
2663 begin
2664 if (stx > 0) then
2665 begin
2666 // to the right
2667 wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
2668 {$IF DEFINED(D2F_DEBUG)}
2669 if dbgShowTraceLog then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2670 {$ENDIF}
2671 if (wkstep >= wklen) then break;
2672 Inc(xptr^, wkstep);
2673 Inc(ga);
2674 end
2675 else
2676 begin
2677 // to the left
2678 wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
2679 {$IF DEFINED(D2F_DEBUG)}
2680 if dbgShowTraceLog then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2681 {$ENDIF}
2682 if (wkstep >= wklen) then break;
2683 Dec(xptr^, wkstep);
2684 Dec(ga);
2685 end;
2686 end
2687 else
2688 begin
2689 if (stx > 0) then
2690 begin
2691 // to the down
2692 wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
2693 {$IF DEFINED(D2F_DEBUG)}
2694 if dbgShowTraceLog then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2695 {$ENDIF}
2696 if (wkstep >= wklen) then break;
2697 Inc(yptr^, wkstep);
2698 Inc(ga, mWidth);
2699 end
2700 else
2701 begin
2702 // to the up
2703 wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
2704 {$IF DEFINED(D2F_DEBUG)}
2705 if dbgShowTraceLog then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2706 {$ENDIF}
2707 if (wkstep >= wklen) then break;
2708 Dec(yptr^, wkstep);
2709 Dec(ga, mWidth);
2710 end;
2711 end;
2712 Dec(wklen, wkstep);
2713 end;
2714 // we can travel less than one cell
2715 if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
2716 mInQuery := false;
2717 exit;
2718 end;
2719 {$ENDIF}
2721 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2722 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div mTileSize*mTileSize)+minx, (yptr^ div mTileSize*mTileSize)+miny);
2723 {$ENDIF}
2725 //e_LogWritefln('*********************', []);
2726 ccidx := -1;
2727 // can omit checks
2728 while (xd <> term) do
2729 begin
2730 // check cell(s)
2731 {$IF DEFINED(D2F_DEBUG)}
2732 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*mTileSize) and (yptr^ >= gh*mTileSize) then raise Exception.Create('raycaster internal error (0)');
2733 {$ENDIF}
2734 // new tile?
2735 ga := (yptr^ div mTileSize)*gw+(xptr^ div mTileSize);
2736 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2737 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);
2738 {$ENDIF}
2739 if (ga <> lastGA) then
2740 begin
2741 // yes
2742 {$IF DEFINED(D2F_DEBUG)}
2743 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div mTileSize*mTileSize)+minx, (yptr^ div mTileSize*mTileSize)+miny);
2744 {$ENDIF}
2745 if (ccidx <> -1) then
2746 begin
2747 // signal cell completion
2748 if assigned(cb) then
2749 begin
2750 if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
2751 end
2752 else if wasHit then
2753 begin
2754 result := lastObj;
2755 mInQuery := false;
2756 exit;
2757 end;
2758 end;
2759 lastGA := ga;
2760 ccidx := mGrid[lastGA];
2761 end;
2762 // has something to process in this tile?
2763 if (ccidx <> -1) then
2764 begin
2765 // process cell
2766 curci := ccidx;
2767 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
2768 // convert coords to map (to avoid ajdusting coords inside the loop)
2769 x := xptr^+minx;
2770 y := yptr^+miny;
2771 // process cell list
2772 while (curci <> -1) do
2773 begin
2774 cc := @mCells[curci];
2775 for f := 0 to GridCellBucketSize-1 do
2776 begin
2777 if (cc.bodies[f] = -1) then break;
2778 px := @mProxies[cc.bodies[f]];
2779 ptag := px.mTag;
2780 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2781 begin
2782 // can we process this proxy?
2783 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2784 begin
2785 px.mQueryMark := lq; // mark as processed
2786 if assigned(cb) then
2787 begin
2788 if cb(px.mObj, ptag, x, y, prevx, prevy) then
2789 begin
2790 result := px.mObj;
2791 ex := prevx;
2792 ey := prevy;
2793 mInQuery := false;
2794 exit;
2795 end;
2796 end
2797 else
2798 begin
2799 // remember this hitpoint if it is nearer than an old one
2800 distSq := distanceSq(ax0, ay0, prevx, prevy);
2801 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2802 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);
2803 {$ENDIF}
2804 if (distSq < lastDistSq) then
2805 begin
2806 wasHit := true;
2807 lastDistSq := distSq;
2808 ex := prevx;
2809 ey := prevy;
2810 lastObj := px.mObj;
2811 end;
2812 end;
2813 end
2814 else
2815 begin
2816 // this is possibly interesting proxy, set "has more to check" flag
2817 hasUntried := true;
2818 end;
2819 end;
2820 end;
2821 // next cell
2822 curci := cc.next;
2823 end;
2824 // still has something interesting in this cell?
2825 if not hasUntried then
2826 begin
2827 // nope, don't process this cell anymore; signal cell completion
2828 ccidx := -1;
2829 if assigned(cb) then
2830 begin
2831 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
2832 end
2833 else if wasHit then
2834 begin
2835 result := lastObj;
2836 mInQuery := false;
2837 exit;
2838 end;
2839 end;
2840 end;
2841 if (ccidx = -1) then
2842 begin
2843 // move to cell edge, as we have nothing to trace here anymore
2844 if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2845 if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2846 //e_LogWritefln('0: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2847 while (xd <> xdist) and (yd <> ydist) do
2848 begin
2849 // step
2850 xd += stx;
2851 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2852 //e_LogWritefln(' xd=%d; yd=%d', [xd, yd]);
2853 if (xd = term) then break;
2854 end;
2855 //e_LogWritefln('1: swapped=%d; xd=%d; yd=%d; stx=%d; sty=%d; e=%d; dx2=%d; dy2=%d; term=%d; xdist=%d; ydist=%d', [swapped, xd, yd, stx, sty, e, dx2, dy2, term, xdist, ydist]);
2856 if (xd = term) then break;
2857 end;
2858 //putPixel(xptr^, yptr^);
2859 // move coords
2860 prevx := xptr^+minx;
2861 prevy := yptr^+miny;
2862 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2863 xd += stx;
2864 end;
2865 // we can travel less than one cell
2866 if wasHit and not assigned(cb) then
2867 begin
2868 result := lastObj;
2869 end
2870 else
2871 begin
2872 ex := ax1; // why not?
2873 ey := ay1; // why not?
2874 end;
2876 mInQuery := false;
2877 end;
2880 end.