DEADSOFTWARE
GIT / REPO / FRED-BOY

Projects / d2df-sdl.git / blob


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