DEADSOFTWARE

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