DEADSOFTWARE

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