DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob


79b87ca5a4bf44859ea618fac4f29aec91fd1e28
[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;
26
27 interface
28
29 uses
30 mempool;
31
32 (*
33 * In order to make this usable for kind-of-recursive calls,
34 * we'll use "frame memory pool" to return results. That is,
35 * we will allocate a memory pool that will be cleared on
36 * frame start, and then used as a simple "no-free" allocator.
37 * Grid will put results into this pool, and will never bother
38 * to free it. Caller should call "release" on result, and
39 * the pool will throw away everything.
40 * No more callbacks, of course.
41 *)
42
43 const
44 GridTileSize = 32; // must be power of two!
45
46 type
47 PGridCellCoord = ^TGridCellCoord;
48 TGridCellCoord = record
49 x, y: Integer;
50 end;
51
52 CellCoordIter = specialize PoolIter<TGridCellCoord>;
53
54
55 type
56 TBodyProxyId = Integer;
57
58 generic TBodyGridBase<ITP> = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
59 public
60 type PITP = ^ITP;
61 type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords
62
63 type Iter = specialize PoolIter<ITP>;
64
65 const TagDisabled = $40000000;
66 const TagFullMask = $3fffffff;
67
68 private
69 const
70 GridCellBucketSize = 8; // WARNING! can't be less than 2!
71
72 public
73 type
74 PBodyProxyRec = ^TBodyProxyRec;
75 TBodyProxyRec = record
76 private
77 mX, mY, mWidth, mHeight: Integer; // aabb
78 mQueryMark: LongWord; // was this object visited at this query?
79 mObj: ITP;
80 mTag: Integer; // `TagDisabled` set: disabled ;-)
81 nextLink: TBodyProxyId; // next free or nothing
82
83 private
84 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
85
86 function getTag (): Integer; inline;
87 procedure setTag (v: Integer); inline;
88
89 function getEnabled (): Boolean; inline;
90 procedure setEnabled (v: Boolean); inline;
91
92 function getX1 (): Integer; inline;
93 function getY1 (): Integer; inline;
94
95 public
96 property x: Integer read mX;
97 property y: Integer read mY;
98 property width: Integer read mWidth;
99 property height: Integer read mHeight;
100 property tag: Integer read getTag write setTag;
101 property enabled: Boolean read getEnabled write setEnabled;
102 property obj: ITP read mObj;
103
104 property x0: Integer read mX;
105 property y0: Integer read mY;
106 property x1: Integer read getX1;
107 property y1: Integer read getY1;
108 end;
109
110 private
111 type
112 PGridCell = ^TGridCell;
113 TGridCell = record
114 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
115 next: Integer; // in this cell; index in mCells
116 end;
117
118 TCellArray = array of TGridCell;
119
120 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
121
122 private
123 //mTileSize: Integer;
124 const mTileSize = GridTileSize;
125 type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object;
126
127 public
128 const tileSize = mTileSize;
129
130 type
131 TAtPointEnumerator = record
132 private
133 mCells: TCellArray;
134 curidx, curbki: Integer;
135 getpx: TGetProxyFn;
136 public
137 constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn);
138 function MoveNext (): Boolean; inline;
139 function getCurrent (): PBodyProxyRec; inline;
140 property Current: PBodyProxyRec read getCurrent;
141 end;
142
143 private
144 mMinX, mMinY: Integer; // so grids can start at any origin
145 mWidth, mHeight: Integer; // in tiles
146 mGrid: array of Integer; // mWidth*mHeight, index in mCells
147 mCells: TCellArray; // cell pool
148 mFreeCell: Integer; // first free cell index or -1
149 mLastQuery: LongWord;
150 mUsedCells: Integer;
151 mProxies: array of TBodyProxyRec;
152 mProxyFree: TBodyProxyId; // free
153 mProxyCount: Integer; // currently used
154 mProxyMaxCount: Integer;
155
156 public
157 dbgShowTraceLog: Boolean;
158 {$IF DEFINED(D2F_DEBUG)}
159 dbgRayTraceTileHitCB: TCellQueryCB;
160 {$ENDIF}
161
162 private
163 function allocCell (): Integer;
164 procedure freeCell (idx: Integer); // `next` is simply overwritten
165
166 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
167 procedure freeProxy (body: TBodyProxyId);
168
169 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
170
171 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
172 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
173
174 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
175 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
176
177 function getGridWidthPx (): Integer; inline;
178 function getGridHeightPx (): Integer; inline;
179
180 function getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
181
182 public
183 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
184 destructor Destroy (); override;
185
186 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
187 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
188
189 procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
190 procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
191 procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
192
193 function insideGrid (x, y: Integer): Boolean; inline;
194
195 // `false` if `body` is surely invalid
196 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
197 function getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
198 function getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
199
200 // return number of ITP thingys put into frame pool
201 // if `firstHit` is `true`, return on first hit (obviously)
202 function forEachInAABB (x, y, w, h: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Iter;
203
204 // return number of ITP thingys put into frame pool
205 // if `firstHit` is `true`, return on first hit (obviously)
206 function forEachAtPoint (x, y: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Iter;
207
208 function atCellInPoint (x, y: Integer): TAtPointEnumerator;
209
210 // return object of the nearest hit or nil
211 function traceRay (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
212 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
213
214 // return `false` if we're still inside at the end
215 // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown
216 // `true`: endpoint will point at the last "inside" pixel
217 // `false`: endpoint will be (ax1, ay1)
218 function traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
219
220 // trace line along the grid, put all objects from passed cells into frame pool, in no particular order
221 // return number of ITP thingys put into frame pool
222 function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1; log: Boolean=false): Iter;
223
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; tagmask: Integer=-1): ITP;
228
229 // debug
230 function forEachBodyCell (body: TBodyProxyId): CellCoordIter; // this puts `TGridCellCoord` into frame pool for each cell
231 function forEachInCell (x, y: Integer): Iter; // this puts `ITP` into frame pool
232 procedure dumpStats ();
233
234 public
235 //WARNING! no sanity checks!
236 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
237
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
242
243 property proxy[idx: TBodyProxyId]: PBodyProxyRec read getProxyById;
244 end;
245
246
247 type
248 // common structure for all line tracers
249 TLineWalker = record
250 public
251 const TileSize = GridTileSize;
252
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;
260
261 public
262 // call `setyp` after this
263 constructor Create (minx, miny, maxx, maxy: Integer);
264
265 procedure setClip (minx, miny, maxx, maxy: Integer); inline;
266
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;
271
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;
275
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;
279
280 // move to next tile; return `true` if the line is complete (and walker state is undefined then)
281 function stepToNextTile (): Boolean; inline;
282
283 procedure getXY (out ox, oy: Integer); inline;
284
285 public
286 // current coords
287 property x: Integer read xd;
288 property y: Integer read yd;
289 end;
290
291
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;
295
296
297 implementation
298
299 uses
300 SysUtils, e_log, g_console, geom, utils;
301
302
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;
308
309
310 // ////////////////////////////////////////////////////////////////////////// //
311 constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer);
312 begin
313 setClip(minx, miny, maxx, maxy);
314 end;
315
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;
324
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;
330
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;
345
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;
392
393 function TLineWalker.done (): Boolean; inline; begin result := (stleft <= 0); end;
394
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;
413
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;
422
423 if (stleft < 2) then begin result := true; exit; end; // max one pixel left, nothing to do
424
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;
445
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;
466
467 // diagonal
468
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;
480
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;
492
493 {
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;
511 }
512
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;
542
543 procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin ox := xd; oy := yd; end;
544
545
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;
558
559
560 function TBodyGridBase.TBodyProxyRec.getTag (): Integer; inline;
561 begin
562 result := mTag and TagFullMask;
563 end;
564
565 procedure TBodyGridBase.TBodyProxyRec.setTag (v: Integer); inline;
566 begin
567 mTag := (mTag and TagDisabled) or (v and TagFullMask);
568 end;
569
570 function TBodyGridBase.TBodyProxyRec.getEnabled (): Boolean; inline;
571 begin
572 result := ((mTag and TagDisabled) = 0);
573 end;
574
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;
579
580 function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline;
581 begin
582 result := mX+mWidth-1;
583 end;
584
585 function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline;
586 begin
587 result := mY+mHeight-1;
588 end;
589
590
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;
599
600
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;
617
618
619 function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline;
620 begin
621 result := getpx(mCells[curidx].bodies[curbki]);
622 end;
623
624
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}
634 {
635 if aTileSize < 1 then aTileSize := 1;
636 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
637 mTileSize := aTileSize;
638 }
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;
669
670
671 destructor TBodyGridBase.Destroy ();
672 begin
673 mCells := nil;
674 mGrid := nil;
675 mProxies := nil;
676 inherited;
677 end;
678
679
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;
699
700
701 function TBodyGridBase.forEachBodyCell (body: TBodyProxyId): CellCoordIter;
702 var
703 g, f, ccidx: Integer;
704 cc: PGridCell;
705 presobj: PGridCellCoord;
706 begin
707 result := CellCoordIter.Create(framePool);
708 if (body < 0) or (body > High(mProxies)) then begin result.finishIt(); exit; end;
709 for g := 0 to High(mGrid) do
710 begin
711 ccidx := mGrid[g];
712 while (ccidx <> -1) do
713 begin
714 cc := @mCells[ccidx];
715 for f := 0 to GridCellBucketSize-1 do
716 begin
717 if (cc.bodies[f] = -1) then break;
718 if (cc.bodies[f] = body) then
719 begin
720 presobj := PGridCellCoord(framePool.alloc(sizeof(TGridCellCoord)));
721 presobj^.x := (g mod mWidth)*mTileSize+mMinX;
722 presobj^.y := (g div mWidth)*mTileSize+mMinY;
723 //cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
724 end;
725 end;
726 // next cell
727 ccidx := cc.next;
728 end;
729 end;
730 result.finishIt();
731 end;
732
733
734 function TBodyGridBase.forEachInCell (x, y: Integer): Iter;
735 var
736 f, ccidx: Integer;
737 cc: PGridCell;
738 presobj: PITP;
739 begin
740 result := Iter.Create(framePool);
741 Dec(x, mMinX);
742 Dec(y, mMinY);
743 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then begin result.finishIt(); exit; end;
744 ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
745 while (ccidx <> -1) do
746 begin
747 cc := @mCells[ccidx];
748 for f := 0 to GridCellBucketSize-1 do
749 begin
750 if (cc.bodies[f] = -1) then break;
751 //if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
752 presobj := PITP(framePool.alloc(sizeof(ITP)));
753 //presobj^ := mProxies[cc.bodies[f]].mObj;
754 Move(mProxies[cc.bodies[f]].mObj, presobj^, sizeof(ITP));
755 end;
756 // next cell
757 ccidx := cc.next;
758 end;
759 result.finishIt();
760 end;
761
762
763 // ////////////////////////////////////////////////////////////////////////// //
764 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
765 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
766
767
768 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
769 begin
770 // fix coords
771 Dec(x, mMinX);
772 Dec(y, mMinY);
773 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
774 end;
775
776
777 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
778 begin
779 if (body >= 0) and (body < Length(mProxies)) then
780 begin
781 with mProxies[body] do begin rx := mX; ry := mY; end;
782 result := true;
783 end
784 else
785 begin
786 rx := 0;
787 ry := 0;
788 result := false;
789 end;
790 end;
791
792
793 function TBodyGridBase.getBodyWH (body: TBodyProxyId; out rw, rh: Integer): Boolean; inline;
794 begin
795 if (body >= 0) and (body < Length(mProxies)) then
796 begin
797 with mProxies[body] do begin rw := mWidth; rh := mHeight; end;
798 result := true;
799 end
800 else
801 begin
802 rw := 0;
803 rh := 0;
804 result := false;
805 end;
806 end;
807
808
809 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
810 begin
811 if (body >= 0) and (body < Length(mProxies)) then
812 begin
813 with mProxies[body] do begin rx := mX; ry := mY; rw := mWidth; rh := mHeight; end;
814 result := true;
815 end
816 else
817 begin
818 rx := 0;
819 ry := 0;
820 rw := 0;
821 rh := 0;
822 result := false;
823 end;
824 end;
825
826
827
828 // ////////////////////////////////////////////////////////////////////////// //
829 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
830 begin
831 if (pid >= 0) and (pid < Length(mProxies)) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
832 end;
833
834
835 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
836 begin
837 if (pid >= 0) and (pid < Length(mProxies)) then
838 begin
839 if val then
840 begin
841 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
842 end
843 else
844 begin
845 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
846 end;
847 end;
848 end;
849
850
851 function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline;
852 begin
853 if (idx >= 0) and (idx < Length(mProxies)) then result := @mProxies[idx] else result := nil;
854 end;
855
856
857 // ////////////////////////////////////////////////////////////////////////// //
858 function TBodyGridBase.allocCell (): Integer;
859 var
860 idx: Integer;
861 pc: PGridCell;
862 begin
863 if (mFreeCell < 0) then
864 begin
865 // no free cells, want more
866 mFreeCell := Length(mCells);
867 SetLength(mCells, mFreeCell+32768); // arbitrary number
868 for idx := mFreeCell to High(mCells) do
869 begin
870 mCells[idx].bodies[0] := -1;
871 mCells[idx].bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
872 mCells[idx].next := idx+1;
873 end;
874 mCells[High(mCells)].next := -1; // last cell
875 end;
876 result := mFreeCell;
877 pc := @mCells[result];
878 mFreeCell := pc.next;
879 pc.next := -1;
880 Inc(mUsedCells);
881 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
882 end;
883
884
885 procedure TBodyGridBase.freeCell (idx: Integer);
886 begin
887 if (idx >= 0) and (idx < Length(mCells)) then
888 begin
889 with mCells[idx] do
890 begin
891 bodies[0] := -1;
892 bodies[GridCellBucketSize-1] := -1; // 'has free room' flag
893 next := mFreeCell;
894 end;
895 mFreeCell := idx;
896 Dec(mUsedCells);
897 end;
898 end;
899
900
901 // ////////////////////////////////////////////////////////////////////////// //
902 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
903 var
904 olen, idx: Integer;
905 px: PBodyProxyRec;
906 begin
907 if (mProxyFree = -1) then
908 begin
909 // no free proxies, resize list
910 olen := Length(mProxies);
911 SetLength(mProxies, olen+8192); // arbitrary number
912 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
913 mProxies[High(mProxies)].nextLink := -1;
914 mProxyFree := olen;
915 end;
916 // get one from list
917 result := mProxyFree;
918 px := @mProxies[result];
919 mProxyFree := px.nextLink;
920 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
921 // add to used list
922 px.nextLink := -1;
923 // statistics
924 Inc(mProxyCount);
925 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
926 end;
927
928 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
929 begin
930 if (body < 0) or (body > High(mProxies)) then exit; // just in case
931 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
932 // add to free list
933 mProxies[body].mObj := nil;
934 mProxies[body].nextLink := mProxyFree;
935 mProxyFree := body;
936 Dec(mProxyCount);
937 end;
938
939
940 // ////////////////////////////////////////////////////////////////////////// //
941 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
942 var
943 gw, gh: Integer;
944 ex, ey: Integer;
945 gx, gy: Integer;
946 begin
947 result := false;
948 if (w < 1) or (h < 1) or not assigned(cb) then exit;
949 // fix coords
950 Dec(x, mMinX);
951 Dec(y, mMinY);
952 // go on
953 if (x+w <= 0) or (y+h <= 0) then exit;
954 gw := mWidth;
955 gh := mHeight;
956 if (x >= gw*mTileSize) or (y >= gh*mTileSize) then exit;
957 ex := (x+w-1) div mTileSize;
958 ey := (y+h-1) div mTileSize;
959 x := x div mTileSize;
960 y := y div mTileSize;
961 // clip rect
962 if (x < 0) then x := 0 else if (x >= gw) then x := gw-1;
963 if (y < 0) then y := 0 else if (y >= gh) then y := gh-1;
964 if (ex < 0) then ex := 0 else if (ex >= gw) then ex := gw-1;
965 if (ey < 0) then ey := 0 else if (ey >= gh) then ey := gh-1;
966 if (x > ex) or (y > ey) then exit; // just in case
967 // do the work
968 for gy := y to ey do
969 begin
970 for gx := x to ex do
971 begin
972 result := cb(gy*gw+gx, bodyId);
973 if result then exit;
974 end;
975 end;
976 end;
977
978
979 // ////////////////////////////////////////////////////////////////////////// //
980 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
981 var
982 ccidx: Integer;
983 pc: Integer;
984 pi: PGridCell;
985 f: Integer;
986 begin
987 result := false; // never stop
988 // add body to the given grid cell
989 pc := mGrid[grida];
990 if (pc <> -1) then
991 begin
992 {$IF DEFINED(D2F_DEBUG)}
993 ccidx := pc;
994 while (ccidx <> -1) do
995 begin
996 pi := @mCells[ccidx];
997 for f := 0 to GridCellBucketSize-1 do
998 begin
999 if (pi.bodies[f] = -1) then break;
1000 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
1001 end;
1002 ccidx := pi.next;
1003 end;
1004 {$ENDIF}
1005 ccidx := pc;
1006 while (ccidx <> -1) do
1007 begin
1008 pi := @mCells[ccidx];
1009 // check "has room" flag
1010 if (pi.bodies[GridCellBucketSize-1] = -1) then
1011 begin
1012 // can add here
1013 for f := 0 to GridCellBucketSize-1 do
1014 begin
1015 if (pi.bodies[f] = -1) then
1016 begin
1017 pi.bodies[f] := bodyId;
1018 if (f+1 < GridCellBucketSize) then pi.bodies[f+1] := -1;
1019 exit;
1020 end;
1021 end;
1022 raise Exception.Create('internal error in grid inserter');
1023 end;
1024 // no room, go to next cell in list (if there is any)
1025 ccidx := pi.next;
1026 end;
1027 // no room in cells, add new cell to list
1028 end;
1029 // either no room, or no cell at all
1030 ccidx := allocCell();
1031 pi := @mCells[ccidx];
1032 pi.bodies[0] := bodyId;
1033 pi.bodies[1] := -1;
1034 pi.next := pc;
1035 mGrid[grida] := ccidx;
1036 end;
1037
1038
1039 // assume that we cannot have one object added to bucket twice
1040 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
1041 var
1042 f, c: Integer;
1043 pidx, ccidx: Integer;
1044 pc: PGridCell;
1045 begin
1046 result := false; // never stop
1047 // find and remove cell
1048 pidx := -1; // previous cell index
1049 ccidx := mGrid[grida]; // current cell index
1050 while (ccidx <> -1) do
1051 begin
1052 pc := @mCells[ccidx];
1053 for f := 0 to GridCellBucketSize-1 do
1054 begin
1055 if (pc.bodies[f] = bodyId) then
1056 begin
1057 // i found her!
1058 if (f = 0) and (pc.bodies[1] = -1) then
1059 begin
1060 // this cell contains no elements, remove it
1061 if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next;
1062 freeCell(ccidx);
1063 exit;
1064 end;
1065 // remove element from bucket
1066 for c := f to GridCellBucketSize-2 do
1067 begin
1068 pc.bodies[c] := pc.bodies[c+1];
1069 if (pc.bodies[c] = -1) then break;
1070 end;
1071 pc.bodies[GridCellBucketSize-1] := -1; // "has free room" flag
1072 exit;
1073 end;
1074 end;
1075 pidx := ccidx;
1076 ccidx := pc.next;
1077 end;
1078 end;
1079
1080
1081 // ////////////////////////////////////////////////////////////////////////// //
1082 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
1083 begin
1084 aTag := aTag and TagFullMask;
1085 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
1086 //insertInternal(result);
1087 forGridRect(aX, aY, aWidth, aHeight, inserter, result);
1088 end;
1089
1090
1091 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
1092 var
1093 px: PBodyProxyRec;
1094 begin
1095 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1096 px := @mProxies[body];
1097 //removeInternal(body);
1098 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1099 freeProxy(body);
1100 end;
1101
1102
1103 // ////////////////////////////////////////////////////////////////////////// //
1104 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
1105 var
1106 px: PBodyProxyRec;
1107 x0, y0, w, h: Integer;
1108 begin
1109 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1110 px := @mProxies[body];
1111 x0 := px.mX;
1112 y0 := px.mY;
1113 w := px.mWidth;
1114 h := px.mHeight;
1115 {$IF DEFINED(D2F_DEBUG_MOVER)}
1116 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);
1117 {$ENDIF}
1118 if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
1119 // map -> grid
1120 Dec(x0, mMinX);
1121 Dec(y0, mMinY);
1122 Dec(nx, mMinX);
1123 Dec(ny, mMinY);
1124 // did any corner crossed tile boundary?
1125 if (x0 div mTileSize <> nx div mTileSize) or
1126 (y0 div mTileSize <> ny div mTileSize) or
1127 ((x0+w-1) div mTileSize <> (nx+nw-1) div mTileSize) or
1128 ((y0+h-1) div mTileSize <> (ny+nh-1) div mTileSize) then
1129 begin
1130 //writeln('moveResizeBody: cell occupation changed! old=(', x0, ',', y0, ')-(', x0+w-1, ',', y0+h-1, '); new=(', nx, ',', ny, ')-(', nx+nw-1, ',', ny+nh-1, ')');
1131 //removeInternal(body);
1132 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1133 px.mX := nx+mMinX;
1134 px.mY := ny+mMinY;
1135 px.mWidth := nw;
1136 px.mHeight := nh;
1137 //insertInternal(body);
1138 forGridRect(px.mX, px.mY, nw, nh, inserter, body);
1139 end
1140 else
1141 begin
1142 px.mX := nx+mMinX;
1143 px.mY := ny+mMinY;
1144 px.mWidth := nw;
1145 px.mHeight := nh;
1146 end;
1147 end;
1148
1149
1150 //TODO: optimize for horizontal/vertical moves
1151 procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
1152 var
1153 px: PBodyProxyRec;
1154 x0, y0: Integer;
1155 ogx0, ogx1, ogy0, ogy1: Integer; // old grid rect
1156 ngx0, ngx1, ngy0, ngy1: Integer; // new grid rect
1157 gx, gy: Integer;
1158 gw, gh: Integer;
1159 pw, ph: Integer;
1160 begin
1161 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1162 // check if tile coords was changed
1163 px := @mProxies[body];
1164 x0 := px.mX;
1165 y0 := px.mY;
1166 if (nx = x0) and (ny = y0) then exit;
1167 // map -> grid
1168 Dec(x0, mMinX);
1169 Dec(y0, mMinY);
1170 Dec(nx, mMinX);
1171 Dec(ny, mMinY);
1172 // check for heavy work
1173 pw := px.mWidth;
1174 ph := px.mHeight;
1175 ogx0 := x0 div mTileSize;
1176 ogy0 := y0 div mTileSize;
1177 ngx0 := nx div mTileSize;
1178 ngy0 := ny div mTileSize;
1179 ogx1 := (x0+pw-1) div mTileSize;
1180 ogy1 := (y0+ph-1) div mTileSize;
1181 ngx1 := (nx+pw-1) div mTileSize;
1182 ngy1 := (ny+ph-1) div mTileSize;
1183 {$IF DEFINED(D2F_DEBUG_MOVER)}
1184 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);
1185 {$ENDIF}
1186 if (ogx0 <> ngx0) or (ogy0 <> ngy0) or (ogx1 <> ngx1) or (ogy1 <> ngy1) then
1187 begin
1188 // crossed tile boundary, do heavy work
1189 gw := mWidth;
1190 gh := mHeight;
1191 // cycle with old rect, remove body where it is necessary
1192 // optimized for horizontal moves
1193 {$IF DEFINED(D2F_DEBUG_MOVER)}
1194 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);
1195 {$ENDIF}
1196 // remove stale marks
1197 if not ((ogy0 >= gh) or (ogy1 < 0)) and
1198 not ((ogx0 >= gw) or (ogx1 < 0)) then
1199 begin
1200 if (ogx0 < 0) then ogx0 := 0;
1201 if (ogy0 < 0) then ogy0 := 0;
1202 if (ogx1 > gw-1) then ogx1 := gw-1;
1203 if (ogy1 > gh-1) then ogy1 := gh-1;
1204 {$IF DEFINED(D2F_DEBUG_MOVER)}
1205 e_WriteLog(Format(' norm og:(%d,%d)-(%d,%d)', [ogx0, ogy0, ogx1, ogy1]), MSG_NOTIFY);
1206 {$ENDIF}
1207 for gx := ogx0 to ogx1 do
1208 begin
1209 if (gx < ngx0) or (gx > ngx1) then
1210 begin
1211 // this column is completely outside of new rect
1212 for gy := ogy0 to ogy1 do
1213 begin
1214 {$IF DEFINED(D2F_DEBUG_MOVER)}
1215 e_WriteLog(Format(' remove0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1216 {$ENDIF}
1217 remover(gy*gw+gx, body);
1218 end;
1219 end
1220 else
1221 begin
1222 // heavy checks
1223 for gy := ogy0 to ogy1 do
1224 begin
1225 if (gy < ngy0) or (gy > ngy1) then
1226 begin
1227 {$IF DEFINED(D2F_DEBUG_MOVER)}
1228 e_WriteLog(Format(' remove1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1229 {$ENDIF}
1230 remover(gy*gw+gx, body);
1231 end;
1232 end;
1233 end;
1234 end;
1235 end;
1236 // cycle with new rect, add body where it is necessary
1237 if not ((ngy0 >= gh) or (ngy1 < 0)) and
1238 not ((ngx0 >= gw) or (ngx1 < 0)) then
1239 begin
1240 if (ngx0 < 0) then ngx0 := 0;
1241 if (ngy0 < 0) then ngy0 := 0;
1242 if (ngx1 > gw-1) then ngx1 := gw-1;
1243 if (ngy1 > gh-1) then ngy1 := gh-1;
1244 {$IF DEFINED(D2F_DEBUG_MOVER)}
1245 e_WriteLog(Format(' norm ng:(%d,%d)-(%d,%d)', [ngx0, ngy0, ngx1, ngy1]), MSG_NOTIFY);
1246 {$ENDIF}
1247 for gx := ngx0 to ngx1 do
1248 begin
1249 if (gx < ogx0) or (gx > ogx1) then
1250 begin
1251 // this column is completely outside of old rect
1252 for gy := ngy0 to ngy1 do
1253 begin
1254 {$IF DEFINED(D2F_DEBUG_MOVER)}
1255 e_WriteLog(Format(' insert0:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1256 {$ENDIF}
1257 inserter(gy*gw+gx, body);
1258 end;
1259 end
1260 else
1261 begin
1262 // heavy checks
1263 for gy := ngy0 to ngy1 do
1264 begin
1265 if (gy < ogy0) or (gy > ogy1) then
1266 begin
1267 {$IF DEFINED(D2F_DEBUG_MOVER)}
1268 e_WriteLog(Format(' insert1:(%d,%d)', [gx, gy]), MSG_NOTIFY);
1269 {$ENDIF}
1270 inserter(gy*gw+gx, body);
1271 end;
1272 end;
1273 end;
1274 end;
1275 end;
1276 // done
1277 end
1278 else
1279 begin
1280 {$IF DEFINED(D2F_DEBUG_MOVER)}
1281 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);
1282 {$ENDIF}
1283 end;
1284 // update coordinates
1285 px.mX := nx+mMinX;
1286 px.mY := ny+mMinY;
1287 end;
1288
1289
1290 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
1291 var
1292 px: PBodyProxyRec;
1293 x0, y0, w, h: Integer;
1294 begin
1295 if (body < 0) or (body > High(mProxies)) then exit; // just in case
1296 // check if tile coords was changed
1297 px := @mProxies[body];
1298 x0 := px.mX-mMinX;
1299 y0 := px.mY-mMinY;
1300 w := px.mWidth;
1301 h := px.mHeight;
1302 {$IF DEFINED(D2F_DEBUG_MOVER)}
1303 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);
1304 {$ENDIF}
1305 if ((x0+w-1) div mTileSize <> (x0+nw-1) div mTileSize) or
1306 ((y0+h-1) div mTileSize <> (y0+nh-1) div mTileSize) then
1307 begin
1308 // crossed tile boundary, do heavy work
1309 //removeInternal(body);
1310 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
1311 px.mWidth := nw;
1312 px.mHeight := nh;
1313 //insertInternal(body);
1314 forGridRect(px.mX, px.mY, nw, nh, inserter, body);
1315 end
1316 else
1317 begin
1318 // nothing to do with the grid, just fix size
1319 px.mWidth := nw;
1320 px.mHeight := nh;
1321 end;
1322 end;
1323
1324
1325 // ////////////////////////////////////////////////////////////////////////// //
1326 function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator;
1327 var
1328 ccidx: Integer = -1;
1329 begin
1330 Dec(x, mMinX);
1331 Dec(y, mMinY);
1332 if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1333 result := TAtPointEnumerator.Create(mCells, ccidx, getProxyById);
1334 end;
1335
1336
1337 // ////////////////////////////////////////////////////////////////////////// //
1338 // no callback: return `true` on the first hit
1339 function TBodyGridBase.forEachAtPoint (x, y: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Iter;
1340 var
1341 f: Integer;
1342 idx, curci: Integer;
1343 cc: PGridCell = nil;
1344 px: PBodyProxyRec;
1345 lq: LongWord;
1346 ptag: Integer;
1347 presobj: PITP;
1348 begin
1349 result := Iter.Create(framePool);
1350 tagmask := tagmask and TagFullMask;
1351 if (tagmask = 0) then begin result.finishIt(); exit; end;
1352
1353 {$IF DEFINED(D2F_DEBUG_XXQ)}
1354 if (assigned(cb)) then e_WriteLog(Format('0: grid pointquery: (%d,%d)', [x, y]), MSG_NOTIFY);
1355 {$ENDIF}
1356
1357 // make coords (0,0)-based
1358 Dec(x, mMinX);
1359 Dec(y, mMinY);
1360 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then begin result.finishIt(); exit; end;
1361
1362 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
1363
1364 {$IF DEFINED(D2F_DEBUG_XXQ)}
1365 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);
1366 {$ENDIF}
1367
1368 // restore coords
1369 Inc(x, mMinX);
1370 Inc(y, mMinY);
1371
1372 // increase query counter
1373 Inc(mLastQuery);
1374 if (mLastQuery = 0) then
1375 begin
1376 // just in case of overflow
1377 mLastQuery := 1;
1378 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1379 end;
1380 lq := mLastQuery;
1381
1382 {$IF DEFINED(D2F_DEBUG_XXQ)}
1383 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1384 {$ENDIF}
1385
1386 while (curci <> -1) do
1387 begin
1388 {$IF DEFINED(D2F_DEBUG_XXQ)}
1389 //if (assigned(cb)) then e_WriteLog(Format(' cell #%d', [curci]), MSG_NOTIFY);
1390 {$ENDIF}
1391 cc := @mCells[curci];
1392 for f := 0 to GridCellBucketSize-1 do
1393 begin
1394 if (cc.bodies[f] = -1) then break;
1395 px := @mProxies[cc.bodies[f]];
1396 {$IF DEFINED(D2F_DEBUG_XXQ)}
1397 //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);
1398 {$ENDIF}
1399 if (px.mQueryMark = lq) then continue;
1400 px.mQueryMark := lq;
1401 ptag := px.mTag;
1402 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1403 if ((ptag and tagmask) = 0) then continue;
1404 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1405 begin
1406 presobj := PITP(framePool.alloc(sizeof(ITP)));
1407 Move(px.mObj, presobj^, sizeof(ITP));
1408 if (firstHit) then begin result.finishIt(); exit; end;
1409 end;
1410 end;
1411 curci := cc.next;
1412 end;
1413 result.finishIt();
1414 end;
1415
1416
1417 // ////////////////////////////////////////////////////////////////////////// //
1418 // no callback: return `true` on the first hit
1419 // return number of ITP thingys put into frame pool
1420 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; tagmask: Integer=-1; allowDisabled: Boolean=false; firstHit: Boolean=false): Iter;
1421 var
1422 idx: Integer;
1423 gx, gy: Integer;
1424 sx, sy, ex, ey: Integer;
1425 curci: Integer;
1426 f: Integer;
1427 cc: PGridCell = nil;
1428 px: PBodyProxyRec;
1429 lq: LongWord;
1430 gw, gh: Integer;
1431 x0, y0: Integer;
1432 ptag: Integer;
1433 presobj: PITP;
1434 begin
1435 if (w = 1) and (h = 1) then
1436 begin
1437 result := forEachAtPoint(x, y, tagmask, allowDisabled, firstHit);
1438 exit;
1439 end;
1440
1441 result := Iter.Create(framePool);
1442 if (w < 1) or (h < 1) then begin result.finishIt(); exit; end;
1443
1444 tagmask := tagmask and TagFullMask;
1445 if (tagmask = 0) then begin result.finishIt(); exit; end;
1446
1447 x0 := x;
1448 y0 := y;
1449
1450 // fix coords
1451 Dec(x, mMinX);
1452 Dec(y, mMinY);
1453
1454 gw := mWidth;
1455 gh := mHeight;
1456
1457 if (x+w <= 0) or (y+h <= 0) then begin result.finishIt(); exit; end;
1458 if (x >= gw*mTileSize) or (y >= gh*mTileSize) then begin result.finishIt(); exit; end;
1459
1460 sx := x div mTileSize;
1461 sy := y div mTileSize;
1462 ex := (x+w-1) div mTileSize;
1463 ey := (y+h-1) div mTileSize;
1464
1465 // clip rect
1466 if (sx < 0) then sx := 0 else if (sx >= gw) then sx := gw-1;
1467 if (sy < 0) then sy := 0 else if (sy >= gh) then sy := gh-1;
1468 if (ex < 0) then ex := 0 else if (ex >= gw) then ex := gw-1;
1469 if (ey < 0) then ey := 0 else if (ey >= gh) then ey := gh-1;
1470 if (sx > ex) or (sy > ey) then begin result.finishIt(); exit; end; // just in case
1471
1472 // has something to do
1473
1474 // increase query counter
1475 Inc(mLastQuery);
1476 if (mLastQuery = 0) then
1477 begin
1478 // just in case of overflow
1479 mLastQuery := 1;
1480 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
1481 end;
1482 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1483 lq := mLastQuery;
1484
1485 // go on
1486 for gy := sy to ey do
1487 begin
1488 for gx := sx to ex do
1489 begin
1490 // process cells
1491 curci := mGrid[gy*gw+gx];
1492 while (curci <> -1) do
1493 begin
1494 cc := @mCells[curci];
1495 for f := 0 to GridCellBucketSize-1 do
1496 begin
1497 if (cc.bodies[f] = -1) then break;
1498 px := @mProxies[cc.bodies[f]];
1499 // shit! has to do it this way, so i can change tag in callback
1500 if (px.mQueryMark = lq) then continue;
1501 px.mQueryMark := lq;
1502 ptag := px.mTag;
1503 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
1504 if ((ptag and tagmask) = 0) then continue;
1505 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
1506 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
1507 presobj := PITP(framePool.alloc(sizeof(ITP)));
1508 Move(px.mObj, presobj^, sizeof(ITP));
1509 if (firstHit) then begin result.finishIt(); exit; end;
1510 end;
1511 curci := cc.next;
1512 end;
1513 end;
1514 end;
1515 result.finishIt();
1516 end;
1517
1518
1519 // ////////////////////////////////////////////////////////////////////////// //
1520 function TBodyGridBase.forEachAlongLine (ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1; log: Boolean=false): Iter;
1521 var
1522 lw: TLineWalker;
1523 ccidx: Integer;
1524 cc: PGridCell;
1525 px: PBodyProxyRec;
1526 lq: LongWord;
1527 f, ptag: Integer;
1528 gw, gh, minx, miny: Integer;
1529 x0, y0: Integer;
1530 x1, y1: Integer;
1531 cx, cy: Integer;
1532 //px0, py0, px1, py1: Integer;
1533 presobj: PITP;
1534 begin
1535 log := false;
1536 result := Iter.Create(framePool);
1537 tagmask := tagmask and TagFullMask;
1538 if (tagmask = 0) then begin result.finishIt(); exit; end;
1539
1540 gw := mWidth;
1541 gh := mHeight;
1542 minx := mMinX;
1543 miny := mMinY;
1544
1545 // make query coords (0,0)-based
1546 x0 := ax0-minx;
1547 y0 := ay0-miny;
1548 x1 := ax1-minx;
1549 y1 := ay1-miny;
1550
1551 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
1552 if not lw.setup(x0, y0, x1, y1) then begin result.finishIt(); exit; end; // out of screen
1553
1554 // increase query counter
1555 Inc(mLastQuery);
1556 if (mLastQuery = 0) then
1557 begin
1558 // just in case of overflow
1559 mLastQuery := 1;
1560 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1561 end;
1562 lq := mLastQuery;
1563
1564 repeat
1565 lw.getXY(cx, cy);
1566 // check tile
1567 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
1568 // process cells
1569 while (ccidx <> -1) do
1570 begin
1571 cc := @mCells[ccidx];
1572 for f := 0 to GridCellBucketSize-1 do
1573 begin
1574 if (cc.bodies[f] = -1) then break;
1575 px := @mProxies[cc.bodies[f]];
1576 ptag := px.mTag;
1577 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1578 begin
1579 px.mQueryMark := lq; // mark as processed
1580 presobj := PITP(framePool.alloc(sizeof(ITP)));
1581 Move(px.mObj, presobj^, sizeof(ITP));
1582 end;
1583 end;
1584 // next cell
1585 ccidx := cc.next;
1586 end;
1587 // done processing cells, move to next tile
1588 until lw.stepToNextTile();
1589 result.finishIt();
1590 end;
1591
1592
1593 // ////////////////////////////////////////////////////////////////////////// //
1594 // trace box with the given velocity; return object hit (if any)
1595 function TBodyGridBase.traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; tagmask: Integer=-1): ITP;
1596 var
1597 gx, gy: Integer;
1598 ccidx: Integer;
1599 cc: PGridCell;
1600 px: PBodyProxyRec;
1601 lq: LongWord;
1602 f, ptag: Integer;
1603 minu0: Single = 100000.0;
1604 u0: Single;
1605 cx0, cy0, cx1, cy1: Integer;
1606 hitpx: PBodyProxyRec = nil;
1607 begin
1608 result := Default(ITP);
1609 ex := ax0+dx;
1610 ey := ay0+dy;
1611 if (aw < 1) or (ah < 1) then exit;
1612
1613 cx0 := nmin(ax0, ax0+dx);
1614 cy0 := nmin(ay0, ay0+dy);
1615 cx1 := nmax(ax0+aw-1, ax0+aw-1+dx);
1616 cy1 := nmax(ay0+ah-1, ay0+ah-1+dy);
1617
1618 cx0 -= mMinX; cy0 -= mMinY;
1619 cx1 -= mMinX; cy1 -= mMinY;
1620
1621 if (cx1 < 0) or (cy1 < 0) or (cx0 >= mWidth*mTileSize) or (cy0 >= mHeight*mTileSize) then exit;
1622
1623 if (cx0 < 0) then cx0 := 0;
1624 if (cy0 < 0) then cy0 := 0;
1625 if (cx1 >= mWidth*mTileSize) then cx1 := mWidth*mTileSize-1;
1626 if (cy1 >= mHeight*mTileSize) then cy1 := mHeight*mTileSize-1;
1627 // just in case
1628 if (cx0 > cx1) or (cy0 > cy1) then exit;
1629
1630 // increase query counter
1631 Inc(mLastQuery);
1632 if (mLastQuery = 0) then
1633 begin
1634 // just in case of overflow
1635 mLastQuery := 1;
1636 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1637 end;
1638 lq := mLastQuery;
1639
1640 for gy := cy0 div mTileSize to cy1 div mTileSize do
1641 begin
1642 for gx := cx0 div mTileSize to cx1 div mTileSize do
1643 begin
1644 ccidx := mGrid[gy*mWidth+gx];
1645 while (ccidx <> -1) do
1646 begin
1647 cc := @mCells[ccidx];
1648 for f := 0 to GridCellBucketSize-1 do
1649 begin
1650 if (cc.bodies[f] = -1) then break;
1651 px := @mProxies[cc.bodies[f]];
1652 ptag := px.mTag;
1653 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1654 begin
1655 px.mQueryMark := lq; // mark as processed
1656 if not sweepAABB(ax0, ay0, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0) then continue;
1657 if (minu0 > u0) then
1658 begin
1659 hitpx := px;
1660 result := px.mObj;
1661 minu0 := u0;
1662 if (u0 = 0.0) then
1663 begin
1664 ex := ax0;
1665 ey := ay0;
1666 exit;
1667 end;
1668 end;
1669 end;
1670 end;
1671 // next cell
1672 ccidx := cc.next;
1673 end;
1674 end;
1675 end;
1676
1677 if (minu0 <= 1.0) then
1678 begin
1679 ex := ax0+round(dx*minu0);
1680 ey := ay0+round(dy*minu0);
1681 // just in case, compensate for floating point inexactness
1682 if (ex >= hitpx.mX) and (ey >= hitpx.mY) and (ex < hitpx.mX+hitpx.mWidth) and (ey < hitpx.mY+hitpx.mHeight) then
1683 begin
1684 ex := ax0+trunc(dx*minu0);
1685 ey := ay0+trunc(dy*minu0);
1686 end;
1687 end;
1688 end;
1689
1690
1691 // ////////////////////////////////////////////////////////////////////////// //
1692 {.$DEFINE D2F_DEBUG_OTR}
1693 function TBodyGridBase.traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean;
1694 var
1695 ccidx: Integer;
1696 cc: PGridCell;
1697 px: PBodyProxyRec;
1698 ptag: Integer;
1699 minx, miny: Integer;
1700 f, c0, c1: Integer;
1701 x0, y0, x1, y1: Integer;
1702 celly0, celly1: Integer;
1703 dy: Integer;
1704 filled: array[0..mTileSize-1] of Byte;
1705 {$IF DEFINED(D2F_DEBUG_OTR)}
1706 s: AnsiString = '';
1707 {$ENDIF}
1708 it: Iter;
1709 begin
1710 result := false;
1711 ex := ax1;
1712 ey := ay1;
1713 if not ((ax0 = ax1) or (ay0 = ay1)) then raise Exception.Create('orthoray is not orthogonal');
1714
1715 tagmask := tagmask and TagFullMask;
1716 if (tagmask = 0) then exit;
1717
1718 it := forEachAtPoint(ax0, ay0, tagmask, false, true);
1719 if (it.length = 0) then begin it.release(); exit; end;
1720 it.release();
1721
1722 minx := mMinX;
1723 miny := mMinY;
1724
1725 // offset query coords to (0,0)-based
1726 x0 := ax0-minx;
1727 y0 := ay0-miny;
1728 x1 := ax1-minx;
1729 y1 := ay1-miny;
1730
1731 if (x0 = x1) then
1732 begin
1733 if (x0 < 0) or (x0 >= mWidth*mTileSize) then exit; // oops
1734 // vertical
1735 if (y0 < y1) then
1736 begin
1737 // down
1738 if (y1 < 0) or (y0 >= mHeight*mTileSize) then exit;
1739 //if (ay0 < 0) then ay0 := 0;
1740 if (y0 < 0) then exit;
1741 if (y1 >= mHeight*mTileSize) then y1 := mHeight*mTileSize-1;
1742 dy := 1;
1743 end
1744 else
1745 begin
1746 // up
1747 if (y0 < 0) or (y1 >= mHeight*mTileSize) then exit;
1748 //if (ay1 < 0) then ay1 := 0;
1749 if (y1 < 0) then exit;
1750 if (y0 >= mHeight*mTileSize) then y0 := mHeight*mTileSize-1;
1751 dy := -1;
1752 end;
1753 // check tile
1754 while true do
1755 begin
1756 ccidx := mGrid[(y0 div mTileSize)*mWidth+(x0 div mTileSize)];
1757 FillChar(filled, sizeof(filled), 0);
1758 celly0 := y0 and (not (mTileSize-1));
1759 celly1 := celly0+mTileSize-1;
1760 while (ccidx <> -1) do
1761 begin
1762 cc := @mCells[ccidx];
1763 for f := 0 to GridCellBucketSize-1 do
1764 begin
1765 if (cc.bodies[f] = -1) then break;
1766 px := @mProxies[cc.bodies[f]];
1767 ptag := px.mTag;
1768 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and
1769 (ax0 >= px.x0) and (ax0 <= px.x1) then
1770 begin
1771 // bound c0 and c1 to cell
1772 c0 := nclamp(px.y0-miny, celly0, celly1);
1773 c1 := nclamp(px.y1-miny, celly0, celly1);
1774 // fill the thing
1775 {$IF DEFINED(D2F_DEBUG_OTR)}
1776 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)]);
1777 {$ENDIF}
1778 //assert(c0 <= c1);
1779 FillChar(filled[c0-celly0], c1-c0+1, 1);
1780 end;
1781 end;
1782 // next cell
1783 ccidx := cc.next;
1784 end;
1785 {$IF DEFINED(D2F_DEBUG_OTR)}
1786 s := formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0, ay0, ay1, y0, celly0, celly1, dy]);
1787 for f := 0 to High(filled) do if (filled[f] <> 0) then s += '1' else s += '0';
1788 s += ']';
1789 e_LogWriteln(s);
1790 {$ENDIF}
1791 // now go till we hit cell boundary or empty space
1792 if (dy < 0) then
1793 begin
1794 // up
1795 while (y0 >= celly0) and (filled[y0-celly0] <> 0) do
1796 begin
1797 {$IF DEFINED(D2F_DEBUG_OTR)}
1798 e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
1799 {$ENDIF}
1800 Dec(y0);
1801 Dec(ay0);
1802 end;
1803 {$IF DEFINED(D2F_DEBUG_OTR)}
1804 e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]);
1805 {$ENDIF}
1806 if (ay0 <= ay1) then begin ey := ay1; result := false; exit; end;
1807 if (y0 >= celly0) then begin ey := ay0+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result := true; exit; end;
1808 end
1809 else
1810 begin
1811 // down
1812 while (y0 <= celly1) and (filled[y0-celly0] <> 0) do begin Inc(y0); Inc(ay0); end;
1813 if (ay0 >= ay1) then begin ey := ay1; result := false; exit; end;
1814 if (y0 <= celly1) then begin ey := ay0-1; result := true; exit; end;
1815 end;
1816 end;
1817 end
1818 else
1819 begin
1820 // horizontal
1821 assert(false);
1822 end;
1823 end;
1824
1825
1826 // ////////////////////////////////////////////////////////////////////////// //
1827 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP;
1828 var
1829 ex, ey: Integer;
1830 begin
1831 result := traceRay(ex, ey, x0, y0, x1, y1, tagmask);
1832 end;
1833
1834
1835 // you are not supposed to understand this
1836 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
1837 var
1838 lw: TLineWalker;
1839 ccidx: Integer;
1840 cc: PGridCell;
1841 px: PBodyProxyRec;
1842 lq: LongWord;
1843 f, ptag: Integer;
1844 gw, gh, minx, miny: Integer;
1845 x0, y0: Integer;
1846 x1, y1: Integer;
1847 cx, cy: Integer;
1848 px0, py0, px1, py1: Integer;
1849 lastDistSq, distSq, hx, hy: Integer;
1850 firstCell: Boolean = true;
1851 wasHit: Boolean;
1852 begin
1853 result := Default(ITP);
1854 tagmask := tagmask and TagFullMask;
1855 if (tagmask = 0) then exit;
1856
1857 gw := mWidth;
1858 gh := mHeight;
1859 minx := mMinX;
1860 miny := mMinY;
1861
1862 // make query coords (0,0)-based
1863 x0 := ax0-minx;
1864 y0 := ay0-miny;
1865 x1 := ax1-minx;
1866 y1 := ay1-miny;
1867
1868 lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1);
1869 if not lw.setup(x0, y0, x1, y1) then exit; // out of screen
1870
1871 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1872
1873 {$IF DEFINED(D2F_DEBUG)}
1874 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]);
1875 {$ENDIF}
1876
1877 // increase query counter
1878 Inc(mLastQuery);
1879 if (mLastQuery = 0) then
1880 begin
1881 // just in case of overflow
1882 mLastQuery := 1;
1883 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1884 end;
1885 lq := mLastQuery;
1886
1887 repeat
1888 lw.getXY(cx, cy);
1889 {$IF DEFINED(D2F_DEBUG)}
1890 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB(cx+mMinX, cy+mMinY);
1891 {$ENDIF}
1892 // check tile
1893 ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)];
1894 // process cells
1895 wasHit := false;
1896 while (ccidx <> -1) do
1897 begin
1898 cc := @mCells[ccidx];
1899 for f := 0 to GridCellBucketSize-1 do
1900 begin
1901 if (cc.bodies[f] = -1) then break;
1902 px := @mProxies[cc.bodies[f]];
1903 ptag := px.mTag;
1904 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1905 begin
1906 px.mQueryMark := lq; // mark as processed
1907 // get adjusted proxy coords
1908 px0 := px.mX-minx;
1909 py0 := px.mY-miny;
1910 px1 := px0+px.mWidth-1;
1911 py1 := py0+px.mHeight-1;
1912 {$IF DEFINED(D2F_DEBUG)}
1913 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' cxy=(%s,%s); pan=(%s,%s)-(%s,%s)', [cx, cy, px0, py0, px1, py1]);
1914 {$ENDIF}
1915 // inside?
1916 if firstCell and (x0 >= px0) and (y0 >= py0) and (x0 <= px1) and (y0 <= py1) then
1917 begin
1918 // oops
1919 ex := ax0;
1920 ey := ay0;
1921 result := px.mObj;
1922 {$IF DEFINED(D2F_DEBUG)}
1923 if assigned(dbgRayTraceTileHitCB) then e_LogWriteln(' INSIDE!');
1924 {$ENDIF}
1925 exit;
1926 end;
1927 // do line-vs-aabb test
1928 if lineAABBIntersects(x0, y0, x1, y1, px0, py0, px1-px0+1, py1-py0+1, hx, hy) then
1929 begin
1930 // hit detected
1931 distSq := distanceSq(x0, y0, hx, hy);
1932 {$IF DEFINED(D2F_DEBUG)}
1933 //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' hit=(%s,%s); distSq=%s; lastDistSq=%s', [hx, hy, distSq, lastDistSq]);
1934 {$ENDIF}
1935 if (distSq < lastDistSq) then
1936 begin
1937 lastDistSq := distSq;
1938 ex := hx+minx;
1939 ey := hy+miny;
1940 result := px.mObj;
1941 wasHit := true;
1942 end;
1943 end;
1944 end;
1945 end;
1946 // next cell
1947 ccidx := cc.next;
1948 end;
1949 // done processing cells; exit if we registered a hit
1950 // next cells can't have better candidates, obviously
1951 if wasHit then exit;
1952 firstCell := false;
1953 // move to next tile
1954 until lw.stepToNextTile();
1955 end;
1956
1957
1958 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024