DEADSOFTWARE

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