DEADSOFTWARE
GIT / REPO / FRED-BOY

Projects / d2df-sdl.git / blob


e6f66bfabdc9808ab0ae391665bffd3575f03803
[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 unit g_grid;
19
20 interface
21
22
23 type
24 TBodyProxyId = Integer;
25
26 generic TBodyGridBase<ITP> = class(TObject)
27 public
28 type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
29 type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
30 type TGridAlongQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
31
32 const TagDisabled = $40000000;
33 const TagFullMask = $3fffffff;
34
35 private
36 const
37 GridDefaultTileSize = 32;
38 GridCellBucketSize = 8; // WARNING! can't be less than 2!
39
40 private
41 type
42 PBodyProxyRec = ^TBodyProxyRec;
43 TBodyProxyRec = record
44 private
45 mX, mY, mWidth, mHeight: Integer; // aabb
46 mQueryMark: LongWord; // was this object visited at this query?
47 mObj: ITP;
48 mTag: Integer; // `TagDisabled` set: disabled ;-)
49 nextLink: TBodyProxyId; // next free or nothing
50
51 private
52 procedure setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
53 end;
54
55 PGridCell = ^TGridCell;
56 TGridCell = record
57 bodies: array [0..GridCellBucketSize-1] of Integer; // -1: end of list
58 next: Integer; // in this cell; index in mCells
59 end;
60
61 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
62
63 private
64 //mTileSize: Integer;
65 const mTileSize = GridDefaultTileSize;
66
67 private
68 mMinX, mMinY: Integer; // so grids can start at any origin
69 mWidth, mHeight: Integer; // in tiles
70 mGrid: array of Integer; // mWidth*mHeight, index in mCells
71 mCells: array of TGridCell; // cell pool
72 mFreeCell: Integer; // first free cell index or -1
73 mLastQuery: LongWord;
74 mUsedCells: Integer;
75 mProxies: array of TBodyProxyRec;
76 mProxyFree: TBodyProxyId; // free
77 mProxyCount: Integer; // currently used
78 mProxyMaxCount: Integer;
79
80 public
81 dbgShowTraceLog: Boolean;
82
83 private
84 function allocCell (): Integer;
85 procedure freeCell (idx: Integer); // `next` is simply overwritten
86
87 function allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
88 procedure freeProxy (body: TBodyProxyId);
89
90 procedure insertInternal (body: TBodyProxyId);
91 procedure removeInternal (body: TBodyProxyId);
92
93 function forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
94
95 function inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
96 function remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
97
98 function getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
99 procedure setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
100
101 function getGridWidthPx (): Integer; inline;
102 function getGridHeightPx (): Integer; inline;
103
104 public
105 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
106 destructor Destroy (); override;
107
108 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
109 procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
110
111 procedure moveBody (body: TBodyProxyId; dx, dy: Integer);
112 procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
113 procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
114
115 function insideGrid (x, y: Integer): Boolean; inline;
116
117 // `false` if `body` is surely invalid
118 function getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
119
120 //WARNING: don't modify grid while any query is in progress (no checks are made!)
121 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
122 // no callback: return `true` on the first hit
123 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
124
125 //WARNING: don't modify grid while any query is in progress (no checks are made!)
126 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
127 // no callback: return `true` on the first hit
128 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
129
130 //WARNING: don't modify grid while any query is in progress (no checks are made!)
131 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
132 // cb with `(nil)` will be called before processing new tile
133 // no callback: return `true` on the nearest hit
134 function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
135 function traceRay (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
136
137 //WARNING: don't modify grid while any query is in progress (no checks are made!)
138 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
139 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
140 function forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1): ITP;
141
142 procedure dumpStats ();
143
144 //WARNING! no sanity checks!
145 property proxyEnabled[pid: TBodyProxyId]: Boolean read getProxyEnabled write setProxyEnabled;
146
147 property gridX0: Integer read mMinX;
148 property gridY0: Integer read mMinY;
149 property gridWidth: Integer read getGridWidthPx; // in pixels
150 property gridHeight: Integer read getGridHeightPx; // in pixels
151 end;
152
153
154 // you are not supposed to understand this
155 // returns `true` if there is an intersection, and enter coords
156 // enter coords will be equal to (x0, y0) if starting point is inside the box
157 // if result is `false`, `inx` and `iny` are undefined
158 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
159
160
161 procedure swapInt (var a: Integer; var b: Integer); inline;
162 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
163
164
165 implementation
166
167 uses
168 SysUtils, e_log;
169
170
171 // ////////////////////////////////////////////////////////////////////////// //
172 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
173
174 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
175
176
177 // ////////////////////////////////////////////////////////////////////////// //
178 // you are not supposed to understand this
179 // returns `true` if there is an intersection, and enter coords
180 // enter coords will be equal to (x0, y0) if starting point is inside the box
181 // if result is `false`, `inx` and `iny` are undefined
182 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
183 var
184 wx0, wy0, wx1, wy1: Integer; // window coordinates
185 stx, sty: Integer; // "steps" for x and y axes
186 dsx, dsy: Integer; // "lengthes" for x and y axes
187 dx2, dy2: Integer; // "double lengthes" for x and y axes
188 xd, yd: Integer; // current coord
189 e: Integer; // "error" (as in bresenham algo)
190 rem: Integer;
191 term: Integer;
192 d0, d1: PInteger;
193 xfixed: Boolean;
194 temp: Integer;
195 begin
196 result := false;
197 // why not
198 inx := x0;
199 iny := y0;
200 if (bw < 1) or (bh < 1) then exit; // impossible box
201
202 if (x0 = x1) and (y0 = y1) then
203 begin
204 // check this point
205 result := (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh);
206 exit;
207 end;
208
209 // check if staring point is inside the box
210 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
211
212 // clip rectange
213 wx0 := bx;
214 wy0 := by;
215 wx1 := bx+bw-1;
216 wy1 := by+bh-1;
217
218 // horizontal setup
219 if (x0 < x1) then
220 begin
221 // from left to right
222 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
223 stx := 1; // going right
224 end
225 else
226 begin
227 // from right to left
228 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
229 stx := -1; // going left
230 x0 := -x0;
231 x1 := -x1;
232 wx0 := -wx0;
233 wx1 := -wx1;
234 swapInt(wx0, wx1);
235 end;
236
237 // vertical setup
238 if (y0 < y1) then
239 begin
240 // from top to bottom
241 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
242 sty := 1; // going down
243 end
244 else
245 begin
246 // from bottom to top
247 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
248 sty := -1; // going up
249 y0 := -y0;
250 y1 := -y1;
251 wy0 := -wy0;
252 wy1 := -wy1;
253 swapInt(wy0, wy1);
254 end;
255
256 dsx := x1-x0;
257 dsy := y1-y0;
258
259 if (dsx < dsy) then
260 begin
261 d0 := @yd;
262 d1 := @xd;
263 swapInt(x0, y0);
264 swapInt(x1, y1);
265 swapInt(dsx, dsy);
266 swapInt(wx0, wy0);
267 swapInt(wx1, wy1);
268 swapInt(stx, sty);
269 end
270 else
271 begin
272 d0 := @xd;
273 d1 := @yd;
274 end;
275
276 dx2 := 2*dsx;
277 dy2 := 2*dsy;
278 xd := x0;
279 yd := y0;
280 e := 2*dsy-dsx;
281 term := x1;
282
283 xfixed := false;
284 if (y0 < wy0) then
285 begin
286 // clip at top
287 temp := dx2*(wy0-y0)-dsx;
288 xd += temp div dy2;
289 rem := temp mod dy2;
290 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
291 if (xd+1 >= wx0) then
292 begin
293 yd := wy0;
294 e -= rem+dsx;
295 if (rem > 0) then begin Inc(xd); e += dy2; end;
296 xfixed := true;
297 end;
298 end;
299
300 if (not xfixed) and (x0 < wx0) then
301 begin
302 // clip at left
303 temp := dy2*(wx0-x0);
304 yd += temp div dx2;
305 rem := temp mod dx2;
306 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
307 xd := wx0;
308 e += rem;
309 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
310 end;
311
312 if (y1 > wy1) then
313 begin
314 // clip at bottom
315 temp := dx2*(wy1-y0)+dsx;
316 term := x0+temp div dy2;
317 rem := temp mod dy2;
318 if (rem = 0) then Dec(term);
319 end;
320
321 if (term > wx1) then term := wx1; // clip at right
322
323 Inc(term); // draw last point
324 //if (term = xd) then exit; // this is the only point, get out of here
325
326 if (sty = -1) then yd := -yd;
327 if (stx = -1) then begin xd := -xd; term := -term; end;
328 dx2 -= dy2;
329
330 inx := d0^;
331 iny := d1^;
332 result := true;
333 end;
334
335
336 // ////////////////////////////////////////////////////////////////////////// //
337 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
338 begin
339 mX := aX;
340 mY := aY;
341 mWidth := aWidth;
342 mHeight := aHeight;
343 mQueryMark := 0;
344 mObj := aObj;
345 mTag := aTag;
346 nextLink := -1;
347 end;
348
349
350 // ////////////////////////////////////////////////////////////////////////// //
351 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
352 var
353 idx: Integer;
354 begin
355 dbgShowTraceLog := false;
356 {
357 if aTileSize < 1 then aTileSize := 1;
358 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
359 mTileSize := aTileSize;
360 }
361 if (aPixWidth < mTileSize) then aPixWidth := mTileSize;
362 if (aPixHeight < mTileSize) then aPixHeight := mTileSize;
363 mMinX := aMinPixX;
364 mMinY := aMinPixY;
365 mWidth := (aPixWidth+mTileSize-1) div mTileSize;
366 mHeight := (aPixHeight+mTileSize-1) div mTileSize;
367 SetLength(mGrid, mWidth*mHeight);
368 SetLength(mCells, mWidth*mHeight);
369 SetLength(mProxies, 8192);
370 mFreeCell := 0;
371 // init free list
372 for idx := 0 to High(mCells) do
373 begin
374 mCells[idx].bodies[0] := -1;
375 mCells[idx].next := idx+1;
376 end;
377 mCells[High(mCells)].next := -1; // last cell
378 // init grid
379 for idx := 0 to High(mGrid) do mGrid[idx] := -1;
380 // init proxies
381 for idx := 0 to High(mProxies) do mProxies[idx].nextLink := idx+1;
382 mProxies[High(mProxies)].nextLink := -1;
383 mLastQuery := 0;
384 mUsedCells := 0;
385 mProxyFree := 0;
386 mProxyCount := 0;
387 mProxyMaxCount := 0;
388 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
389 end;
390
391
392 destructor TBodyGridBase.Destroy ();
393 begin
394 mCells := nil;
395 mGrid := nil;
396 mProxies := nil;
397 inherited;
398 end;
399
400
401 // ////////////////////////////////////////////////////////////////////////// //
402 procedure TBodyGridBase.dumpStats ();
403 var
404 idx, mcb, cidx, cnt: Integer;
405 begin
406 mcb := 0;
407 for idx := 0 to High(mGrid) do
408 begin
409 cidx := mGrid[idx];
410 cnt := 0;
411 while cidx >= 0 do
412 begin
413 Inc(cnt);
414 cidx := mCells[cidx].next;
415 end;
416 if (mcb < cnt) then mcb := cnt;
417 end;
418 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);
419 end;
420
421
422 // ////////////////////////////////////////////////////////////////////////// //
423 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
424 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
425
426
427 function TBodyGridBase.insideGrid (x, y: Integer): Boolean; inline;
428 begin
429 // fix coords
430 Dec(x, mMinX);
431 Dec(y, mMinY);
432 result := (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize);
433 end;
434
435
436 function TBodyGridBase.getBodyXY (body: TBodyProxyId; out rx, ry: Integer): Boolean; inline;
437 begin
438 if (body >= 0) and (body < Length(mProxies)) then
439 begin
440 with mProxies[body] do begin rx := mX; ry := mY; end;
441 result := true;
442 end
443 else
444 begin
445 rx := 0;
446 ry := 0;
447 result := false;
448 end;
449 end;
450
451
452 // ////////////////////////////////////////////////////////////////////////// //
453 function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline;
454 begin
455 if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false;
456 end;
457
458
459 procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline;
460 begin
461 if (pid >= 0) then
462 begin
463 if val then
464 begin
465 mProxies[pid].mTag := mProxies[pid].mTag and not TagDisabled;
466 end
467 else
468 begin
469 mProxies[pid].mTag := mProxies[pid].mTag or TagDisabled;
470 end;
471 end;
472 end;
473
474
475 // ////////////////////////////////////////////////////////////////////////// //
476 function TBodyGridBase.allocCell (): Integer;
477 var
478 idx: Integer;
479 begin
480 if (mFreeCell < 0) then
481 begin
482 // no free cells, want more
483 mFreeCell := Length(mCells);
484 SetLength(mCells, mFreeCell+32768); // arbitrary number
485 for idx := mFreeCell to High(mCells) do
486 begin
487 mCells[idx].bodies[0] := -1;
488 mCells[idx].next := idx+1;
489 end;
490 mCells[High(mCells)].next := -1; // last cell
491 end;
492 result := mFreeCell;
493 mFreeCell := mCells[result].next;
494 mCells[result].next := -1;
495 mCells[result].bodies[0] := -1;
496 Inc(mUsedCells);
497 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
498 end;
499
500
501 procedure TBodyGridBase.freeCell (idx: Integer);
502 begin
503 if (idx >= 0) and (idx < Length(mCells)) then
504 begin
505 //if mCells[idx].body = -1 then exit; // the thing that should not be
506 mCells[idx].bodies[0] := -1;
507 mCells[idx].next := mFreeCell;
508 mFreeCell := idx;
509 Dec(mUsedCells);
510 end;
511 end;
512
513
514 // ////////////////////////////////////////////////////////////////////////// //
515 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
516 var
517 olen, idx: Integer;
518 px: PBodyProxyRec;
519 begin
520 if (mProxyFree = -1) then
521 begin
522 // no free proxies, resize list
523 olen := Length(mProxies);
524 SetLength(mProxies, olen+8192); // arbitrary number
525 for idx := olen to High(mProxies) do mProxies[idx].nextLink := idx+1;
526 mProxies[High(mProxies)].nextLink := -1;
527 mProxyFree := olen;
528 end;
529 // get one from list
530 result := mProxyFree;
531 px := @mProxies[result];
532 mProxyFree := px.nextLink;
533 px.setup(aX, aY, aWidth, aHeight, aObj, aTag);
534 // add to used list
535 px.nextLink := -1;
536 // statistics
537 Inc(mProxyCount);
538 if (mProxyMaxCount < mProxyCount) then mProxyMaxCount := mProxyCount;
539 end;
540
541 procedure TBodyGridBase.freeProxy (body: TBodyProxyId);
542 begin
543 if (body < 0) or (body > High(mProxies)) then exit; // just in case
544 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
545 // add to free list
546 mProxies[body].mObj := nil;
547 mProxies[body].nextLink := mProxyFree;
548 mProxyFree := body;
549 Dec(mProxyCount);
550 end;
551
552
553 // ////////////////////////////////////////////////////////////////////////// //
554 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
555 const
556 tsize = mTileSize;
557 var
558 gx, gy: Integer;
559 gw, gh: Integer;
560 begin
561 result := false;
562 if (w < 1) or (h < 1) or not assigned(cb) then exit;
563 // fix coords
564 Dec(x, mMinX);
565 Dec(y, mMinY);
566 // go on
567 if (x+w <= 0) or (y+h <= 0) then exit;
568 gw := mWidth;
569 gh := mHeight;
570 //tsize := mTileSize;
571 if (x >= gw*tsize) or (y >= gh*tsize) then exit;
572 for gy := y div tsize to (y+h-1) div tsize do
573 begin
574 if (gy < 0) then continue;
575 if (gy >= gh) then break;
576 for gx := x div tsize to (x+w-1) div tsize do
577 begin
578 if (gx < 0) then continue;
579 if (gx >= gw) then break;
580 result := cb(gy*gw+gx, bodyId);
581 if result then exit;
582 end;
583 end;
584 end;
585
586
587 // ////////////////////////////////////////////////////////////////////////// //
588 function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean;
589 var
590 cidx: Integer;
591 pc: Integer;
592 pi: PGridCell;
593 f: Integer;
594 begin
595 result := false; // never stop
596 // add body to the given grid cell
597 pc := mGrid[grida];
598 if (pc <> -1) then
599 begin
600 pi := @mCells[pc];
601 f := 0;
602 for f := 0 to High(TGridCell.bodies) do
603 begin
604 if (pi.bodies[f] = -1) then
605 begin
606 // can add here
607 pi.bodies[f] := bodyId;
608 if (f+1 < Length(TGridCell.bodies)) then pi.bodies[f+1] := -1;
609 exit;
610 end;
611 end;
612 end;
613 // either no room, or no cell at all
614 cidx := allocCell();
615 mCells[cidx].bodies[0] := bodyId;
616 mCells[cidx].bodies[1] := -1;
617 mCells[cidx].next := pc;
618 mGrid[grida] := cidx;
619 end;
620
621 procedure TBodyGridBase.insertInternal (body: TBodyProxyId);
622 var
623 px: PBodyProxyRec;
624 begin
625 if (body < 0) or (body > High(mProxies)) then exit; // just in case
626 px := @mProxies[body];
627 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, inserter, body);
628 end;
629
630
631 // absolutely not tested
632 function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean;
633 var
634 f: Integer;
635 pidx, idx, tmp: Integer;
636 pc: PGridCell;
637 begin
638 result := false; // never stop
639 // find and remove cell
640 pidx := -1;
641 idx := mGrid[grida];
642 while (idx >= 0) do
643 begin
644 tmp := mCells[idx].next;
645 pc := @mCells[idx];
646 f := 0;
647 while (f < High(TGridCell.bodies)) do
648 begin
649 if (pc.bodies[f] = bodyId) then
650 begin
651 // i found her!
652 if (f = 0) and (pc.bodies[1] = -1) then
653 begin
654 // this cell contains no elements, remove it
655 tmp := mCells[idx].next;
656 if (pidx = -1) then mGrid[grida] := tmp else mCells[pidx].next := tmp;
657 freeCell(idx);
658 end
659 else
660 begin
661 // remove element from bucket
662 Inc(f);
663 while (f < High(TGridCell.bodies)) do
664 begin
665 pc.bodies[f-1] := pc.bodies[f];
666 if (pc.bodies[f] = -1) then break;
667 Inc(f);
668 end;
669 pc.bodies[High(TGridCell.bodies)] := -1; // just in case
670 end;
671 exit; // assume that we cannot have one object added to bucket twice
672 end;
673 Inc(f);
674 end;
675 pidx := idx;
676 idx := tmp;
677 end;
678 end;
679
680 // absolutely not tested
681 procedure TBodyGridBase.removeInternal (body: TBodyProxyId);
682 var
683 px: PBodyProxyRec;
684 begin
685 if (body < 0) or (body > High(mProxies)) then exit; // just in case
686 px := @mProxies[body];
687 forGridRect(px.mX, px.mY, px.mWidth, px.mHeight, remover, body);
688 end;
689
690
691 // ////////////////////////////////////////////////////////////////////////// //
692 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
693 begin
694 aTag := aTag and TagFullMask;
695 result := allocProxy(aX, aY, aWidth, aHeight, aObj, aTag);
696 insertInternal(result);
697 end;
698
699
700 procedure TBodyGridBase.removeBody (body: TBodyProxyId);
701 begin
702 if (body < 0) or (body > High(mProxies)) then exit; // just in case
703 removeInternal(body);
704 freeProxy(body);
705 end;
706
707
708 // ////////////////////////////////////////////////////////////////////////// //
709 procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
710 var
711 px: PBodyProxyRec;
712 x0, y0, w, h: Integer;
713 begin
714 if (body < 0) or (body > High(mProxies)) then exit; // just in case
715 if (dx = 0) and (dy = 0) and (sx = 0) and (sy = 0) then exit;
716 px := @mProxies[body];
717 x0 := px.mX;
718 y0 := px.mY;
719 w := px.mWidth;
720 h := px.mHeight;
721 // did any corner crossed tile boundary?
722 if (x0 div mTileSize <> (x0+dx) div mTileSize) or
723 (y0 div mTileSize <> (y0+dx) div mTileSize) or
724 ((x0+w) div mTileSize <> (x0+w+sx) div mTileSize) or
725 ((y0+h) div mTileSize <> (y0+h+sy) div mTileSize) then
726 begin
727 removeInternal(body);
728 Inc(px.mX, dx);
729 Inc(px.mY, dy);
730 Inc(px.mWidth, sx);
731 Inc(px.mHeight, sy);
732 insertInternal(body);
733 end
734 else
735 begin
736 Inc(px.mX, dx);
737 Inc(px.mY, dy);
738 Inc(px.mWidth, sx);
739 Inc(px.mHeight, sy);
740 end;
741 end;
742
743 procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
744 var
745 px: PBodyProxyRec;
746 nx, ny: Integer;
747 begin
748 if (body < 0) or (body > High(mProxies)) then exit; // just in case
749 if (dx = 0) and (dy = 0) then exit;
750 // check if tile coords was changed
751 px := @mProxies[body];
752 nx := px.mX+dx;
753 ny := px.mY+dy;
754 if (nx div mTileSize <> px.mX div mTileSize) or (ny div mTileSize <> px.mY div mTileSize) then
755 begin
756 // crossed tile boundary, do heavy work
757 moveResizeBody(body, dx, dy, 0, 0);
758 end
759 else
760 begin
761 // nothing to do with the grid, just fix coordinates
762 px.mX := nx;
763 px.mY := ny;
764 end;
765 end;
766
767 procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer);
768 var
769 px: PBodyProxyRec;
770 x0, y0: Integer;
771 nw, nh: Integer;
772 begin
773 if (body < 0) or (body > High(mProxies)) then exit; // just in case
774 if (sx = 0) and (sy = 0) then exit;
775 // check if tile coords was changed
776 px := @mProxies[body];
777 x0 := px.mX;
778 y0 := px.mY;
779 nw := px.mWidth+sx;
780 nh := px.mHeight+sy;
781 if ((x0+px.mWidth) div mTileSize <> (x0+nw) div mTileSize) or
782 ((y0+px.mHeight) div mTileSize <> (y0+nh) div mTileSize) then
783 begin
784 // crossed tile boundary, do heavy work
785 moveResizeBody(body, 0, 0, sx, sy);
786 end
787 else
788 begin
789 // nothing to do with the grid, just fix size
790 px.mWidth := nw;
791 px.mHeight := nh;
792 end;
793 end;
794
795
796 // ////////////////////////////////////////////////////////////////////////// //
797 // no callback: return `true` on the first hit
798 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
799 var
800 f: Integer;
801 idx, curci: Integer;
802 cc: PGridCell = nil;
803 px: PBodyProxyRec;
804 lq: LongWord;
805 ptag: Integer;
806 begin
807 result := Default(ITP);
808 tagmask := tagmask and TagFullMask;
809 if (tagmask = 0) then exit;
810
811 // make coords (0,0)-based
812 Dec(x, mMinX);
813 Dec(y, mMinY);
814 if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y >= mHeight*mTileSize) then exit;
815
816 curci := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)];
817 // restore coords
818 Inc(x, mMinX);
819 Inc(y, mMinY);
820
821 // increase query counter
822 Inc(mLastQuery);
823 if (mLastQuery = 0) then
824 begin
825 // just in case of overflow
826 mLastQuery := 1;
827 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
828 end;
829 lq := mLastQuery;
830
831 while (curci <> -1) do
832 begin
833 cc := @mCells[curci];
834 for f := 0 to High(TGridCell.bodies) do
835 begin
836 if (cc.bodies[f] = -1) then break;
837 px := @mProxies[cc.bodies[f]];
838 ptag := px.mTag;
839 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
840 begin
841 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
842 begin
843 px.mQueryMark := lq;
844 if assigned(cb) then
845 begin
846 if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
847 end
848 else
849 begin
850 result := px.mObj;
851 exit;
852 end;
853 end;
854 end;
855 end;
856 curci := cc.next;
857 end;
858 end;
859
860
861 // ////////////////////////////////////////////////////////////////////////// //
862 // no callback: return `true` on the first hit
863 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
864 const
865 tsize = mTileSize;
866 var
867 idx: Integer;
868 gx, gy: Integer;
869 curci: Integer;
870 f: Integer;
871 cc: PGridCell = nil;
872 px: PBodyProxyRec;
873 lq: LongWord;
874 gw: Integer;
875 x0, y0: Integer;
876 ptag: Integer;
877 begin
878 result := Default(ITP);
879 if (w < 1) or (h < 1) then exit;
880 tagmask := tagmask and TagFullMask;
881 if (tagmask = 0) then exit;
882
883 x0 := x;
884 y0 := y;
885
886 // fix coords
887 Dec(x, mMinX);
888 Dec(y, mMinY);
889
890 gw := mWidth;
891 //tsize := mTileSize;
892
893 if (x+w <= 0) or (y+h <= 0) then exit;
894 if (x >= gw*tsize) or (y >= mHeight*tsize) then exit;
895
896 // increase query counter
897 Inc(mLastQuery);
898 if (mLastQuery = 0) then
899 begin
900 // just in case of overflow
901 mLastQuery := 1;
902 for idx := 0 to High(mProxies) do mProxies[idx].mQueryMark := 0;
903 end;
904 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
905 lq := mLastQuery;
906
907 // go on
908 for gy := y div tsize to (y+h-1) div tsize do
909 begin
910 if (gy < 0) then continue;
911 if (gy >= mHeight) then break;
912 for gx := x div tsize to (x+w-1) div tsize do
913 begin
914 if (gx < 0) then continue;
915 if (gx >= gw) then break;
916 // process cells
917 curci := mGrid[gy*gw+gx];
918 while (curci <> -1) do
919 begin
920 cc := @mCells[curci];
921 for f := 0 to High(TGridCell.bodies) do
922 begin
923 if (cc.bodies[f] = -1) then break;
924 px := @mProxies[cc.bodies[f]];
925 ptag := px.mTag;
926 if (not allowDisabled) and ((ptag and TagDisabled) <> 0) then continue;
927 if ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
928 //if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
929 //if ( ((ptag and TagDisabled) = 0) = ignoreDisabled) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
930 begin
931 if (x0 >= px.mX+px.mWidth) or (y0 >= px.mY+px.mHeight) then continue;
932 if (x0+w <= px.mX) or (y0+h <= px.mY) then continue;
933 px.mQueryMark := lq;
934 if assigned(cb) then
935 begin
936 if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
937 end
938 else
939 begin
940 result := px.mObj;
941 exit;
942 end;
943 end;
944 end;
945 curci := cc.next;
946 end;
947 end;
948 end;
949 end;
950
951
952 // ////////////////////////////////////////////////////////////////////////// //
953 // no callback: return `true` on the nearest hit
954 function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
955 var
956 ex, ey: Integer;
957 begin
958 result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask);
959 end;
960
961
962 // no callback: return `true` on the nearest hit
963 (*
964 function TBodyGridBase.traceRay (out ex, ey: Integer; x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
965 const
966 tsize = mTileSize;
967 var
968 i: Integer;
969 dx, dy, d: Integer;
970 xerr, yerr: Integer;
971 incx, incy: Integer;
972 stepx, stepy: Integer;
973 x, y: Integer;
974 maxx, maxy: Integer;
975 gw, gh: Integer;
976 ccidx: Integer;
977 curci: Integer;
978 cc: PGridCell;
979 hasUntried: Boolean;
980 px: PBodyProxyRec;
981 lq: LongWord;
982 prevX, prevY: Integer;
983 minx, miny: Integer;
984 ptag: Integer;
985 lastDistSq, distSq: Integer;
986 wasHit: Boolean = false;
987 lastObj: ITP;
988 lastWasInGrid: Boolean;
989 tbcross: Boolean;
990 f: Integer;
991 begin
992 result := Default(ITP);
993 lastObj := Default(ITP);
994 tagmask := tagmask and TagFullMask;
995 if (tagmask = 0) then begin ex := x0; ey := y0; exit; end;
996
997 minx := mMinX;
998 miny := mMinY;
999
1000 dx := x1-x0;
1001 dy := y1-y0;
1002
1003 if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1004 if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1005
1006 dx := abs(dx);
1007 dy := abs(dy);
1008
1009 if (dx > dy) then d := dx else d := dy;
1010
1011 // `x` and `y` will be in grid coords
1012 x := x0-minx;
1013 y := y0-miny;
1014
1015 // increase query counter
1016 Inc(mLastQuery);
1017 if (mLastQuery = 0) then
1018 begin
1019 // just in case of overflow
1020 mLastQuery := 1;
1021 for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1022 end;
1023 lq := mLastQuery;
1024
1025 // cache various things
1026 //tsize := mTileSize;
1027 gw := mWidth;
1028 gh := mHeight;
1029 maxx := gw*tsize-1;
1030 maxy := gh*tsize-1;
1031
1032 // setup distance and flags
1033 lastDistSq := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0)+1;
1034 lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1035
1036 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1037 if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1038
1039 // it is slightly faster this way
1040 xerr := -d;
1041 yerr := -d;
1042
1043 // now trace
1044 for i := 1 to d do
1045 begin
1046 // prevs are always in map coords
1047 prevX := x+minx;
1048 prevY := y+miny;
1049 // do one step
1050 xerr += dx;
1051 yerr += dy;
1052 // invariant: one of those always changed
1053 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1054 if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1055 if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1056 // invariant: we always doing a step
1057 if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1058 begin
1059 // check for crossing tile/grid boundary
1060 if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1061 begin
1062 // we're still in grid
1063 lastWasInGrid := true;
1064 // check for tile edge crossing
1065 if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1066 else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1067 else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1068 else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1069 else tbcross := false;
1070 // crossed tile edge?
1071 if tbcross then
1072 begin
1073 // had something in the cell we're leaving?
1074 if (ccidx <> -1) then
1075 begin
1076 // yes, signal cell completion
1077 if assigned(cb) then
1078 begin
1079 if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
1080 end
1081 else if wasHit then
1082 begin
1083 result := lastObj;
1084 exit;
1085 end;
1086 end;
1087 // setup new cell index
1088 ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1089 end;
1090 end
1091 else
1092 begin
1093 // out of grid, had something in the last processed cell?
1094 if (ccidx <> -1) then
1095 begin
1096 // yes, signal cell completion
1097 ccidx := -1;
1098 if assigned(cb) then
1099 begin
1100 if cb(nil, 0, x+minx, y+miny, prevX, prevY) then begin result := lastObj; exit; end;
1101 end
1102 else if wasHit then
1103 begin
1104 result := lastObj;
1105 exit;
1106 end;
1107 end;
1108 if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1109 end;
1110 end;
1111
1112 // has something to process in the current cell?
1113 if (ccidx <> -1) then
1114 begin
1115 // process cell
1116 curci := ccidx;
1117 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1118 // convert coords to map (to avoid ajdusting coords inside the loop)
1119 Inc(x, minx);
1120 Inc(y, miny);
1121 // process cell list
1122 while (curci <> -1) do
1123 begin
1124 cc := @mCells[curci];
1125 for f := 0 to High(TGridCell.bodies) do
1126 begin
1127 if (cc.bodies[f] = -1) then break;
1128 px := @mProxies[cc.bodies[f]];
1129 ptag := px.mTag;
1130 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1131 begin
1132 // can we process this proxy?
1133 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1134 begin
1135 px.mQueryMark := lq; // mark as processed
1136 if assigned(cb) then
1137 begin
1138 if cb(px.mObj, ptag, x, y, prevX, prevY) then
1139 begin
1140 result := lastObj;
1141 ex := prevX;
1142 ey := prevY;
1143 exit;
1144 end;
1145 end
1146 else
1147 begin
1148 // remember this hitpoint if it is nearer than an old one
1149 distSq := (prevX-x0)*(prevX-x0)+(prevY-y0)*(prevY-y0);
1150 if (distSq < lastDistSq) then
1151 begin
1152 wasHit := true;
1153 lastDistSq := distSq;
1154 ex := prevX;
1155 ey := prevY;
1156 lastObj := px.mObj;
1157 end;
1158 end;
1159 end
1160 else
1161 begin
1162 // this is possibly interesting proxy, set "has more to check" flag
1163 hasUntried := true;
1164 end;
1165 end;
1166 end;
1167 // next cell
1168 curci := cc.next;
1169 end;
1170 // still has something interesting in this cell?
1171 if not hasUntried then
1172 begin
1173 // nope, don't process this cell anymore; signal cell completion
1174 ccidx := -1;
1175 if assigned(cb) then
1176 begin
1177 if cb(nil, 0, x, y, prevX, prevY) then begin result := lastObj; exit; end;
1178 end
1179 else if wasHit then
1180 begin
1181 result := lastObj;
1182 exit;
1183 end;
1184 end;
1185 // convert coords to grid
1186 Dec(x, minx);
1187 Dec(y, miny);
1188 end;
1189 end;
1190 end;
1191 *)
1192
1193
1194 // no callback: return `true` on the nearest hit
1195 // you are not supposed to understand this
1196 function TBodyGridBase.traceRay (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1197 const
1198 tsize = mTileSize;
1199 var
1200 wx0, wy0, wx1, wy1: Integer; // window coordinates
1201 stx, sty: Integer; // "steps" for x and y axes
1202 dsx, dsy: Integer; // "lengthes" for x and y axes
1203 dx2, dy2: Integer; // "double lengthes" for x and y axes
1204 xd, yd: Integer; // current coord
1205 e: Integer; // "error" (as in bresenham algo)
1206 rem: Integer;
1207 term: Integer;
1208 xptr, yptr: PInteger;
1209 xfixed: Boolean;
1210 temp: Integer;
1211 prevx, prevy: Integer;
1212 lastDistSq: Integer;
1213 ccidx, curci: Integer;
1214 hasUntried: Boolean;
1215 lastGA: Integer = -1;
1216 ga, x, y: Integer;
1217 lastObj: ITP;
1218 wasHit: Boolean = false;
1219 gw, gh, minx, miny, maxx, maxy: Integer;
1220 cc: PGridCell;
1221 px: PBodyProxyRec;
1222 lq: LongWord;
1223 f, ptag, distSq: Integer;
1224 x0, y0, x1, y1: Integer;
1225 begin
1226 result := Default(ITP);
1227 lastObj := Default(ITP);
1228 tagmask := tagmask and TagFullMask;
1229 ex := ax1; // why not?
1230 ey := ay1; // why not?
1231 if (tagmask = 0) then exit;
1232
1233 if (ax0 = ax1) and (ay0 = ay1) then exit; // as the first point is ignored, just get outta here
1234
1235 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1236
1237 gw := mWidth;
1238 gh := mHeight;
1239 minx := mMinX;
1240 miny := mMinY;
1241 maxx := gw*tsize-1;
1242 maxy := gh*tsize-1;
1243
1244 x0 := ax0;
1245 y0 := ay0;
1246 x1 := ax1;
1247 y1 := ay1;
1248
1249 // offset query coords to (0,0)-based
1250 Dec(x0, minx);
1251 Dec(y0, miny);
1252 Dec(x1, minx);
1253 Dec(y1, miny);
1254
1255 // clip rectange
1256 wx0 := 0;
1257 wy0 := 0;
1258 wx1 := maxx;
1259 wy1 := maxy;
1260
1261 // horizontal setup
1262 if (x0 < x1) then
1263 begin
1264 // from left to right
1265 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1266 stx := 1; // going right
1267 end
1268 else
1269 begin
1270 // from right to left
1271 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1272 stx := -1; // going left
1273 x0 := -x0;
1274 x1 := -x1;
1275 wx0 := -wx0;
1276 wx1 := -wx1;
1277 swapInt(wx0, wx1);
1278 end;
1279
1280 // vertical setup
1281 if (y0 < y1) then
1282 begin
1283 // from top to bottom
1284 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1285 sty := 1; // going down
1286 end
1287 else
1288 begin
1289 // from bottom to top
1290 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1291 sty := -1; // going up
1292 y0 := -y0;
1293 y1 := -y1;
1294 wy0 := -wy0;
1295 wy1 := -wy1;
1296 swapInt(wy0, wy1);
1297 end;
1298
1299 dsx := x1-x0;
1300 dsy := y1-y0;
1301
1302 if (dsx < dsy) then
1303 begin
1304 xptr := @yd;
1305 yptr := @xd;
1306 swapInt(x0, y0);
1307 swapInt(x1, y1);
1308 swapInt(dsx, dsy);
1309 swapInt(wx0, wy0);
1310 swapInt(wx1, wy1);
1311 swapInt(stx, sty);
1312 end
1313 else
1314 begin
1315 xptr := @xd;
1316 yptr := @yd;
1317 end;
1318
1319 dx2 := 2*dsx;
1320 dy2 := 2*dsy;
1321 xd := x0;
1322 yd := y0;
1323 e := 2*dsy-dsx;
1324 term := x1;
1325
1326 xfixed := false;
1327 if (y0 < wy0) then
1328 begin
1329 // clip at top
1330 temp := dx2*(wy0-y0)-dsx;
1331 xd += temp div dy2;
1332 rem := temp mod dy2;
1333 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
1334 if (xd+1 >= wx0) then
1335 begin
1336 yd := wy0;
1337 e -= rem+dsx;
1338 if (rem > 0) then begin Inc(xd); e += dy2; end;
1339 xfixed := true;
1340 end;
1341 end;
1342
1343 if (not xfixed) and (x0 < wx0) then
1344 begin
1345 // clip at left
1346 temp := dy2*(wx0-x0);
1347 yd += temp div dx2;
1348 rem := temp mod dx2;
1349 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
1350 xd := wx0;
1351 e += rem;
1352 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
1353 end;
1354
1355 if (y1 > wy1) then
1356 begin
1357 // clip at bottom
1358 temp := dx2*(wy1-y0)+dsx;
1359 term := x0+temp div dy2;
1360 rem := temp mod dy2;
1361 if (rem = 0) then Dec(term);
1362 end;
1363
1364 if (term > wx1) then term := wx1; // clip at right
1365
1366 Inc(term); // draw last point
1367 //if (term = xd) then exit; // this is the only point, get out of here
1368
1369 if (sty = -1) then yd := -yd;
1370 if (stx = -1) then begin xd := -xd; term := -term; end;
1371 dx2 -= dy2;
1372
1373 // first move, to skip starting point
1374 if (xd = term) then exit;
1375 prevx := xptr^+minx;
1376 prevy := yptr^+miny;
1377 // move coords
1378 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1379 xd += stx;
1380 // done?
1381 if (xd = term) then exit;
1382
1383 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
1384
1385 if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1386
1387 // restore query coords
1388 Inc(ax0, minx);
1389 Inc(ay0, miny);
1390 //Inc(ax1, minx);
1391 //Inc(ay1, miny);
1392
1393 // increase query counter
1394 Inc(mLastQuery);
1395 if (mLastQuery = 0) then
1396 begin
1397 // just in case of overflow
1398 mLastQuery := 1;
1399 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
1400 end;
1401 lq := mLastQuery;
1402
1403 ccidx := -1;
1404 // draw it; can omit checks
1405 while (xd <> term) do
1406 begin
1407 // check cell(s)
1408 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
1409 // new tile?
1410 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
1411 if (ga <> lastGA) then
1412 begin
1413 // yes
1414 if (ccidx <> -1) then
1415 begin
1416 // signal cell completion
1417 if assigned(cb) then
1418 begin
1419 if cb(nil, 0, xptr^+minx, yptr^+miny, prevx, prevy) then begin result := lastObj; exit; end;
1420 end
1421 else if wasHit then
1422 begin
1423 result := lastObj;
1424 exit;
1425 end;
1426 end;
1427 lastGA := ga;
1428 ccidx := mGrid[lastGA];
1429 end;
1430 // has something to process in this tile?
1431 if (ccidx <> -1) then
1432 begin
1433 // process cell
1434 curci := ccidx;
1435 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1436 // convert coords to map (to avoid ajdusting coords inside the loop)
1437 x := xptr^+minx;
1438 y := yptr^+miny;
1439 // process cell list
1440 while (curci <> -1) do
1441 begin
1442 cc := @mCells[curci];
1443 for f := 0 to High(TGridCell.bodies) do
1444 begin
1445 if (cc.bodies[f] = -1) then break;
1446 px := @mProxies[cc.bodies[f]];
1447 ptag := px.mTag;
1448 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1449 begin
1450 // can we process this proxy?
1451 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
1452 begin
1453 px.mQueryMark := lq; // mark as processed
1454 if assigned(cb) then
1455 begin
1456 if cb(px.mObj, ptag, x, y, prevx, prevy) then
1457 begin
1458 result := lastObj;
1459 ex := prevx;
1460 ey := prevy;
1461 exit;
1462 end;
1463 end
1464 else
1465 begin
1466 // remember this hitpoint if it is nearer than an old one
1467 distSq := distanceSq(ax0, ay0, prevx, prevy);
1468 if (distSq < lastDistSq) then
1469 begin
1470 wasHit := true;
1471 lastDistSq := distSq;
1472 ex := prevx;
1473 ey := prevy;
1474 lastObj := px.mObj;
1475 end;
1476 end;
1477 end
1478 else
1479 begin
1480 // this is possibly interesting proxy, set "has more to check" flag
1481 hasUntried := true;
1482 end;
1483 end;
1484 end;
1485 // next cell
1486 curci := cc.next;
1487 end;
1488 // still has something interesting in this cell?
1489 if not hasUntried then
1490 begin
1491 // nope, don't process this cell anymore; signal cell completion
1492 ccidx := -1;
1493 if assigned(cb) then
1494 begin
1495 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
1496 end
1497 else if wasHit then
1498 begin
1499 result := lastObj;
1500 exit;
1501 end;
1502 end;
1503 end;
1504 //putPixel(xptr^, yptr^);
1505 // move coords
1506 prevx := xptr^+minx;
1507 prevy := yptr^+miny;
1508 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1509 xd += stx;
1510 end;
1511 end;
1512
1513
1514 // ////////////////////////////////////////////////////////////////////////// //
1515 //FIXME! optimize this with real tile walking
1516 function TBodyGridBase.forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1): ITP;
1517 const
1518 tsize = mTileSize;
1519 var
1520 i: Integer;
1521 dx, dy, d: Integer;
1522 xerr, yerr: Integer;
1523 incx, incy: Integer;
1524 stepx, stepy: Integer;
1525 x, y: Integer;
1526 maxx, maxy: Integer;
1527 gw, gh: Integer;
1528 ccidx: Integer;
1529 curci: Integer;
1530 cc: PGridCell;
1531 px: PBodyProxyRec;
1532 lq: LongWord;
1533 minx, miny: Integer;
1534 ptag: Integer;
1535 lastWasInGrid: Boolean;
1536 tbcross: Boolean;
1537 f: Integer;
1538 begin
1539 result := Default(ITP);
1540 tagmask := tagmask and TagFullMask;
1541 if (tagmask = 0) then exit;
1542
1543 minx := mMinX;
1544 miny := mMinY;
1545
1546 dx := x1-x0;
1547 dy := y1-y0;
1548
1549 if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
1550 if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
1551
1552 dx := abs(dx);
1553 dy := abs(dy);
1554
1555 if (dx > dy) then d := dx else d := dy;
1556
1557 // `x` and `y` will be in grid coords
1558 x := x0-minx;
1559 y := y0-miny;
1560
1561 // increase query counter
1562 Inc(mLastQuery);
1563 if (mLastQuery = 0) then
1564 begin
1565 // just in case of overflow
1566 mLastQuery := 1;
1567 for i := 0 to High(mProxies) do mProxies[i].mQueryMark := 0;
1568 end;
1569 lq := mLastQuery;
1570
1571 // cache various things
1572 //tsize := mTileSize;
1573 gw := mWidth;
1574 gh := mHeight;
1575 maxx := gw*tsize-1;
1576 maxy := gh*tsize-1;
1577
1578 // setup distance and flags
1579 lastWasInGrid := (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy);
1580
1581 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1582 if lastWasInGrid then ccidx := mGrid[(y div tsize)*gw+(x div tsize)] else ccidx := -1;
1583
1584 // it is slightly faster this way
1585 xerr := -d;
1586 yerr := -d;
1587
1588 // now trace
1589 for i := 1 to d do
1590 begin
1591 // do one step
1592 xerr += dx;
1593 yerr += dy;
1594 // invariant: one of those always changed
1595 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1596 if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
1597 if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
1598 // invariant: we always doing a step
1599 if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
1600 begin
1601 // check for crossing tile/grid boundary
1602 if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
1603 begin
1604 // we're still in grid
1605 lastWasInGrid := true;
1606 // check for tile edge crossing
1607 if (stepx < 0) and ((x mod tsize) = tsize-1) then tbcross := true
1608 else if (stepx > 0) and ((x mod tsize) = 0) then tbcross := true
1609 else if (stepy < 0) and ((y mod tsize) = tsize-1) then tbcross := true
1610 else if (stepy > 0) and ((y mod tsize) = 0) then tbcross := true
1611 else tbcross := false;
1612 // crossed tile edge?
1613 if tbcross then
1614 begin
1615 // setup new cell index
1616 ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
1617 end;
1618 end
1619 else
1620 begin
1621 // out of grid
1622 if lastWasInGrid then exit; // oops, stepped out of the grid -- there is no way to return
1623 end;
1624 end;
1625
1626 // has something to process in the current cell?
1627 if (ccidx <> -1) then
1628 begin
1629 // process cell
1630 curci := ccidx;
1631 // convert coords to map (to avoid ajdusting coords inside the loop)
1632 Inc(x, minx);
1633 Inc(y, miny);
1634 // process cell list
1635 while (curci <> -1) do
1636 begin
1637 cc := @mCells[curci];
1638 for f := 0 to High(TGridCell.bodies) do
1639 begin
1640 if (cc.bodies[f] = -1) then break;
1641 px := @mProxies[cc.bodies[f]];
1642 ptag := px.mTag;
1643 if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
1644 begin
1645 px.mQueryMark := lq; // mark as processed
1646 if cb(px.mObj, ptag) then begin result := px.mObj; exit; end;
1647 end;
1648 end;
1649 // next cell
1650 curci := cc.next;
1651 end;
1652 ccidx := -1; // don't process this anymore
1653 // convert coords to grid
1654 Dec(x, minx);
1655 Dec(y, miny);
1656 end;
1657 end;
1658 end;
1659
1660
1661 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
DEADSOFTWARE 2012-2025