DEADSOFTWARE
GIT / REPO / FRED-BOY

Projects / d2df-sdl.git / blob


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