DEADSOFTWARE

moved some geometry functions to shared/geom.pas; TODO: move most of g_basic.pas...
[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 uses
30 mempool;
32 const
33 GridTileSize = 32; // must be power of two!
35 type
36 TBodyProxyId = Integer;
38 generic TBodyGridBase<ITP> = class(TPoolObject)
39 public
40 type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
41 type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
42 type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
44 const TagDisabled = $40000000;
45 const TagFullMask = $3fffffff;
47 private
48 const
49 GridCellBucketSize = 8; // WARNING! can't be less than 2!
51 public
52 type
53 PBodyProxyRec = ^TBodyProxyRec;
54 TBodyProxyRec = record
55 private
56 mX, mY, mWidth, mHeight: Integer; // aabb
57 mQueryMark: LongWord; // was this object visited at this query?
58 mObj: ITP;
59 mTag: Integer; // `TagDisabled` set: disabled ;-)
60 nextLink: TBodyProxyId; // next free or nothing
62 private
63 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
65 function getTag (): Integer; inline;
66 procedure setTag (v: Integer); inline;
68 function getEnabled (): Boolean; inline;
69 procedure setEnabled (v: Boolean); inline;
71 function getX1 (): Integer; inline;
72 function getY1 (): Integer; inline;
74 public
75 property x: Integer read mX;
76 property y: Integer read mY;
77 property width: Integer read mWidth;
78 property height: Integer read mHeight;
79 property tag: Integer read getTag write setTag;
80 property enabled: Boolean read getEnabled write setEnabled;
81 property obj: ITP read mObj;
83 property x0: Integer read mX;
84 property y0: Integer read mY;
85 property x1: Integer read getX1;
86 property y1: Integer read getY1;
87 end;
89 private
90 type
91 PGridCell = ^TGridCell;
92 TGridCell = record
93 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
94 next: Integer; // in this cell; index in mCells
95 end;
97 TCellArray = array of TGridCell;
99 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
101 private
102 //mTileSize: Integer;
103 const mTileSize = GridTileSize;
104 type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
106 public
107 const tileSize = mTileSize;
109 type
110 TAtPointEnumerator = record
111 private
112 mCells: TCellArray;
113 curidx, curbki: Integer;
114 getpx: TGetProxyFn;
115 public
116 constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
117 function MoveNext (): Boolean; inline;
118 function getCurrent (): PBodyProxyRec; inline;
119 property Current: PBodyProxyRec read getCurrent;
120 end;
122 private
123 mMinX, mMinY: Integer; // so grids can start at any origin
124 mWidth, mHeight: Integer; // in tiles
125 mGrid: array of Integer; // mWidth*mHeight, index in mCells
126 mCells: TCellArray; // cell pool
127 mFreeCell: Integer; // first free cell index or -1
128 mLastQuery: LongWord;
129 mUsedCells: Integer;
130 mProxies: array of TBodyProxyRec;
131 mProxyFree: TBodyProxyId; // free
132 mProxyCount: Integer; // currently used
133 mProxyMaxCount: Integer;
134 mInQuery: Boolean;
136 public
137 dbgShowTraceLog: Boolean;
138 {$IF DEFINED(D2F_DEBUG)}
139 dbgRayTraceTileHitCB: TCellQueryCB;
140 {$ENDIF}
142 private
143 function allocCell (): Integer;
144 procedure freeCell (idx: Integer); // `next` is simply overwritten
146 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
147 procedure freeProxy (body: TBodyProxyId);
149 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
151 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
152 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
154 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
155 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
157 function getGridWidthPx (): Integer; inline;
158 function getGridHeightPx (): Integer; inline;
160 function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
162 public
163 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
164 destructor Destroy (); override;
166 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
167 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
169 procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
170 procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
171 procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
173 function insideGrid (x, y: Integer): Boolean; inline;
175 // `false` if `body` is surely invalid
176 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
177 function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
178 function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
180 //WARNING: don't modify grid while any query is in progress (no checks are made!)
181 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
182 // no callback: return `true` on the first hit
183 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
185 //WARNING: don't modify grid while any query is in progress (no checks are made!)
186 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
187 // no callback: return object on the first hit or nil
188 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
190 function atCellInPoint (x, y: Integer): TAtPointEnumerator;
192 //WARNING: don't modify grid while any query is in progress (no checks are made!)
193 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
194 // cb with `(nil)` will be called before processing new tile
195 // no callback: return object of the nearest hit or nil
196 // if `inverted` is true, trace will register bodies *exluding* tagmask
197 //WARNING: don't change tags in callbacks here!
198 function traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
199 function traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
201 //WARNING: don't modify grid while any query is in progress (no checks are made!)
202 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
203 // cb with `(nil)` will be called before processing new tile
204 // no callback: return object of the nearest hit or nil
205 // if `inverted` is true, trace will register bodies *exluding* tagmask
206 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
207 //WARNING: don't change tags in callbacks here!
208 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; overload;
209 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
211 // return `false` if we're still inside at the end
212 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
213 // `true`: endpoint will point at the last "inside" pixel
214 // `false`: endpoint will be (ax1, ay1)
215 //WARNING: don't change tags in callbacks here!
216 function traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
218 //WARNING: don't modify grid while any query is in progress (no checks are made!)
219 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
220 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
221 //WARNING: don't change tags in callbacks here!
222 function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
224 // trace box with the given velocity; return object hit (if any)
225 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
226 //WARNING: don't change tags in callbacks here!
227 function traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
229 // debug
230 procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
231 function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
232 procedure dumpStats ();
234 public
235 //WARNING! no sanity checks!
236 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
238 property gridX0: Integer read mMinX;
239 property gridY0: Integer read mMinY;
240 property gridWidth: Integer read getGridWidthPx; // in pixels
241 property gridHeight: Integer read getGridHeightPx; // in pixels
243 property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
244 end;
247 type
248 // common structure for all line tracers
249 TLineWalker = record
250 public
251 const TileSize = GridTileSize;
253 private
254 wx0, wy0, wx1, wy1: Integer; // window coordinates
255 stx, sty: Integer; // "steps" for x and y axes
256 stleft: Integer; // "steps left"
257 err, errinc, errmax: Integer;
258 xd, yd: Integer; // current coord
259 horiz: Boolean;
261 public
262 // call `setyp` after this
263 constructor Create (minx, miny, maxx, maxy: Integer);
265 procedure setClip (minx, miny, maxx, maxy: Integer); inline;
267 // this will use `w[xy][01]` to clip coords
268 // return `false` if the whole line was clipped away
269 // on `true`, you should process first point, and go on
270 function setup (x0, y0, x1, y1: Integer): Boolean;
272 // call this *after* doing a step
273 // WARNING! if you will do a step when this returns `true`, you will fall into limbo
274 function done (): Boolean; inline;
276 // as you will prolly call `done()` after doing a step anyway, this will do it for you
277 // move to next point, return `true` when the line is complete (i.e. you should stop)
278 function step (): Boolean; inline;
280 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
281 function stepToNextTile (): Boolean; inline;
283 procedure getXY (out ox, oy: Integer); inline;
285 public
286 // current coords
287 property x: Integer read xd;
288 property y: Integer read yd;
289 end;
292 procedure swapInt (var a: Integer; var b: Integer); inline;
293 //function minInt (a, b: Integer): Integer; inline;
294 //function maxInt (a, b: Integer): Integer; inline;
297 implementation
299 uses
300 SysUtils, e_log, g_console, geom, utils;
303 // ////////////////////////////////////////////////////////////////////////// //
304 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
305 //procedure swapInt (var a: Integer; var b: Integer); inline; begin a := a xor b; b := b xor a; a := a xor b; end;
306 //function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
307 //function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
310 // ////////////////////////////////////////////////////////////////////////// //
311 constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer);
312 begin
313 setClip(minx, miny, maxx, maxy);
314 end;
316 procedure TLineWalker.setClip (minx, miny, maxx, maxy: Integer); inline;
317 begin
318 // clip rectange
319 wx0 := minx;
320 wy0 := miny;
321 wx1 := maxx;
322 wy1 := maxy;
323 end;
325 function TLineWalker.setup (x0, y0, x1, y1: Integer): Boolean;
326 var
327 sx0, sy0, sx1, sy1: Single;
328 begin
329 if (wx1 < wx0) or (wy1 < wy0) then begin stleft := 0; xd := x0; yd := y0; result := false; exit; end;
331 if (x0 >= wx0) and (y0 >= wy0) and (x0 <= wx1) and (y0 <= wy1) and
332 (x1 >= wx0) and (y1 >= wy0) and (x1 <= wx1) and (y1 <= wy1) then
333 begin
334 result := true;
335 end
336 else
337 begin
338 sx0 := x0; sy0 := y0;
339 sx1 := x1; sy1 := y1;
340 result := clipLine(sx0, sy0, sx1, sy1, wx0, wy0, wx1, wy1);
341 if not result then begin stleft := 0; xd := x0; yd := y0; exit; end;
342 x0 := trunc(sx0); y0 := trunc(sy0);
343 x1 := trunc(sx1); y1 := trunc(sy1);
344 end;
346 // check for ortho lines
347 if (y0 = y1) then
348 begin
349 // horizontal
350 horiz := true;
351 stleft := abs(x1-x0)+1;
352 if (x0 < x1) then stx := 1 else stx := -1;
353 sty := 0;
354 errinc := 0;
355 errmax := 10; // anything that is greater than zero
356 end
357 else if (x0 = x1) then
358 begin
359 // vertical
360 horiz := false;
361 stleft := abs(y1-y0)+1;
362 stx := 0;
363 if (y0 < y1) then sty := 1 else sty := -1;
364 errinc := 0;
365 errmax := 10; // anything that is greater than zero
366 end
367 else
368 begin
369 // diagonal
370 if (abs(x1-x0) >= abs(y1-y0)) then
371 begin
372 // horizontal
373 horiz := true;
374 stleft := abs(x1-x0)+1;
375 errinc := abs(y1-y0)+1;
376 end
377 else
378 begin
379 // vertical
380 horiz := false;
381 stleft := abs(y1-y0)+1;
382 errinc := abs(x1-x0)+1;
383 end;
384 if (x0 < x1) then stx := 1 else stx := -1;
385 if (y0 < y1) then sty := 1 else sty := -1;
386 errmax := stleft;
387 end;
388 xd := x0;
389 yd := y0;
390 err := -errmax;
391 end;
393 function TLineWalker.done (): Boolean; inline; begin result := (stleft <= 0); end;
395 // true: done
396 function TLineWalker.step (): Boolean; inline;
397 begin
398 if horiz then
399 begin
400 xd += stx;
401 err += errinc;
402 if (err >= 0) then begin err -= errmax; yd += sty; end;
403 end
404 else
405 begin
406 yd += sty;
407 err += errinc;
408 if (err >= 0) then begin err -= errmax; xd += stx; end;
409 end;
410 Dec(stleft);
411 result := (stleft <= 0);
412 end;
414 // true: done
415 function TLineWalker.stepToNextTile (): Boolean; inline;
416 var
417 ex, ey: Integer;
418 xwalk, ywalk, wklen: Integer; // to the respective edges
419 f: Integer;
420 begin
421 result := false;
423 if (stleft < 2) then begin result := true; exit; end; // max one pixel left, nothing to do
425 // strictly horizontal?
426 if (sty = 0) then
427 begin
428 // only xd
429 if (stx < 0) then
430 begin
431 // xd: to left edge
432 ex := (xd and (not (TileSize-1)))-1;
433 stleft -= xd-ex;
434 end
435 else
436 begin
437 // xd: to right edge
438 ex := (xd or (TileSize-1))+1;
439 stleft -= ex-xd;
440 end;
441 result := (stleft <= 0);
442 xd := ex;
443 exit;
444 end;
446 // strictly vertical?
447 if (stx = 0) then
448 begin
449 // only xd
450 if (sty < 0) then
451 begin
452 // yd: to top edge
453 ey := (yd and (not (TileSize-1)))-1;
454 stleft -= yd-ey;
455 end
456 else
457 begin
458 // yd: to bottom edge
459 ey := (yd or (TileSize-1))+1;
460 stleft -= ey-yd;
461 end;
462 result := (stleft <= 0);
463 yd := ey;
464 exit;
465 end;
467 // diagonal
469 // calculate xwalk
470 if (stx < 0) then
471 begin
472 ex := (xd and (not (TileSize-1)))-1;
473 xwalk := xd-ex;
474 end
475 else
476 begin
477 ex := (xd or (TileSize-1))+1;
478 xwalk := ex-xd;
479 end;
481 // calculate ywalk
482 if (sty < 0) then
483 begin
484 ey := (yd and (not (TileSize-1)))-1;
485 ywalk := yd-ey;
486 end
487 else
488 begin
489 ey := (yd or (TileSize-1))+1;
490 ywalk := ey-yd;
491 end;
494 while (xd <> ex) and (yd <> ey) do
495 begin
496 if horiz then
497 begin
498 xd += stx;
499 err += errinc;
500 if (err >= 0) then begin err -= errmax; yd += sty; end;
501 end
502 else
503 begin
504 yd += sty;
505 err += errinc;
506 if (err >= 0) then begin err -= errmax; xd += stx; end;
507 end;
508 Dec(stleft);
509 if (stleft < 1) then begin result := true; exit; end;
510 end;
513 if (xwalk <= ywalk) then wklen := xwalk else wklen := ywalk;
514 while true do
515 begin
516 // in which dir we want to walk?
517 stleft -= wklen;
518 if (stleft <= 0) then begin result := true; exit; end;
519 if horiz then
520 begin
521 xd += wklen*stx;
522 for f := 1 to wklen do
523 begin
524 err += errinc;
525 if (err >= 0) then begin err -= errmax; yd += sty; end;
526 end;
527 end
528 else
529 begin
530 yd += wklen*sty;
531 for f := 1 to wklen do
532 begin
533 err += errinc;
534 if (err >= 0) then begin err -= errmax; xd += stx; end;
535 end;
536 end;
537 // check for walk completion
538 if (xd = ex) or (yd = ey) then exit;
539 wklen := 1;
540 end;
541 end;
543 procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin ox := xd; oy := yd; end;
546 // ////////////////////////////////////////////////////////////////////////// //
547 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
548 begin
549 mX := aX;
550 mY := aY;
551 mWidth := aWidth;
552 mHeight := aHeight;
553 mQueryMark := 0;
554 mObj := aObj;
555 mTag := aTag;
556 nextLink := -1;
557 end;
560 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
561 begin
562 result := mTag and TagFullMask;
563 end;
565 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
566 begin
567 mTag := (mTag and TagDisabled) or (v and TagFullMask);
568 end;
570 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
571 begin
572 result := ((mTag and TagDisabled) = 0);
573 end;
575 procedure TBodyGridBase.TBodyProxyRec.setEnabled (v: Boolean); inline;
576 begin
577 if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled;
578 end;
580 function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline;
581 begin
582 result := mX+mWidth-1;
583 end;
585 function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline;
586 begin
587 result := mY+mHeight-1;
588 end;
591 // ////////////////////////////////////////////////////////////////////////// //
592 constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
593 begin
594 mCells := acells;
595 curidx := aidx;
596 curbki := -1;
597 getpx := agetpx;
598 end;
601 function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline;
602 begin
603 while (curidx <> -1) do
604 begin
605 while (curbki < GridCellBucketSize) do
606 begin
607 Inc(curbki);
608 if (mCells[curidx].bodies[curbki] = -1) then break;
609 result := true;
610 exit;
611 end;
612 curidx := mCells[curidx].next;
613 curbki := -1;
614 end;
615 result := false;
616 end;
619 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
620 begin
621 result := getpx(mCells[curidx].bodies[curbki]);
622 end;
625 // ////////////////////////////////////////////////////////////////////////// //
626 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
627 var
628 idx: Integer;
629 begin
630 dbgShowTraceLog := false;
631 {$IF DEFINED(D2F_DEBUG)}
632 dbgRayTraceTileHitCB := nil;
633 {$ENDIF}
635 if aTileSize < 1 then aTileSize := 1;
636 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
637 mTileSize := aTileSize;
639 if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
640 if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
641 mMinX := aMinPixX;
642 mMinY := aMinPixY;
643 mWidth := (aPixWidth+mTileSize-1) div mTileSize;
644 mHeight := (aPixHeight+mTileSize-1) div mTileSize;
645 SetLength(mGrid, mWidth*mHeight);
646 SetLength(mCells, mWidth*mHeight);
647 SetLength(mProxies, 8192);
648 mFreeCell := 0;
649 // init free list
650 for idx := 0 to High(mCells) do
651 begin
652 mCells[idx].bodies[0] := -1;
653 mCells[idx].bodies[GridCellBucketSize-1] := -1; // "has free room" flag
654 mCells[idx].next := idx+1;
655 end;
656 mCells[High(mCells)].next := -1; // last cell
657 // init grid
658 for idx := 0 to High(mGrid) do mGrid[idx] := -1;
659 // init proxies
660 for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
661 mProxies[High(mProxies)].nextLink := -1;
662 mLastQuery := 0;
663 mUsedCells := 0;
664 mProxyFree := 0;
665 mProxyCount := 0;
666 mProxyMaxCount := 0;
667 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), TMsgType.Notify);
668 end;
671 destructor TBodyGridBase.Destroy ();
672 begin
673 mCells := nil;
674 mGrid := nil;
675 mProxies := nil;
676 inherited;
677 end;
680 // ////////////////////////////////////////////////////////////////////////// //
681 procedure TBodyGridBase.dumpStats ();
682 var
683 idx, mcb, ccidx, cnt: Integer;
684 begin
685 mcb := 0;
686 for idx := 0 to High(mGrid) do
687 begin
688 ccidx := mGrid[idx];
689 cnt := 0;
690 while ccidx >= 0 do
691 begin
692 Inc(cnt);
693 ccidx := mCells[ccidx].next;
694 end;
695 if (mcb < cnt) then mcb := cnt;
696 end;
697 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]), TMsgType.Notify);
698 end;
701 procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB);
702 var
703 g, f, ccidx: Integer;
704 cc: PGridCell;
705 begin
706 if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit;
707 for g := 0 to High(mGrid) do
708 begin
709 ccidx := mGrid[g];
710 while (ccidx <> -1) do
711 begin
712 cc := @mCells[ccidx];
713 for f := 0 to GridCellBucketSize-1 do
714 begin
715 if (cc.bodies[f] = -1) then break;
716 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
717 end;
718 // next cell
719 ccidx := cc.next;
720 end;
721 end;
722 end;
725 function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP;
726 var
727 f, ccidx: Integer;
728 cc: PGridCell;
729 begin
730 result := Default(ITP);
731 if not assigned(cb) then exit;
732 Dec(x, mMinX);
733 Dec(y, mMinY);
734 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit;
735 ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
736 while (ccidx <> -1) do
737 begin
738 cc := @mCells[ccidx];
739 for f := 0 to GridCellBucketSize-1 do
740 begin
741 if (cc.bodies[f] = -1) then break;
742 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
743 end;
744 // next cell
745 ccidx := cc.next;
746 end;
747 end;
750 // ////////////////////////////////////////////////////////////////////////// //
751 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
752 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
755 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
756 begin
757 // fix coords
758 Dec(x, mMinX);
759 Dec(y, mMinY);
760 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
761 end;
764 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
765 begin
766 if (body >= 0) and (body < Length(mProxies)) then
767 begin
768 with mProxies[body] do begin rx := mX; ry := mY; end;
769 result := true;
770 end
771 else
772 begin
773 rx := 0;
774 ry := 0;
775 result := false;
776 end;
777 end;
780 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
781 begin
782 if (body >= 0) and (body < Length(mProxies)) then
783 begin
784 with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
785 result := true;
786 end
787 else
788 begin
789 rw := 0;
790 rh := 0;
791 result := false;
792 end;
793 end;
796 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
797 begin
798 if (body >= 0) and (body < Length(mProxies)) then
799 begin
800 with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
801 result := true;
802 end
803 else
804 begin
805 rx := 0;
806 ry := 0;
807 rw := 0;
808 rh := 0;
809 result := false;
810 end;
811 end;
815 // ////////////////////////////////////////////////////////////////////////// //
816 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
817 begin
818 if (pid >= 0) and (pid < Length(mProxies)) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
819 end;
822 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
823 begin
824 if (pid >= 0) and (pid < Length(mProxies)) then
825 begin
826 if val then
827 begin
828 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
829 end
830 else
831 begin
832 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
833 end;
834 end;
835 end;
838 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
839 begin
840 if (idx >= 0) and (idx < Length(mProxies)) then result := @mProxies[idx] else result := nil;
841 end;
844 // ////////////////////////////////////////////////////////////////////////// //
845 function TBodyGridBase.allocCell (): Integer;
846 var
847 idx: Integer;
848 pc: PGridCell;
849 begin
850 if (mFreeCell < 0) then
851 begin
852 // no free cells, want more
853 mFreeCell := Length(mCells);
854 SetLength(mCells, mFreeCell+32768); // arbitrary number
855 for idx := mFreeCell to High(mCells) do
856 begin
857 mCells[idx].bodies[0] := -1;
858 mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
859 mCells[idx].next := idx+1;
860 end;
861 mCells[High(mCells)].next := -1; // last cell
862 end;
863 result := mFreeCell;
864 pc := @mCells[result];
865 mFreeCell := pc.next;
866 pc.next := -1;
867 Inc(mUsedCells);
868 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
869 end;
872 procedure TBodyGridBase.freeCell (idx: Integer);
873 begin
874 if (idx >= 0) and (idx < Length(mCells)) then
875 begin
876 with mCells[idx] do
877 begin
878 bodies[0] := -1;
879 bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
880 next := mFreeCell;
881 end;
882 mFreeCell := idx;
883 Dec(mUsedCells);
884 end;
885 end;
888 // ////////////////////////////////////////////////////////////////////////// //
889 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
890 var
891 olen, idx: Integer;
892 px: PBodyProxyRec;
893 begin
894 if (mProxyFree = -1) then
895 begin
896 // no free proxies, resize list
897 olen := Length(mProxies);
898 SetLength(mProxies, olen+8192); // arbitrary number
899 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
900 mProxies[High(mProxies)].nextLink := -1;
901 mProxyFree := olen;
902 end;
903 // get one from list
904 result := mProxyFree;
905 px := @mProxies[result];
906 mProxyFree := px.nextLink;
907 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
908 // add to used list
909 px.nextLink := -1;
910 // statistics
911 Inc(mProxyCount);
912 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
913 end;
915 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
916 begin
917 if (body < 0) or (body > High(mProxies)) then exit; // just in case
918 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
919 // add to free list
920 mProxies[body].mObj := nil;
921 mProxies[body].nextLink := mProxyFree;
922 mProxyFree := body;
923 Dec(mProxyCount);
924 end;
927 // ////////////////////////////////////////////////////////////////////////// //
928 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
929 var
930 gw, gh: Integer;
931 ex, ey: Integer;
932 gx, gy: Integer;
933 begin
934 result := false;
935 if (w < 1) or (h < 1) or not assigned(cb) then exit;
936 // fix coords
937 Dec(x, mMinX);
938 Dec(y, mMinY);
939 // go on
940 if (x+w <= 0) or (y+h <= 0) then exit;
941 gw := mWidth;
942 gh := mHeight;
943 if (x >= gw*mTileSize) or (y >= gh*mTileSize) then exit;
944 ex := (x+w-1) div mTileSize;
945 ey := (y+h-1) div mTileSize;
946 x := x div mTileSize;
947 y := y div mTileSize;
948 // clip rect
949 if (x < 0) then x := 0 else if (x >= gw) then x := gw-1;
950 if (y < 0) then y := 0 else if (y >= gh) then y := gh-1;
951 if (ex < 0) then ex := 0 else if (ex >= gw) then ex := gw-1;
952 if (ey < 0) then ey := 0 else if (ey >= gh) then ey := gh-1;
953 if (x > ex) or (y > ey) then exit; // just in case
954 // do the work
955 for gy := y to ey do
956 begin
957 for gx := x to ex do
958 begin
959 result := cb(gy*gw+gx, bodyId);
960 if result then exit;
961 end;
962 end;
963 end;
966 // ////////////////////////////////////////////////////////////////////////// //
967 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
968 var
969 ccidx: Integer;
970 pc: Integer;
971 pi: PGridCell;
972 f: Integer;
973 begin
974 result := false; // never stop
975 // add body to the given grid cell
976 pc := mGrid[grida];
977 if (pc <> -1) then
978 begin
979 {$IF DEFINED(D2F_DEBUG)}
980 ccidx := pc;
981 while (ccidx <> -1) do
982 begin
983 pi := @mCells[ccidx];
984 for f := 0 to GridCellBucketSize-1 do
985 begin
986 if (pi.bodies[f] = -1) then break;
987 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
988 end;
989 ccidx := pi.next;
990 end;
991 {$ENDIF}
992 ccidx := pc;
993 while (ccidx <> -1) do
994 begin
995 pi := @mCells[ccidx];
996 // check "has room" flag
997 if (pi.bodies[GridCellBucketSize-1] = -1) then
998 begin
999 // can add here
1000 for f := 0 to GridCellBucketSize-1 do
1001 begin
1002 if (pi.bodies[f] = -1) then
1003 begin
1004 pi.bodies[f] := bodyId;
1005 if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
1006 exit;
1007 end;
1008 end;
1009 raise Exception.Create('internal error in grid inserter');
1010 end;
1011 // no room, go to next cell in list (if there is any)
1012 ccidx := pi.next;
1013 end;
1014 // no room in cells, add new cell to list
1015 end;
1016 // either no room, or no cell at all
1017 ccidx := allocCell();
1018 pi := @mCells[ccidx];
1019 pi.bodies[0] := bodyId;
1020 pi.bodies[1] := -1;
1021 pi.next := pc;
1022 mGrid[grida] := ccidx;
1023 end;
1026 // assume that we cannot have one object added to bucket twice
1027 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
1028 var
1029 f, c: Integer;
1030 pidx, ccidx: Integer;
1031 pc: PGridCell;
1032 begin
1033 result := false; // never stop
1034 // find and remove cell
1035 pidx := -1; // previous cell index
1036 ccidx := mGrid[grida]; // current cell index
1037 while (ccidx <> -1) do
1038 begin
1039 pc := @mCells[ccidx];
1040 for f := 0 to GridCellBucketSize-1 do
1041 begin
1042 if (pc.bodies[f] = bodyId) then
1043 begin
1044 // i found her!
1045 if (f = 0) and (pc.bodies[1] = -1) then
1046 begin
1047 // this cell contains no elements, remove it
1048 if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
1049 freeCell(ccidx);
1050 exit;
1051 end;
1052 // remove element from bucket
1053 for c := f to GridCellBucketSize-2 do
1054 begin
1055 pc.bodies[c] := pc.bodies[c+1];
1056 if (pc.bodies[c] = -1) then break;
1057 end;
1058 pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
1059 exit;
1060 end;
1061 end;
1062 pidx := ccidx;
1063 ccidx := pc.next;
1064 end;
1065 end;
1068 // ////////////////////////////////////////////////////////////////////////// //
1069 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
1070 begin
1071 aTag := aTag and TagFullMask;
1072 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
1073 //insertInternal(result);
1074 forGridRect(aX, aY, aWidth, aHeight, inserter, result);
1075 end;
1078 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
1079 var
1080 px: PBodyProxyRec;
1081 begin
1082 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1083 px := @mProxies[body];
1084 //removeInternal(body);
1085 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1086 freeProxy(body);
1087 end;
1090 // ////////////////////////////////////////////////////////////////////////// //
1091 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
1092 var
1093 px: PBodyProxyRec;
1094 x0, y0, w, h: Integer;
1095 begin
1096 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1097 px := @mProxies[body];
1098 x0 := px.mX;
1099 y0 := px.mY;
1100 w := px.mWidth;
1101 h := px.mHeight;
1102 {$IF DEFINED(D2F_DEBUG_MOVER)}
1103 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);
1104 {$ENDIF}
1105 if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
1106 // map -> grid
1107 Dec(x0, mMinX);
1108 Dec(y0, mMinY);
1109 Dec(nx, mMinX);
1110 Dec(ny, mMinY);
1111 // did any corner crossed tile boundary?
1112 if (x0 div mTileSize <> nx div mTileSize) or
1113 (y0 div mTileSize <> ny div mTileSize) or
1114 ((x0+w-1) div mTileSize <> (nx+nw-1) div mTileSize) or
1115 ((y0+h-1) div mTileSize <> (ny+nh-1) div mTileSize) then
1116 begin
1117 //writeln('moveResizeBody: cell occupation changed! old=(', x0, ',', y0, ')-(', x0+w-1, ',', y0+h-1, '); new=(', nx, ',', ny, ')-(', nx+nw-1, ',', ny+nh-1, ')');
1118 //removeInternal(body);
1119 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1120 px.mX := nx+mMinX;
1121 px.mY := ny+mMinY;
1122 px.mWidth := nw;
1123 px.mHeight := nh;
1124 //insertInternal(body);
1125 forGridRect(px.mX, px.mY, nw, nh, inserter, body);
1126 end
1127 else
1128 begin
1129 px.mX := nx+mMinX;
1130 px.mY := ny+mMinY;
1131 px.mWidth := nw;
1132 px.mHeight := nh;
1133 end;
1134 end;
1137 //TODO: optimize for horizontal/vertical moves
1138 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
1139 var
1140 px: PBodyProxyRec;
1141 x0, y0: Integer;
1142 ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
1143 ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
1144 gx, gy: Integer;
1145 gw, gh: Integer;
1146 pw, ph: Integer;
1147 begin
1148 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1149 // check if tile coords was changed
1150 px := @mProxies[body];
1151 x0 := px.mX;
1152 y0 := px.mY;
1153 if (nx = x0) and (ny = y0) then exit;
1154 // map -> grid
1155 Dec(x0, mMinX);
1156 Dec(y0, mMinY);
1157 Dec(nx, mMinX);
1158 Dec(ny, mMinY);
1159 // check for heavy work
1160 pw := px.mWidth;
1161 ph := px.mHeight;
1162 ogx0 := x0 div mTileSize;
1163 ogy0 := y0 div mTileSize;
1164 ngx0 := nx div mTileSize;
1165 ngy0 := ny div mTileSize;
1166 ogx1 := (x0+pw-1) div mTileSize;
1167 ogy1 := (y0+ph-1) div mTileSize;
1168 ngx1 := (nx+pw-1) div mTileSize;
1169 ngy1 := (ny+ph-1) div mTileSize;
1170 {$IF DEFINED(D2F_DEBUG_MOVER)}
1171 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);
1172 {$ENDIF}
1173 if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1174 begin
1175 // crossed tile boundary, do heavy work
1176 gw := mWidth;
1177 gh := mHeight;
1178 // cycle with old rect, remove body where it is necessary
1179 // optimized for horizontal moves
1180 {$IF DEFINED(D2F_DEBUG_MOVER)}
1181 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);
1182 {$ENDIF}
1183 // remove stale marks
1184 if not ((ogy0 >= gh) or (ogy1 < 0)) and
1185 not ((ogx0 >= gw) or (ogx1 < 0)) then
1186 begin
1187 if (ogx0 < 0) then ogx0 := 0;
1188 if (ogy0 < 0) then ogy0 := 0;
1189 if (ogx1 > gw-1) then ogx1 := gw-1;
1190 if (ogy1 > gh-1) then ogy1 := gh-1;
1191 {$IF DEFINED(D2F_DEBUG_MOVER)}
1192 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1193 {$ENDIF}
1194 for gx := ogx0 to ogx1 do
1195 begin
1196 if (gx < ngx0) or (gx > ngx1) then
1197 begin
1198 // this column is completely outside of new rect
1199 for gy := ogy0 to ogy1 do
1200 begin
1201 {$IF DEFINED(D2F_DEBUG_MOVER)}
1202 e_WriteLog(Format(' remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1203 {$ENDIF}
1204 remover(gy*gw+gx, body);
1205 end;
1206 end
1207 else
1208 begin
1209 // heavy checks
1210 for gy := ogy0 to ogy1 do
1211 begin
1212 if (gy < ngy0) or (gy > ngy1) then
1213 begin
1214 {$IF DEFINED(D2F_DEBUG_MOVER)}
1215 e_WriteLog(Format(' remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1216 {$ENDIF}
1217 remover(gy*gw+gx, body);
1218 end;
1219 end;
1220 end;
1221 end;
1222 end;
1223 // cycle with new rect, add body where it is necessary
1224 if not ((ngy0 >= gh) or (ngy1 < 0)) and
1225 not ((ngx0 >= gw) or (ngx1 < 0)) then
1226 begin
1227 if (ngx0 < 0) then ngx0 := 0;
1228 if (ngy0 < 0) then ngy0 := 0;
1229 if (ngx1 > gw-1) then ngx1 := gw-1;
1230 if (ngy1 > gh-1) then ngy1 := gh-1;
1231 {$IF DEFINED(D2F_DEBUG_MOVER)}
1232 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1233 {$ENDIF}
1234 for gx := ngx0 to ngx1 do
1235 begin
1236 if (gx < ogx0) or (gx > ogx1) then
1237 begin
1238 // this column is completely outside of old rect
1239 for gy := ngy0 to ngy1 do
1240 begin
1241 {$IF DEFINED(D2F_DEBUG_MOVER)}
1242 e_WriteLog(Format(' insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1243 {$ENDIF}
1244 inserter(gy*gw+gx, body);
1245 end;
1246 end
1247 else
1248 begin
1249 // heavy checks
1250 for gy := ngy0 to ngy1 do
1251 begin
1252 if (gy < ogy0) or (gy > ogy1) then
1253 begin
1254 {$IF DEFINED(D2F_DEBUG_MOVER)}
1255 e_WriteLog(Format(' insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1256 {$ENDIF}
1257 inserter(gy*gw+gx, body);
1258 end;
1259 end;
1260 end;
1261 end;
1262 end;
1263 // done
1264 end
1265 else
1266 begin
1267 {$IF DEFINED(D2F_DEBUG_MOVER)}
1268 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);
1269 {$ENDIF}
1270 end;
1271 // update coordinates
1272 px.mX := nx+mMinX;
1273 px.mY := ny+mMinY;
1274 end;
1277 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1278 var
1279 px: PBodyProxyRec;
1280 x0, y0, w, h: Integer;
1281 begin
1282 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1283 // check if tile coords was changed
1284 px := @mProxies[body];
1285 x0 := px.mX-mMinX;
1286 y0 := px.mY-mMinY;
1287 w := px.mWidth;
1288 h := px.mHeight;
1289 {$IF DEFINED(D2F_DEBUG_MOVER)}
1290 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);
1291 {$ENDIF}
1292 if ((x0+w-1) div mTileSize <> (x0+nw-1) div mTileSize) or
1293 ((y0+h-1) div mTileSize <> (y0+nh-1) div mTileSize) then
1294 begin
1295 // crossed tile boundary, do heavy work
1296 //removeInternal(body);
1297 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1298 px.mWidth := nw;
1299 px.mHeight := nh;
1300 //insertInternal(body);
1301 forGridRect(px.mX, px.mY, nw, nh, inserter, body);
1302 end
1303 else
1304 begin
1305 // nothing to do with the grid, just fix size
1306 px.mWidth := nw;
1307 px.mHeight := nh;
1308 end;
1309 end;
1312 // ////////////////////////////////////////////////////////////////////////// //
1313 function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator;
1314 var
1315 ccidx: Integer = -1;
1316 begin
1317 Dec(x, mMinX);
1318 Dec(y, mMinY);
1319 if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1320 result := TAtPointEnumerator.Create(mCells, ccidx, getProxyById);
1321 end;
1324 // ////////////////////////////////////////////////////////////////////////// //
1325 // no callback: return `true` on the first hit
1326 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1327 var
1328 f: Integer;
1329 idx, curci: Integer;
1330 cc: PGridCell = nil;
1331 px: PBodyProxyRec;
1332 lq: LongWord;
1333 ptag: Integer;
1334 begin
1335 result := Default(ITP);
1336 if (exittag <> nil) then exittag^ := 0;
1337 tagmask := tagmask and TagFullMask;
1338 if (tagmask = 0) then exit;
1340 {$IF DEFINED(D2F_DEBUG_XXQ)}
1341 if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1342 {$ENDIF}
1344 // make coords (0,0)-based
1345 Dec(x, mMinX);
1346 Dec(y, mMinY);
1347 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
1349 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1351 {$IF DEFINED(D2F_DEBUG_XXQ)}
1352 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);
1353 {$ENDIF}
1355 // restore coords
1356 Inc(x, mMinX);
1357 Inc(y, mMinY);
1359 // increase query counter
1360 Inc(mLastQuery);
1361 if (mLastQuery = 0) then
1362 begin
1363 // just in case of overflow
1364 mLastQuery := 1;
1365 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1366 end;
1367 lq := mLastQuery;
1369 {$IF DEFINED(D2F_DEBUG_XXQ)}
1370 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1371 {$ENDIF}
1373 while (curci <> -1) do
1374 begin
1375 {$IF DEFINED(D2F_DEBUG_XXQ)}
1376 if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1377 {$ENDIF}
1378 cc := @mCells[curci];
1379 for f := 0 to GridCellBucketSize-1 do
1380 begin
1381 if (cc.bodies[f] = -1) then break;
1382 px := @mProxies[cc.bodies[f]];
1383 {$IF DEFINED(D2F_DEBUG_XXQ)}
1384 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);
1385 {$ENDIF}
1386 // shit. has to do it this way, so i can change tag in callback
1387 if (px.mQueryMark <> lq) then
1388 begin
1389 px.mQueryMark := lq;
1390 ptag := px.mTag;
1391 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1392 (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1393 begin
1394 if assigned(cb) then
1395 begin
1396 if cb(px.mObj, ptag) then
1397 begin
1398 result := px.mObj;
1399 if (exittag <> nil) then exittag^ := ptag;
1400 exit;
1401 end;
1402 end
1403 else
1404 begin
1405 result := px.mObj;
1406 if (exittag <> nil) then exittag^ := ptag;
1407 exit;
1408 end;
1409 end;
1410 end;
1411 end;
1412 curci := cc.next;
1413 end;
1414 end;
1417 // ////////////////////////////////////////////////////////////////////////// //
1418 // no callback: return `true` on the first hit
1419 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1420 var
1421 idx: Integer;
1422 gx, gy: Integer;
1423 sx, sy, ex, ey: Integer;
1424 curci: Integer;
1425 f: Integer;
1426 cc: PGridCell = nil;
1427 px: PBodyProxyRec;
1428 lq: LongWord;
1429 gw, gh: Integer;
1430 x0, y0: Integer;
1431 ptag: Integer;
1432 begin
1433 result := Default(ITP);
1434 if (w < 1) or (h < 1) then exit;
1435 tagmask := tagmask and TagFullMask;
1436 if (tagmask = 0) then exit;
1438 x0 := x;
1439 y0 := y;
1441 // fix coords
1442 Dec(x, mMinX);
1443 Dec(y, mMinY);
1445 gw := mWidth;
1446 gh := mHeight;
1448 if (x+w <= 0) or (y+h <= 0) then exit;
1449 if (x >= gw*mTileSize) or (y >= gh*mTileSize) then exit;
1451 sx := x div mTileSize;
1452 sy := y div mTileSize;
1453 ex := (x+w-1) div mTileSize;
1454 ey := (y+h-1) div mTileSize;
1456 // clip rect
1457 if (sx < 0) then sx := 0 else if (sx >= gw) then sx := gw-1;
1458 if (sy < 0) then sy := 0 else if (sy >= gh) then sy := gh-1;
1459 if (ex < 0) then ex := 0 else if (ex >= gw) then ex := gw-1;
1460 if (ey < 0) then ey := 0 else if (ey >= gh) then ey := gh-1;
1461 if (sx > ex) or (sy > ey) then exit; // just in case
1463 // has something to do
1464 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1465 mInQuery := true;
1467 // increase query counter
1468 Inc(mLastQuery);
1469 if (mLastQuery = 0) then
1470 begin
1471 // just in case of overflow
1472 mLastQuery := 1;
1473 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1474 end;
1475 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1476 lq := mLastQuery;
1478 // go on
1479 for gy := sy to ey do
1480 begin
1481 for gx := sx to ex do
1482 begin
1483 // process cells
1484 curci := mGrid[gy*gw+gx];
1485 while (curci <> -1) do
1486 begin
1487 cc := @mCells[curci];
1488 for f := 0 to GridCellBucketSize-1 do
1489 begin
1490 if (cc.bodies[f] = -1) then break;
1491 px := @mProxies[cc.bodies[f]];
1492 // shit! has to do it this way, so i can change tag in callback
1493 if (px.mQueryMark = lq) then continue;
1494 px.mQueryMark := lq;
1495 ptag := px.mTag;
1496 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1497 if ((ptag and tagmask) = 0) then continue;
1498 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1499 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1500 if assigned(cb) then
1501 begin
1502 if cb(px.mObj, ptag) then begin result := px.mObj; mInQuery := false; exit; end;
1503 end
1504 else
1505 begin
1506 result := px.mObj;
1507 mInQuery := false;
1508 exit;
1509 end;
1510 end;
1511 curci := cc.next;
1512 end;
1513 end;
1514 end;
1516 mInQuery := false;
1517 end;
1520 // ////////////////////////////////////////////////////////////////////////// //
1521 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1522 var
1523 lw: TLineWalker;
1524 ccidx: Integer;
1525 cc: PGridCell;
1526 px: PBodyProxyRec;
1527 lq: LongWord;
1528 f, ptag: Integer;
1529 gw, gh, minx, miny: Integer;
1530 x0, y0: Integer;
1531 x1, y1: Integer;
1532 cx, cy: Integer;
1533 //px0, py0, px1, py1: Integer;
1534 begin
1535 log := false;
1536 result := Default(ITP);
1537 tagmask := tagmask and TagFullMask;
1538 if (tagmask = 0) or not assigned(cb) then exit;
1540 gw := mWidth;
1541 gh := mHeight;
1542 minx := mMinX;
1543 miny := mMinY;
1545 // make query coords (0,0)-based
1546 x0 := ax0-minx;
1547 y0 := ay0-miny;
1548 x1 := ax1-minx;
1549 y1 := ay1-miny;
1551 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
1552 if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
1554 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1555 mInQuery := true;
1557 // increase query counter
1558 Inc(mLastQuery);
1559 if (mLastQuery = 0) then
1560 begin
1561 // just in case of overflow
1562 mLastQuery := 1;
1563 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1564 end;
1565 lq := mLastQuery;
1567 repeat
1568 lw.getXY(cx, cy);
1569 // check tile
1570 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
1571 // process cells
1572 while (ccidx <> -1) do
1573 begin
1574 cc := @mCells[ccidx];
1575 for f := 0 to GridCellBucketSize-1 do
1576 begin
1577 if (cc.bodies[f] = -1) then break;
1578 px := @mProxies[cc.bodies[f]];
1579 ptag := px.mTag;
1580 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1581 begin
1582 px.mQueryMark := lq; // mark as processed
1583 if cb(px.mObj, ptag) then
1584 begin
1585 result := px.mObj;
1586 mInQuery := false;
1587 exit;
1588 end;
1589 end;
1590 end;
1591 // next cell
1592 ccidx := cc.next;
1593 end;
1594 // done processing cells, move to next tile
1595 until lw.stepToNextTile();
1597 mInQuery := false;
1598 end;
1601 // ////////////////////////////////////////////////////////////////////////// //
1602 // trace box with the given velocity; return object hit (if any)
1603 // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object
1604 function TBodyGridBase.traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
1605 var
1606 gx, gy: Integer;
1607 ccidx: Integer;
1608 cc: PGridCell;
1609 px: PBodyProxyRec;
1610 lq: LongWord;
1611 f, ptag: Integer;
1612 minu0: Single = 100000.0;
1613 u0: Single;
1614 cx0, cy0, cx1, cy1: Integer;
1615 hitpx: PBodyProxyRec = nil;
1616 begin
1617 result := Default(ITP);
1618 ex := ax0+dx;
1619 ey := ay0+dy;
1620 if (aw < 1) or (ah < 1) then exit;
1622 cx0 := nmin(ax0, ax0+dx);
1623 cy0 := nmin(ay0, ay0+dy);
1624 cx1 := nmax(ax0+aw-1, ax0+aw-1+dx);
1625 cy1 := nmax(ay0+ah-1, ay0+ah-1+dy);
1627 cx0 -= mMinX; cy0 -= mMinY;
1628 cx1 -= mMinX; cy1 -= mMinY;
1630 if (cx1 < 0) or (cy1 < 0) or (cx0 >= mWidth*mTileSize) or (cy0 >= mHeight*mTileSize) then exit;
1632 if (cx0 < 0) then cx0 := 0;
1633 if (cy0 < 0) then cy0 := 0;
1634 if (cx1 >= mWidth*mTileSize) then cx1 := mWidth*mTileSize-1;
1635 if (cy1 >= mHeight*mTileSize) then cy1 := mHeight*mTileSize-1;
1636 // just in case
1637 if (cx0 > cx1) or (cy0 > cy1) then exit;
1639 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1640 mInQuery := true;
1642 // increase query counter
1643 Inc(mLastQuery);
1644 if (mLastQuery = 0) then
1645 begin
1646 // just in case of overflow
1647 mLastQuery := 1;
1648 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1649 end;
1650 lq := mLastQuery;
1652 for gy := cy0 div mTileSize to cy1 div mTileSize do
1653 begin
1654 for gx := cx0 div mTileSize to cx1 div mTileSize do
1655 begin
1656 ccidx := mGrid[gy*mWidth+gx];
1657 while (ccidx <> -1) do
1658 begin
1659 cc := @mCells[ccidx];
1660 for f := 0 to GridCellBucketSize-1 do
1661 begin
1662 if (cc.bodies[f] = -1) then break;
1663 px := @mProxies[cc.bodies[f]];
1664 ptag := px.mTag;
1665 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1666 begin
1667 px.mQueryMark := lq; // mark as processed
1668 if assigned(cb) then
1669 begin
1670 if not cb(px.mObj, ptag) then continue;
1671 end;
1672 if not sweepAABB(ax0, ay0, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0) then continue;
1673 if (minu0 > u0) then
1674 begin
1675 hitpx := px;
1676 result := px.mObj;
1677 minu0 := u0;
1678 if (u0 = 0.0) then
1679 begin
1680 ex := ax0;
1681 ey := ay0;
1682 mInQuery := false;
1683 exit;
1684 end;
1685 end;
1686 end;
1687 end;
1688 // next cell
1689 ccidx := cc.next;
1690 end;
1691 end;
1692 end;
1694 if (minu0 <= 1.0) then
1695 begin
1696 ex := ax0+round(dx*minu0);
1697 ey := ay0+round(dy*minu0);
1698 // just in case, compensate for floating point inexactness
1699 if (ex >= hitpx.mX) and (ey >= hitpx.mY) and (ex < hitpx.mX+hitpx.mWidth) and (ey < hitpx.mY+hitpx.mHeight) then
1700 begin
1701 ex := ax0+trunc(dx*minu0);
1702 ey := ay0+trunc(dy*minu0);
1703 end;
1704 end;
1706 mInQuery := false;
1707 end;
1710 // ////////////////////////////////////////////////////////////////////////// //
1711 {.$DEFINE D2F_DEBUG_OTR}
1712 function TBodyGridBase.traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
1713 var
1714 ccidx: Integer;
1715 cc: PGridCell;
1716 px: PBodyProxyRec;
1717 ptag: Integer;
1718 minx, miny: Integer;
1719 f, c0, c1: Integer;
1720 x0, y0, x1, y1: Integer;
1721 celly0, celly1: Integer;
1722 dy: Integer;
1723 filled: array[0..mTileSize-1] of Byte;
1724 {$IF DEFINED(D2F_DEBUG_OTR)}
1725 s: AnsiString = '';
1726 {$ENDIF}
1727 begin
1728 result := false;
1729 ex := ax1;
1730 ey := ay1;
1731 if not ((ax0 = ax1) or (ay0 = ay1)) then raise Exception.Create('orthoray is not orthogonal');
1733 tagmask := tagmask and TagFullMask;
1734 if (tagmask = 0) then exit;
1736 if (forEachAtPoint(ax0, ay0, nil, tagmask) = nil) then exit;
1738 minx := mMinX;
1739 miny := mMinY;
1741 // offset query coords to (0,0)-based
1742 x0 := ax0-minx;
1743 y0 := ay0-miny;
1744 x1 := ax1-minx;
1745 y1 := ay1-miny;
1747 if (x0 = x1) then
1748 begin
1749 if (x0 < 0) or (x0 >= mWidth*mTileSize) then exit; // oops
1750 // vertical
1751 if (y0 < y1) then
1752 begin
1753 // down
1754 if (y1 < 0) or (y0 >= mHeight*mTileSize) then exit;
1755 //if (ay0 < 0) then ay0 := 0;
1756 if (y0 < 0) then exit;
1757 if (y1 >= mHeight*mTileSize) then y1 := mHeight*mTileSize-1;
1758 dy := 1;
1759 end
1760 else
1761 begin
1762 // up
1763 if (y0 < 0) or (y1 >= mHeight*mTileSize) then exit;
1764 //if (ay1 < 0) then ay1 := 0;
1765 if (y1 < 0) then exit;
1766 if (y0 >= mHeight*mTileSize) then y0 := mHeight*mTileSize-1;
1767 dy := -1;
1768 end;
1769 // check tile
1770 while true do
1771 begin
1772 ccidx := mGrid[(y0 div mTileSize)*mWidth+(x0 div mTileSize)];
1773 FillChar(filled, sizeof(filled), 0);
1774 celly0 := y0 and (not (mTileSize-1));
1775 celly1 := celly0+mTileSize-1;
1776 while (ccidx <> -1) do
1777 begin
1778 cc := @mCells[ccidx];
1779 for f := 0 to GridCellBucketSize-1 do
1780 begin
1781 if (cc.bodies[f] = -1) then break;
1782 px := @mProxies[cc.bodies[f]];
1783 ptag := px.mTag;
1784 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1785 (ax0 >= px.x0) and (ax0 <= px.x1) then
1786 begin
1787 // bound c0 and c1 to cell
1788 c0 := nclamp(px.y0-miny, celly0, celly1);
1789 c1 := nclamp(px.y1-miny, celly0, celly1);
1790 // fill the thing
1791 {$IF DEFINED(D2F_DEBUG_OTR)}
1792 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)]);
1793 {$ENDIF}
1794 //assert(c0 <= c1);
1795 FillChar(filled[c0-celly0], c1-c0+1, 1);
1796 end;
1797 end;
1798 // next cell
1799 ccidx := cc.next;
1800 end;
1801 {$IF DEFINED(D2F_DEBUG_OTR)}
1802 s := formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0, ay0, ay1, y0, celly0, celly1, dy]);
1803 for f := 0 to High(filled) do if (filled[f] <> 0) then s += '1' else s += '0';
1804 s += ']';
1805 e_LogWriteln(s);
1806 {$ENDIF}
1807 // now go till we hit cell boundary or empty space
1808 if (dy < 0) then
1809 begin
1810 // up
1811 while (y0 >= celly0) and (filled[y0-celly0] <> 0) do
1812 begin
1813 {$IF DEFINED(D2F_DEBUG_OTR)}
1814 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
1815 {$ENDIF}
1816 Dec(y0);
1817 Dec(ay0);
1818 end;
1819 {$IF DEFINED(D2F_DEBUG_OTR)}
1820 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
1821 {$ENDIF}
1822 if (ay0 <= ay1) then begin ey := ay1; result := false; exit; end;
1823 if (y0 >= celly0) then begin ey := ay0+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result := true; exit; end;
1824 end
1825 else
1826 begin
1827 // down
1828 while (y0 <= celly1) and (filled[y0-celly0] <> 0) do begin Inc(y0); Inc(ay0); end;
1829 if (ay0 >= ay1) then begin ey := ay1; result := false; exit; end;
1830 if (y0 <= celly1) then begin ey := ay0-1; result := true; exit; end;
1831 end;
1832 end;
1833 end
1834 else
1835 begin
1836 // horizontal
1837 assert(false);
1838 end;
1839 end;
1842 // ////////////////////////////////////////////////////////////////////////// //
1843 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
1844 var
1845 ex, ey: Integer;
1846 begin
1847 result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
1848 end;
1851 // no callback: return `true` on the nearest hit
1852 // you are not supposed to understand this
1853 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
1854 var
1855 lw: TLineWalker;
1856 ccidx: Integer;
1857 cc: PGridCell;
1858 px: PBodyProxyRec;
1859 lq: LongWord;
1860 f, ptag: Integer;
1861 gw, gh, minx, miny: Integer;
1862 x0, y0: Integer;
1863 x1, y1: Integer;
1864 cx, cy: Integer;
1865 px0, py0, px1, py1: Integer;
1866 lastDistSq, distSq, hx, hy: Integer;
1867 firstCell: Boolean = true;
1868 wasHit: Boolean;
1869 begin
1870 result := Default(ITP);
1871 tagmask := tagmask and TagFullMask;
1872 if (tagmask = 0) then exit;
1874 gw := mWidth;
1875 gh := mHeight;
1876 minx := mMinX;
1877 miny := mMinY;
1879 // make query coords (0,0)-based
1880 x0 := ax0-minx;
1881 y0 := ay0-miny;
1882 x1 := ax1-minx;
1883 y1 := ay1-miny;
1885 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
1886 if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
1888 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1890 {$IF DEFINED(D2F_DEBUG)}
1891 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]);
1892 {$ENDIF}
1894 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
1895 mInQuery := true;
1897 // increase query counter
1898 Inc(mLastQuery);
1899 if (mLastQuery = 0) then
1900 begin
1901 // just in case of overflow
1902 mLastQuery := 1;
1903 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1904 end;
1905 lq := mLastQuery;
1907 repeat
1908 lw.getXY(cx, cy);
1909 {$IF DEFINED(D2F_DEBUG)}
1910 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB(cx+mMinX, cy+mMinY);
1911 {$ENDIF}
1912 // check tile
1913 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
1914 // process cells
1915 wasHit := false;
1916 while (ccidx <> -1) do
1917 begin
1918 cc := @mCells[ccidx];
1919 for f := 0 to GridCellBucketSize-1 do
1920 begin
1921 if (cc.bodies[f] = -1) then break;
1922 px := @mProxies[cc.bodies[f]];
1923 ptag := px.mTag;
1924 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1925 begin
1926 px.mQueryMark := lq; // mark as processed
1927 if assigned(cb) then
1928 begin
1929 if not cb(px.mObj, ptag) then continue;
1930 end;
1931 // get adjusted proxy coords
1932 px0 := px.mX-minx;
1933 py0 := px.mY-miny;
1934 px1 := px0+px.mWidth-1;
1935 py1 := py0+px.mHeight-1;
1936 {$IF DEFINED(D2F_DEBUG)}
1937 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' cxy=(%s,%s); pan=(%s,%s)-(%s,%s)', [cx, cy, px0, py0, px1, py1]);
1938 {$ENDIF}
1939 // inside?
1940 if firstCell and (x0 >= px0) and (y0 >= py0) and (x0 <= px1) and (y0 <= py1) then
1941 begin
1942 // oops
1943 ex := ax0;
1944 ey := ay0;
1945 result := px.mObj;
1946 mInQuery := false;
1947 {$IF DEFINED(D2F_DEBUG)}
1948 if assigned(dbgRayTraceTileHitCB) then e_LogWriteln(' INSIDE!');
1949 {$ENDIF}
1950 exit;
1951 end;
1952 // do line-vs-aabb test
1953 if lineAABBIntersects(x0, y0, x1, y1, px0, py0, px1-px0+1, py1-py0+1, hx, hy) then
1954 begin
1955 // hit detected
1956 distSq := distanceSq(x0, y0, hx, hy);
1957 {$IF DEFINED(D2F_DEBUG)}
1958 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' hit=(%s,%s); distSq=%s; lastDistSq=%s', [hx, hy, distSq, lastDistSq]);
1959 {$ENDIF}
1960 if (distSq < lastDistSq) then
1961 begin
1962 lastDistSq := distSq;
1963 ex := hx+minx;
1964 ey := hy+miny;
1965 result := px.mObj;
1966 wasHit := true;
1967 end;
1968 end;
1969 end;
1970 end;
1971 // next cell
1972 ccidx := cc.next;
1973 end;
1974 // done processing cells; exit if we registered a hit
1975 // next cells can't have better candidates, obviously
1976 if wasHit then begin mInQuery := false; exit; end;
1977 firstCell := false;
1978 // move to next tile
1979 until lw.stepToNextTile();
1981 mInQuery := false;
1982 end;
1985 // ////////////////////////////////////////////////////////////////////////// //
1986 // no callback: return `true` on the nearest hit
1987 function TBodyGridBase.traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1988 var
1989 ex, ey: Integer;
1990 begin
1991 result := traceRayOld(ex, ey, x0, y0, x1, y1, cb, tagmask);
1992 end;
1995 // no callback: return `true` on the nearest hit
1996 // you are not supposed to understand this
1997 function TBodyGridBase.traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1998 var
1999 wx0, wy0, wx1, wy1: Integer; // window coordinates
2000 stx, sty: Integer; // "steps" for x and y axes
2001 dsx, dsy: Integer; // "lengthes" for x and y axes
2002 dx2, dy2: Integer; // "double lengthes" for x and y axes
2003 xd, yd: Integer; // current coord
2004 e: Integer; // "error" (as in bresenham algo)
2005 rem: Integer;
2006 term: Integer;
2007 xptr, yptr: PInteger;
2008 xfixed: Boolean;
2009 temp: Integer;
2010 prevx, prevy: Integer;
2011 lastDistSq: Integer;
2012 ccidx, curci: Integer;
2013 hasUntried: Boolean;
2014 lastGA: Integer = -1;
2015 ga, x, y: Integer;
2016 lastObj: ITP;
2017 wasHit: Boolean = false;
2018 gw, gh, minx, miny, maxx, maxy: Integer;
2019 cc: PGridCell;
2020 px: PBodyProxyRec;
2021 lq: LongWord;
2022 f, ptag, distSq: Integer;
2023 x0, y0, x1, y1: Integer;
2024 //swapped: Boolean = false; // true: xd is yd, and vice versa
2025 // horizontal walker
2026 {$IFDEF GRID_USE_ORTHO_ACCEL}
2027 wklen, wkstep: Integer;
2028 //wksign: Integer;
2029 hopt: Boolean;
2030 {$ENDIF}
2031 // skipper
2032 xdist, ydist: Integer;
2033 begin
2034 result := Default(ITP);
2035 lastObj := Default(ITP);
2036 tagmask := tagmask and TagFullMask;
2037 ex := ax1; // why not?
2038 ey := ay1; // why not?
2039 if (tagmask = 0) then exit;
2041 if (ax0 = ax1) and (ay0 = ay1) then
2042 begin
2043 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2044 if (result <> nil) then
2045 begin
2046 if assigned(cb) and not cb(result, ptag, ax0, ay0, ax0, ay0) then result := Default(ITP);
2047 end;
2048 exit;
2049 end;
2051 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
2053 gw := mWidth;
2054 gh := mHeight;
2055 minx := mMinX;
2056 miny := mMinY;
2057 maxx := gw*mTileSize-1;
2058 maxy := gh*mTileSize-1;
2060 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2061 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);
2062 {$ENDIF}
2064 x0 := ax0;
2065 y0 := ay0;
2066 x1 := ax1;
2067 y1 := ay1;
2069 // offset query coords to (0,0)-based
2070 Dec(x0, minx);
2071 Dec(y0, miny);
2072 Dec(x1, minx);
2073 Dec(y1, miny);
2075 // clip rectange
2076 wx0 := 0;
2077 wy0 := 0;
2078 wx1 := maxx;
2079 wy1 := maxy;
2081 // horizontal setup
2082 if (x0 < x1) then
2083 begin
2084 // from left to right
2085 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2086 stx := 1; // going right
2087 end
2088 else
2089 begin
2090 // from right to left
2091 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2092 stx := -1; // going left
2093 x0 := -x0;
2094 x1 := -x1;
2095 wx0 := -wx0;
2096 wx1 := -wx1;
2097 swapInt(wx0, wx1);
2098 end;
2100 // vertical setup
2101 if (y0 < y1) then
2102 begin
2103 // from top to bottom
2104 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2105 sty := 1; // going down
2106 end
2107 else
2108 begin
2109 // from bottom to top
2110 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2111 sty := -1; // going up
2112 y0 := -y0;
2113 y1 := -y1;
2114 wy0 := -wy0;
2115 wy1 := -wy1;
2116 swapInt(wy0, wy1);
2117 end;
2119 dsx := x1-x0;
2120 dsy := y1-y0;
2122 if (dsx < dsy) then
2123 begin
2124 //swapped := true;
2125 xptr := @yd;
2126 yptr := @xd;
2127 swapInt(x0, y0);
2128 swapInt(x1, y1);
2129 swapInt(dsx, dsy);
2130 swapInt(wx0, wy0);
2131 swapInt(wx1, wy1);
2132 swapInt(stx, sty);
2133 end
2134 else
2135 begin
2136 xptr := @xd;
2137 yptr := @yd;
2138 end;
2140 dx2 := 2*dsx;
2141 dy2 := 2*dsy;
2142 xd := x0;
2143 yd := y0;
2144 e := 2*dsy-dsx;
2145 term := x1;
2147 xfixed := false;
2148 if (y0 < wy0) then
2149 begin
2150 // clip at top
2151 temp := dx2*(wy0-y0)-dsx;
2152 xd += temp div dy2;
2153 rem := temp mod dy2;
2154 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2155 if (xd+1 >= wx0) then
2156 begin
2157 yd := wy0;
2158 e -= rem+dsx;
2159 //if (rem > 0) then begin Inc(xd); e += dy2; end; //BUGGY
2160 if (xd < wx0) then begin xd += 1; e += dy2; end; //???
2161 xfixed := true;
2162 end;
2163 end;
2165 if (not xfixed) and (x0 < wx0) then
2166 begin
2167 // clip at left
2168 temp := dy2*(wx0-x0);
2169 yd += temp div dx2;
2170 rem := temp mod dx2;
2171 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2172 xd := wx0;
2173 e += rem;
2174 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2175 end;
2177 if (y1 > wy1) then
2178 begin
2179 // clip at bottom
2180 temp := dx2*(wy1-y0)+dsx;
2181 term := x0+temp div dy2;
2182 rem := temp mod dy2;
2183 if (rem = 0) then Dec(term);
2184 end;
2186 if (term > wx1) then term := wx1; // clip at right
2188 Inc(term); // draw last point
2189 //if (term = xd) then exit; // this is the only point, get out of here
2191 if (sty = -1) then yd := -yd;
2192 if (stx = -1) then begin xd := -xd; term := -term; end;
2193 dx2 -= dy2;
2195 // first move, to skip starting point
2196 // DON'T DO THIS! loop will take care of that
2197 if (xd = term) then
2198 begin
2199 //FIXME!
2200 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2201 if (result <> nil) then
2202 begin
2203 if assigned(cb) then
2204 begin
2205 if cb(result, ptag, ax0, ay0, ax0, ay0) then
2206 begin
2207 ex := ax0;
2208 ey := ay0;
2209 end
2210 else
2211 begin
2212 result := nil;
2213 end;
2214 end
2215 else
2216 begin
2217 ex := ax0;
2218 ey := ay0;
2219 end;
2220 end;
2221 exit;
2222 end;
2224 prevx := xptr^+minx;
2225 prevy := yptr^+miny;
2226 (*
2227 // move coords
2228 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2229 xd += stx;
2230 // done?
2231 if (xd = term) then exit;
2232 *)
2234 {$IF DEFINED(D2F_DEBUG)}
2235 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*mTileSize) and (yptr^ >= gh*mTileSize) then raise Exception.Create('raycaster internal error (0)');
2236 {$ENDIF}
2237 // DON'T DO THIS! loop will take care of that
2238 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
2239 //ccidx := mGrid[lastGA];
2241 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2242 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
2243 {$ENDIF}
2245 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
2247 if mInQuery then raise Exception.Create('recursive queries aren''t supported');
2248 mInQuery := true;
2250 // increase query counter
2251 Inc(mLastQuery);
2252 if (mLastQuery = 0) then
2253 begin
2254 // just in case of overflow
2255 mLastQuery := 1;
2256 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2257 end;
2258 lq := mLastQuery;
2260 {$IFDEF GRID_USE_ORTHO_ACCEL}
2261 // if this is strict horizontal/vertical trace, use optimized codepath
2262 if (ax0 = ax1) or (ay0 = ay1) then
2263 begin
2264 // horizontal trace: walk the whole tiles, calculating mindist once for each proxy in cell
2265 // stx < 0: going left, otherwise `stx` is > 0, and we're going right
2266 // vertical trace: walk the whole tiles, calculating mindist once for each proxy in cell
2267 // stx < 0: going up, otherwise `stx` is > 0, and we're going down
2268 hopt := (ay0 = ay1); // horizontal?
2269 if (stx < 0) then begin {wksign := -1;} wklen := -(term-xd); end else begin {wksign := 1;} wklen := term-xd; end;
2270 {$IF DEFINED(D2F_DEBUG)}
2271 if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]);
2272 {$ENDIF}
2273 ga := (yptr^ div mTileSize)*gw+(xptr^ div mTileSize);
2274 // one of those will never change
2275 x := xptr^+minx;
2276 y := yptr^+miny;
2277 while (wklen > 0) do
2278 begin
2279 {$IF DEFINED(D2F_DEBUG)}
2280 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
2281 {$ENDIF}
2282 // new tile?
2283 if (ga <> lastGA) then
2284 begin
2285 lastGA := ga;
2286 ccidx := mGrid[lastGA];
2287 // convert coords to map (to avoid ajdusting coords inside the loop)
2288 if hopt then x := xptr^+minx else y := yptr^+miny;
2289 while (ccidx <> -1) do
2290 begin
2291 cc := @mCells[ccidx];
2292 for f := 0 to GridCellBucketSize-1 do
2293 begin
2294 if (cc.bodies[f] = -1) then break;
2295 px := @mProxies[cc.bodies[f]];
2296 ptag := px.mTag;
2297 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and
2298 // constant coord should be inside
2299 ((hopt and (y >= px.y0) and (y <= px.y1)) or
2300 ((not hopt) and (x >= px.x0) and (x <= px.x1))) then
2301 begin
2302 px.mQueryMark := lq; // mark as processed
2303 // inside the proxy?
2304 if (hopt and (x > px.x0) and (x < px.x1)) or
2305 ((not hopt) and (y > px.y0) and (y < px.y1)) then
2306 begin
2307 // setup prev[xy]
2308 if assigned(cb) then
2309 begin
2310 if cb(px.mObj, ptag, x, y, x, y) then
2311 begin
2312 result := px.mObj;
2313 ex := x;
2314 ey := y;
2315 mInQuery := false;
2316 exit;
2317 end;
2318 end
2319 else
2320 begin
2321 distSq := distanceSq(ax0, ay0, x, y);
2322 {$IF DEFINED(D2F_DEBUG)}
2323 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]);
2324 {$ENDIF}
2325 if (distSq < lastDistSq) then
2326 begin
2327 ex := x;
2328 ey := y;
2329 result := px.mObj;
2330 mInQuery := false;
2331 exit;
2332 end;
2333 end;
2334 continue;
2335 end;
2336 // remember this hitpoint if it is nearer than an old one
2337 // setup prev[xy]
2338 if hopt then
2339 begin
2340 // horizontal trace
2341 prevy := y;
2342 y := yptr^+miny;
2343 if (stx < 0) then
2344 begin
2345 // going left
2346 if (x < px.x1) then continue; // not on the right edge
2347 x := px.x1;
2348 prevx := x+1;
2349 end
2350 else
2351 begin
2352 // going right
2353 if (x > px.x0) then continue; // not on the left edge
2354 x := px.x0;
2355 prevx := x-1;
2356 end;
2357 end
2358 else
2359 begin
2360 // vertical trace
2361 prevx := x;
2362 x := xptr^+minx;
2363 if (stx < 0) then
2364 begin
2365 // going up
2366 if (y < px.y1) then continue; // not on the bottom edge
2367 y := px.y1;
2368 prevy := x+1;
2369 end
2370 else
2371 begin
2372 // going down
2373 if (y > px.y0) then continue; // not on the top edge
2374 y := px.y0;
2375 prevy := y-1;
2376 end;
2377 end;
2378 if assigned(cb) then
2379 begin
2380 if cb(px.mObj, ptag, x, y, prevx, prevy) then
2381 begin
2382 result := px.mObj;
2383 ex := prevx;
2384 ey := prevy;
2385 mInQuery := false;
2386 exit;
2387 end;
2388 end
2389 else
2390 begin
2391 distSq := distanceSq(ax0, ay0, prevx, prevy);
2392 {$IF DEFINED(D2F_DEBUG)}
2393 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]);
2394 {$ENDIF}
2395 if (distSq < lastDistSq) then
2396 begin
2397 wasHit := true;
2398 lastDistSq := distSq;
2399 ex := prevx;
2400 ey := prevy;
2401 lastObj := px.mObj;
2402 end;
2403 end;
2404 end;
2405 end;
2406 // next cell
2407 ccidx := cc.next;
2408 end;
2409 if wasHit and not assigned(cb) then begin result := lastObj; mInQuery := false; exit; end;
2410 if assigned(cb) and cb(nil, 0, x, y, x, y) then begin result := lastObj; mInQuery := false; exit; end;
2411 end;
2412 // skip to next tile
2413 if hopt then
2414 begin
2415 if (stx > 0) then
2416 begin
2417 // to the right
2418 wkstep := ((xptr^ or (mTileSize-1))+1)-xptr^;
2419 {$IF DEFINED(D2F_DEBUG)}
2420 if dbgShowTraceLog then e_LogWritefln(' right step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2421 {$ENDIF}
2422 if (wkstep >= wklen) then break;
2423 Inc(xptr^, wkstep);
2424 Inc(ga);
2425 end
2426 else
2427 begin
2428 // to the left
2429 wkstep := xptr^-((xptr^ and (not (mTileSize-1)))-1);
2430 {$IF DEFINED(D2F_DEBUG)}
2431 if dbgShowTraceLog then e_LogWritefln(' left step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2432 {$ENDIF}
2433 if (wkstep >= wklen) then break;
2434 Dec(xptr^, wkstep);
2435 Dec(ga);
2436 end;
2437 end
2438 else
2439 begin
2440 if (stx > 0) then
2441 begin
2442 // to the down
2443 wkstep := ((yptr^ or (mTileSize-1))+1)-yptr^;
2444 {$IF DEFINED(D2F_DEBUG)}
2445 if dbgShowTraceLog then e_LogWritefln(' down step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2446 {$ENDIF}
2447 if (wkstep >= wklen) then break;
2448 Inc(yptr^, wkstep);
2449 Inc(ga, mWidth);
2450 end
2451 else
2452 begin
2453 // to the up
2454 wkstep := yptr^-((yptr^ and (not (mTileSize-1)))-1);
2455 {$IF DEFINED(D2F_DEBUG)}
2456 if dbgShowTraceLog then e_LogWritefln(' up step: wklen=%d; wkstep=%d', [wklen, wkstep]);
2457 {$ENDIF}
2458 if (wkstep >= wklen) then break;
2459 Dec(yptr^, wkstep);
2460 Dec(ga, mWidth);
2461 end;
2462 end;
2463 Dec(wklen, wkstep);
2464 end;
2465 // we can travel less than one cell
2466 if wasHit and not assigned(cb) then result := lastObj else begin ex := ax1; ey := ay1; end;
2467 mInQuery := false;
2468 exit;
2469 end;
2470 {$ENDIF}
2472 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2473 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div mTileSize*mTileSize)+minx, (yptr^ div mTileSize*mTileSize)+miny);
2474 {$ENDIF}
2476 //e_LogWritefln('*********************', []);
2477 ccidx := -1;
2478 // can omit checks
2479 while (xd <> term) do
2480 begin
2481 // check cell(s)
2482 {$IF DEFINED(D2F_DEBUG)}
2483 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*mTileSize) and (yptr^ >= gh*mTileSize) then raise Exception.Create('raycaster internal error (0)');
2484 {$ENDIF}
2485 // new tile?
2486 ga := (yptr^ div mTileSize)*gw+(xptr^ div mTileSize);
2487 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2488 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);
2489 {$ENDIF}
2490 if (ga <> lastGA) then
2491 begin
2492 // yes
2493 {$IF DEFINED(D2F_DEBUG)}
2494 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div mTileSize*mTileSize)+minx, (yptr^ div mTileSize*mTileSize)+miny);
2495 {$ENDIF}
2496 if (ccidx <> -1) then
2497 begin
2498 // signal cell completion
2499 if assigned(cb) then
2500 begin
2501 if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
2502 end
2503 else if wasHit then
2504 begin
2505 result := lastObj;
2506 mInQuery := false;
2507 exit;
2508 end;
2509 end;
2510 lastGA := ga;
2511 ccidx := mGrid[lastGA];
2512 end;
2513 // has something to process in this tile?
2514 if (ccidx <> -1) then
2515 begin
2516 // process cell
2517 curci := ccidx;
2518 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
2519 // convert coords to map (to avoid ajdusting coords inside the loop)
2520 x := xptr^+minx;
2521 y := yptr^+miny;
2522 // process cell list
2523 while (curci <> -1) do
2524 begin
2525 cc := @mCells[curci];
2526 for f := 0 to GridCellBucketSize-1 do
2527 begin
2528 if (cc.bodies[f] = -1) then break;
2529 px := @mProxies[cc.bodies[f]];
2530 ptag := px.mTag;
2531 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
2532 begin
2533 // can we process this proxy?
2534 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2535 begin
2536 px.mQueryMark := lq; // mark as processed
2537 if assigned(cb) then
2538 begin
2539 if cb(px.mObj, ptag, x, y, prevx, prevy) then
2540 begin
2541 result := px.mObj;
2542 ex := prevx;
2543 ey := prevy;
2544 mInQuery := false;
2545 exit;
2546 end;
2547 end
2548 else
2549 begin
2550 // remember this hitpoint if it is nearer than an old one
2551 distSq := distanceSq(ax0, ay0, prevx, prevy);
2552 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
2553 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);
2554 {$ENDIF}
2555 if (distSq < lastDistSq) then
2556 begin
2557 wasHit := true;
2558 lastDistSq := distSq;
2559 ex := prevx;
2560 ey := prevy;
2561 lastObj := px.mObj;
2562 end;
2563 end;
2564 end
2565 else
2566 begin
2567 // this is possibly interesting proxy, set "has more to check" flag
2568 hasUntried := true;
2569 end;
2570 end;
2571 end;
2572 // next cell
2573 curci := cc.next;
2574 end;
2575 // still has something interesting in this cell?
2576 if not hasUntried then
2577 begin
2578 // nope, don't process this cell anymore; signal cell completion
2579 ccidx := -1;
2580 if assigned(cb) then
2581 begin
2582 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; mInQuery := false; exit; end;
2583 end
2584 else if wasHit then
2585 begin
2586 result := lastObj;
2587 mInQuery := false;
2588 exit;
2589 end;
2590 end;
2591 end;
2592 if (ccidx = -1) then
2593 begin
2594 // move to cell edge, as we have nothing to trace here anymore
2595 if (stx < 0) then xdist := xd and (not (mTileSize-1)) else xdist := xd or (mTileSize-1);
2596 if (sty < 0) then ydist := yd and (not (mTileSize-1)) else ydist := yd or (mTileSize-1);
2597 //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]);
2598 while (xd <> xdist) and (yd <> ydist) do
2599 begin
2600 // step
2601 xd += stx;
2602 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2603 //e_LogWritefln(' xd=%d; yd=%d', [xd, yd]);
2604 if (xd = term) then break;
2605 end;
2606 //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]);
2607 if (xd = term) then break;
2608 end;
2609 //putPixel(xptr^, yptr^);
2610 // move coords
2611 prevx := xptr^+minx;
2612 prevy := yptr^+miny;
2613 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2614 xd += stx;
2615 end;
2616 // we can travel less than one cell
2617 if wasHit and not assigned(cb) then
2618 begin
2619 result := lastObj;
2620 end
2621 else
2622 begin
2623 ex := ax1; // why not?
2624 ey := ay1; // why not?
2625 end;
2627 mInQuery := false;
2628 end;
2631 end.