DEADSOFTWARE

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