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}
25 interface
28 type
32 public
33 type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
34 type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop
35 type TGridAlongQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop
42 private
43 const
47 private
48 type
51 private
58 private
68 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
70 private
71 //mTileSize: Integer;
74 public
77 private
90 private
91 // optimized horizontal tracer
92 //function traceRayHOpt (out ex, ey: Integer; const ax0, ay0, ax1, ay1, x0, len, dx: Integer; cb: TGridRayQueryCB; tagmask: Integer): ITP;
94 public
96 {$IF DEFINED(D2F_DEBUG)}
98 {$ENDIF}
100 private
121 public
122 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
125 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
134 // `false` if `body` is surely invalid
139 //WARNING: don't modify grid while any query is in progress (no checks are made!)
140 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
141 // no callback: return `true` on the first hit
142 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
144 //WARNING: don't modify grid while any query is in progress (no checks are made!)
145 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
146 // no callback: return object on the first hit or nil
147 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
149 //WARNING: don't modify grid while any query is in progress (no checks are made!)
150 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
151 // cb with `(nil)` will be called before processing new tile
152 // no callback: return object of the nearest hit or nil
153 // if `inverted` is true, trace will register bodies *exluding* tagmask
154 //WARNING: don't change tags in callbacks here!
155 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
156 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
158 //function traceRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
159 //function traceRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
161 //WARNING: don't modify grid while any query is in progress (no checks are made!)
162 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
163 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
164 //WARNING: don't change tags in callbacks here!
165 function forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
167 // debug
172 //WARNING! no sanity checks!
182 // you are not supposed to understand this
183 // returns `true` if there is an intersection, and enter coords
184 // enter coords will be equal to (x0, y0) if starting point is inside the box
185 // if result is `false`, `inx` and `iny` are undefined
186 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
195 implementation
197 uses
201 // ////////////////////////////////////////////////////////////////////////// //
202 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
203 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
204 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
206 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
209 // ////////////////////////////////////////////////////////////////////////// //
210 // you are not supposed to understand this
211 // returns `true` if there is an intersection, and enter coords
212 // enter coords will be equal to (x0, y0) if starting point is inside the box
213 // if result is `false`, `inx` and `iny` are undefined
214 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
215 var
223 //!term: Integer;
227 begin
229 // why not
235 begin
236 // check this point
238 exit;
241 // check if staring point is inside the box
242 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
244 // clip rectange
250 // horizontal setup
252 begin
253 // from left to right
256 end
257 else
258 begin
259 // from right to left
269 // vertical setup
271 begin
272 // from top to bottom
275 end
276 else
277 begin
278 // from bottom to top
292 begin
301 end
302 else
303 begin
313 //!term := x1;
317 begin
318 // clip at top
324 begin
333 begin
334 // clip at left
344 (*
345 if (y1 > wy1) then
346 begin
347 // clip at bottom
348 temp := dx2*(wy1-y0)+dsx;
349 term := x0+temp div dy2;
350 rem := temp mod dy2;
351 if (rem = 0) then Dec(term);
352 end;
354 if (term > wx1) then term := wx1; // clip at right
356 Inc(term); // draw last point
357 //if (term = xd) then exit; // this is the only point, get out of here
358 *)
362 //!dx2 -= dy2;
370 // ////////////////////////////////////////////////////////////////////////// //
371 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
372 begin
384 // ////////////////////////////////////////////////////////////////////////// //
385 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
386 var
388 begin
390 {$IF DEFINED(D2F_DEBUG)}
392 {$ENDIF}
393 {
394 if aTileSize < 1 then aTileSize := 1;
395 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
396 mTileSize := aTileSize;
397 }
408 // init free list
410 begin
416 // init grid
418 // init proxies
426 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
431 begin
439 // ////////////////////////////////////////////////////////////////////////// //
441 var
443 begin
446 begin
450 begin
456 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);
461 var
464 begin
467 begin
470 begin
473 begin
475 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
477 // next cell
485 var
488 begin
496 begin
499 begin
501 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
503 // next cell
509 // ////////////////////////////////////////////////////////////////////////// //
510 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
511 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
515 begin
516 // fix coords
524 begin
526 begin
529 end
530 else
531 begin
540 begin
542 begin
545 end
546 else
547 begin
555 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
556 begin
558 begin
561 end
562 else
563 begin
574 // ////////////////////////////////////////////////////////////////////////// //
576 begin
582 begin
584 begin
586 begin
588 end
589 else
590 begin
597 // ////////////////////////////////////////////////////////////////////////// //
599 var
602 begin
604 begin
605 // no free cells, want more
609 begin
621 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
626 begin
628 begin
630 begin
641 // ////////////////////////////////////////////////////////////////////////// //
642 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
643 var
646 begin
648 begin
649 // no free proxies, resize list
656 // get one from list
661 // add to used list
663 // statistics
669 begin
671 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
672 // add to free list
680 // ////////////////////////////////////////////////////////////////////////// //
681 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
682 const
684 var
687 begin
690 // fix coords
693 // go on
697 //tsize := mTileSize;
700 begin
704 begin
714 // ////////////////////////////////////////////////////////////////////////// //
716 var
721 begin
723 // add body to the given grid cell
726 begin
727 {$IF DEFINED(D2F_DEBUG)}
730 begin
733 begin
735 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
739 {$ENDIF}
742 begin
744 // check "has room" flag
746 begin
747 // can add here
749 begin
751 begin
754 exit;
759 // no room, go to next cell in list (if there is any)
762 // no room in cells, add new cell to list
764 // either no room, or no cell at all
774 var
776 begin
783 // assume that we cannot have one object added to bucket twice
785 var
789 begin
791 // find and remove cell
795 begin
798 begin
800 begin
801 // i found her!
803 begin
804 // this cell contains no elements, remove it
807 exit;
809 // remove element from bucket
811 begin
816 exit;
825 var
827 begin
834 // ////////////////////////////////////////////////////////////////////////// //
835 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
836 begin
844 begin
851 // ////////////////////////////////////////////////////////////////////////// //
853 var
856 begin
863 {$IF DEFINED(D2F_DEBUG_MOVER)}
864 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);
865 {$ENDIF}
867 // map -> grid
872 // did any corner crossed tile boundary?
877 begin
884 end
885 else
886 begin
894 //TODO: optimize for horizontal/vertical moves
896 var
904 begin
906 // check if tile coords was changed
911 // map -> grid
916 // check for heavy work
927 {$IF DEFINED(D2F_DEBUG_MOVER)}
928 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);
929 {$ENDIF}
931 begin
932 // crossed tile boundary, do heavy work
935 // cycle with old rect, remove body where it is necessary
936 // optimized for horizontal moves
937 {$IF DEFINED(D2F_DEBUG_MOVER)}
938 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);
939 {$ENDIF}
940 // remove stale marks
943 begin
948 {$IF DEFINED(D2F_DEBUG_MOVER)}
950 {$ENDIF}
952 begin
954 begin
955 // this column is completely outside of new rect
957 begin
958 {$IF DEFINED(D2F_DEBUG_MOVER)}
960 {$ENDIF}
963 end
964 else
965 begin
966 // heavy checks
968 begin
970 begin
971 {$IF DEFINED(D2F_DEBUG_MOVER)}
973 {$ENDIF}
980 // cycle with new rect, add body where it is necessary
983 begin
988 {$IF DEFINED(D2F_DEBUG_MOVER)}
990 {$ENDIF}
992 begin
994 begin
995 // this column is completely outside of old rect
997 begin
998 {$IF DEFINED(D2F_DEBUG_MOVER)}
1000 {$ENDIF}
1003 end
1004 else
1005 begin
1006 // heavy checks
1008 begin
1010 begin
1011 {$IF DEFINED(D2F_DEBUG_MOVER)}
1013 {$ENDIF}
1020 // done
1021 end
1022 else
1023 begin
1024 {$IF DEFINED(D2F_DEBUG_MOVER)}
1025 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);
1026 {$ENDIF}
1028 // update coordinates
1034 var
1037 begin
1039 // check if tile coords was changed
1045 {$IF DEFINED(D2F_DEBUG_MOVER)}
1046 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);
1047 {$ENDIF}
1050 begin
1051 // crossed tile boundary, do heavy work
1056 end
1057 else
1058 begin
1059 // nothing to do with the grid, just fix size
1066 // ////////////////////////////////////////////////////////////////////////// //
1067 // no callback: return `true` on the first hit
1068 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1069 var
1076 begin
1082 {$IF DEFINED(D2F_DEBUG_XXQ)}
1084 {$ENDIF}
1086 // make coords (0,0)-based
1093 {$IF DEFINED(D2F_DEBUG_XXQ)}
1094 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);
1095 {$ENDIF}
1097 // restore coords
1101 // increase query counter
1104 begin
1105 // just in case of overflow
1111 {$IF DEFINED(D2F_DEBUG_XXQ)}
1112 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1113 {$ENDIF}
1116 begin
1117 {$IF DEFINED(D2F_DEBUG_XXQ)}
1119 {$ENDIF}
1122 begin
1125 {$IF DEFINED(D2F_DEBUG_XXQ)}
1126 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);
1127 {$ENDIF}
1128 // shit. has to do it this way, so i can change tag in callback
1130 begin
1135 begin
1137 begin
1139 begin
1142 exit;
1144 end
1145 else
1146 begin
1149 exit;
1159 // ////////////////////////////////////////////////////////////////////////// //
1160 // no callback: return `true` on the first hit
1161 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1162 const
1164 var
1175 begin
1184 // fix coords
1189 //tsize := mTileSize;
1194 // increase query counter
1197 begin
1198 // just in case of overflow
1202 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1205 // go on
1207 begin
1211 begin
1214 // process cells
1217 begin
1220 begin
1223 // shit. has to do it this way, so i can change tag in callback
1232 begin
1234 end
1235 else
1236 begin
1238 exit;
1248 // ////////////////////////////////////////////////////////////////////////// //
1249 // no callback: return `true` on the nearest hit
1250 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1251 var
1253 begin
1258 // no callback: return `true` on the nearest hit
1259 // you are not supposed to understand this
1260 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1261 const
1263 var
1289 // horizontal walker
1291 begin
1300 begin
1303 begin
1306 exit;
1318 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1319 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);
1320 {$ENDIF}
1327 // offset query coords to (0,0)-based
1333 // clip rectange
1339 // horizontal setup
1341 begin
1342 // from left to right
1345 end
1346 else
1347 begin
1348 // from right to left
1358 // vertical setup
1360 begin
1361 // from top to bottom
1364 end
1365 else
1366 begin
1367 // from bottom to top
1381 begin
1390 end
1391 else
1392 begin
1406 begin
1407 // clip at top
1413 begin
1422 begin
1423 // clip at left
1434 begin
1435 // clip at bottom
1445 //if (term = xd) then exit; // this is the only point, get out of here
1451 // first move, to skip starting point
1452 // DON'T DO THIS! loop will take care of that
1454 begin
1457 begin
1459 begin
1461 begin
1464 end
1465 else
1466 begin
1469 end
1470 else
1471 begin
1476 exit;
1481 (*
1482 // move coords
1483 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1484 xd += stx;
1485 // done?
1486 if (xd = term) then exit;
1487 *)
1489 {$IF DEFINED(D2F_DEBUG)}
1490 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1491 {$ENDIF}
1492 // DON'T DO THIS! loop will take care of that
1493 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1494 //ccidx := mGrid[lastGA];
1496 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1497 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1498 {$ENDIF}
1500 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1502 // increase query counter
1505 begin
1506 // just in case of overflow
1512 // if this is strict horizontal/vertical trace, use optimized codepath
1514 begin
1515 //if dbgShowTraceLog then e_LogWritefln('!!!', []);
1516 // horizontal trace
1517 // for horizontal traces, we'll walk the whole tiles, calculating mindist once for each proxy in cell
1518 // one step:
1519 // while (xd <> term) do
1520 // if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1521 // xd += stx;
1523 {$IF DEFINED(D2F_DEBUG)}
1525 {$ENDIF}
1528 {$IF DEFINED(D2F_DEBUG)}
1530 {$ENDIF}
1532 begin
1533 {$IF DEFINED(D2F_DEBUG)}
1534 if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d; y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]);
1535 {$ENDIF}
1536 // new tile?
1538 begin
1541 // convert coords to map (to avoid ajdusting coords inside the loop)
1544 begin
1547 begin
1553 begin
1555 // inside the proxy; something that should not be
1557 begin
1558 //raise Exception.Create('abosultely impossible embedding in htrace');
1560 begin
1562 begin
1566 exit;
1568 end
1569 else
1570 begin
1572 {$IF DEFINED(D2F_DEBUG)}
1573 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]);
1574 {$ENDIF}
1576 begin
1580 exit;
1583 continue;
1585 // remember this hitpoint if it is nearer than an old one
1588 begin
1591 begin
1595 exit;
1597 end
1598 else
1599 begin
1601 {$IF DEFINED(D2F_DEBUG)}
1602 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, wkpos, y, distSq, lastDistSq]);
1603 {$ENDIF}
1605 begin
1615 // next cell
1620 // skip to next tile
1622 begin
1623 // to the right
1625 {$IF DEFINED(D2F_DEBUG)}
1627 {$ENDIF}
1631 end
1632 else
1633 begin
1634 // to the left
1636 {$IF DEFINED(D2F_DEBUG)}
1638 {$ENDIF}
1644 // we can travel less than one cell
1646 exit;
1649 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1650 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1651 {$ENDIF}
1654 // can omit checks
1656 begin
1657 // check cell(s)
1658 {$IF DEFINED(D2F_DEBUG)}
1659 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1660 {$ENDIF}
1661 // new tile?
1663 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1664 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);
1665 {$ENDIF}
1667 begin
1668 // yes
1669 {$IF DEFINED(D2F_DEBUG)}
1670 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1671 {$ENDIF}
1673 begin
1674 // signal cell completion
1676 begin
1678 end
1680 begin
1682 exit;
1688 // has something to process in this tile?
1690 begin
1691 // process cell
1693 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1694 // convert coords to map (to avoid ajdusting coords inside the loop)
1697 // process cell list
1699 begin
1702 begin
1707 begin
1708 // can we process this proxy?
1710 begin
1713 begin
1715 begin
1719 exit;
1721 (*
1722 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1723 distSq := distanceSq(ax0, ay0, prevx, prevy);
1724 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);
1725 if (distSq < lastDistSq) then
1726 begin
1727 wasHit := true;
1728 lastDistSq := distSq;
1729 ex := prevx;
1730 ey := prevy;
1731 lastObj := px.mObj;
1732 end;
1733 {$ENDIF}
1734 *)
1735 end
1736 else
1737 begin
1738 // remember this hitpoint if it is nearer than an old one
1740 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1741 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);
1742 {$ENDIF}
1744 begin
1752 end
1753 else
1754 begin
1755 // this is possibly interesting proxy, set "has more to check" flag
1760 // next cell
1763 // still has something interesting in this cell?
1765 begin
1766 // nope, don't process this cell anymore; signal cell completion
1769 begin
1771 end
1773 begin
1775 exit;
1779 //putPixel(xptr^, yptr^);
1780 // move coords
1786 // we can travel less than one cell
1788 begin
1790 end
1791 else
1792 begin
1799 // ////////////////////////////////////////////////////////////////////////// //
1800 //FIXME! optimize this with real tile walking
1801 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1802 const
1804 var
1823 //tedist: Integer;
1824 begin
1846 // `x` and `y` will be in grid coords
1850 // increase query counter
1853 begin
1854 // just in case of overflow
1860 // cache various things
1861 //tsize := mTileSize;
1867 // setup distance and flags
1870 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1873 // it is slightly faster this way
1877 if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1879 // now trace
1882 begin
1884 // do one step
1887 // invariant: one of those always changed
1888 {$IF DEFINED(D2F_DEBUG)}
1889 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1890 {$ENDIF}
1893 // invariant: we always doing a step
1894 {$IF DEFINED(D2F_DEBUG)}
1896 {$ENDIF}
1897 begin
1898 // check for crossing tile/grid boundary
1900 begin
1901 // we're still in grid
1903 // check for tile edge crossing
1909 // crossed tile edge?
1911 begin
1912 // setup new cell index
1914 if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1915 end
1916 else
1918 begin
1919 // we have nothing interesting here anymore, jump directly to tile edge
1920 (*
1921 if (incx = 0) then
1922 begin
1923 // vertical line
1924 if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1925 if (tedist > 1) then
1926 begin
1927 if (log) then e_WriteLog(Format(' doing vertical jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1928 y += incy*tedist;
1929 Inc(i, tedist);
1930 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1931 end;
1932 end
1933 else if (incy = 0) then
1934 begin
1935 // horizontal line
1936 if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1937 if (tedist > 1) then
1938 begin
1939 if (log) then e_WriteLog(Format(' doing horizontal jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1940 x += incx*tedist;
1941 Inc(i, tedist);
1942 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1943 end;
1944 end;
1945 *)
1946 (*
1947 else if (
1948 // get minimal distance to tile edges
1949 if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1950 {$IF DEFINED(D2F_DEBUG)}
1951 if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1952 {$ENDIF}
1953 if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1954 {$IF DEFINED(D2F_DEBUG)}
1955 if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1956 {$ENDIF}
1957 if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1958 // do jump
1959 if (tedist > 1) then
1960 begin
1961 if (log) then e_WriteLog(Format(' doing jump from tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1962 xerr += dx*tedist;
1963 yerr += dy*tedist;
1964 if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1965 if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1966 Inc(i, tedist);
1967 if (log) then e_WriteLog(Format(' jumped to tile (%d,%d) - (%d,%d) by %d steps', [(x div tsize), (y div tsize), x, y, tedist]), MSG_NOTIFY);
1968 end;
1969 *)
1971 end
1972 else
1973 begin
1974 // out of grid
1979 // has something to process in the current cell?
1981 begin
1982 // process cell
1984 // convert coords to map (to avoid ajdusting coords inside the loop)
1985 //Inc(x, minx);
1986 //Inc(y, miny);
1987 // process cell list
1989 begin
1992 begin
1997 begin
2002 // next cell
2006 // convert coords to grid
2007 //Dec(x, minx);
2008 //Dec(y, miny);
2014 // ////////////////////////////////////////////////////////////////////////// //
2015 (*
2016 function TBodyGridBase.traceRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
2017 var
2018 ex, ey: Integer;
2019 begin
2020 result := traceRayWhileIn(ex, ey, x0, y0, x1, y1, tagmask);
2021 end;
2024 // FUCKIN' PASTA!
2025 function TBodyGridBase.traceRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
2026 const
2027 tsize = mTileSize;
2028 var
2029 wx0, wy0, wx1, wy1: Integer; // window coordinates
2030 stx, sty: Integer; // "steps" for x and y axes
2031 dsx, dsy: Integer; // "lengthes" for x and y axes
2032 dx2, dy2: Integer; // "double lengthes" for x and y axes
2033 xd, yd: Integer; // current coord
2034 e: Integer; // "error" (as in bresenham algo)
2035 rem: Integer;
2036 term: Integer;
2037 xptr, yptr: PInteger;
2038 xfixed: Boolean;
2039 temp: Integer;
2040 prevx, prevy: Integer;
2041 lastDistSq: Integer;
2042 ccidx, curci: Integer;
2043 hasUntried: Boolean;
2044 lastGA: Integer = -1;
2045 ga, x, y: Integer;
2046 lastObj: ITP;
2047 wasHit: Boolean = false;
2048 gw, gh, minx, miny, maxx, maxy: Integer;
2049 cc: PGridCell;
2050 px: PBodyProxyRec;
2051 lq: LongWord;
2052 f, ptag, distSq: Integer;
2053 x0, y0, x1, y1: Integer;
2054 inx, iny: Integer;
2055 begin
2056 result := Default(ITP);
2057 lastObj := Default(ITP);
2058 tagmask := tagmask and TagFullMask;
2059 ex := ax1; // why not?
2060 ey := ay1; // why not?
2061 if (tagmask = 0) then exit;
2063 if (ax0 = ax1) and (ay0 = ay1) then exit; // doesn't matter
2065 // we should start inside
2066 if (forEachAtPoint(ax0, ay0, nil, tagmask, @ptag) = nil) then
2067 begin
2068 ex := ax0; // why not?
2069 ey := ay0; // why not?
2070 exit;
2071 end;
2073 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
2075 gw := mWidth;
2076 gh := mHeight;
2077 minx := mMinX;
2078 miny := mMinY;
2079 maxx := gw*tsize-1;
2080 maxy := gh*tsize-1;
2082 x0 := ax0;
2083 y0 := ay0;
2084 x1 := ax1;
2085 y1 := ay1;
2087 // offset query coords to (0,0)-based
2088 Dec(x0, minx);
2089 Dec(y0, miny);
2090 Dec(x1, minx);
2091 Dec(y1, miny);
2093 // clip rectange
2094 wx0 := 0;
2095 wy0 := 0;
2096 wx1 := maxx;
2097 wy1 := maxy;
2099 // horizontal setup
2100 if (x0 < x1) then
2101 begin
2102 // from left to right
2103 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
2104 stx := 1; // going right
2105 end
2106 else
2107 begin
2108 // from right to left
2109 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
2110 stx := -1; // going left
2111 x0 := -x0;
2112 x1 := -x1;
2113 wx0 := -wx0;
2114 wx1 := -wx1;
2115 swapInt(wx0, wx1);
2116 end;
2118 // vertical setup
2119 if (y0 < y1) then
2120 begin
2121 // from top to bottom
2122 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
2123 sty := 1; // going down
2124 end
2125 else
2126 begin
2127 // from bottom to top
2128 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
2129 sty := -1; // going up
2130 y0 := -y0;
2131 y1 := -y1;
2132 wy0 := -wy0;
2133 wy1 := -wy1;
2134 swapInt(wy0, wy1);
2135 end;
2137 dsx := x1-x0;
2138 dsy := y1-y0;
2140 if (dsx < dsy) then
2141 begin
2142 xptr := @yd;
2143 yptr := @xd;
2144 swapInt(x0, y0);
2145 swapInt(x1, y1);
2146 swapInt(dsx, dsy);
2147 swapInt(wx0, wy0);
2148 swapInt(wx1, wy1);
2149 swapInt(stx, sty);
2150 end
2151 else
2152 begin
2153 xptr := @xd;
2154 yptr := @yd;
2155 end;
2157 dx2 := 2*dsx;
2158 dy2 := 2*dsy;
2159 xd := x0;
2160 yd := y0;
2161 e := 2*dsy-dsx;
2162 term := x1;
2164 xfixed := false;
2165 if (y0 < wy0) then
2166 begin
2167 // clip at top
2168 temp := dx2*(wy0-y0)-dsx;
2169 xd += temp div dy2;
2170 rem := temp mod dy2;
2171 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2172 if (xd+1 >= wx0) then
2173 begin
2174 yd := wy0;
2175 e -= rem+dsx;
2176 if (rem > 0) then begin Inc(xd); e += dy2; end;
2177 xfixed := true;
2178 end;
2179 end;
2181 if (not xfixed) and (x0 < wx0) then
2182 begin
2183 // clip at left
2184 temp := dy2*(wx0-x0);
2185 yd += temp div dx2;
2186 rem := temp mod dx2;
2187 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2188 xd := wx0;
2189 e += rem;
2190 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2191 end;
2193 if (y1 > wy1) then
2194 begin
2195 // clip at bottom
2196 temp := dx2*(wy1-y0)+dsx;
2197 term := x0+temp div dy2;
2198 rem := temp mod dy2;
2199 if (rem = 0) then Dec(term);
2200 end;
2202 if (term > wx1) then term := wx1; // clip at right
2204 Inc(term); // draw last point
2205 //if (term = xd) then exit; // this is the only point, get out of here
2207 if (sty = -1) then yd := -yd;
2208 if (stx = -1) then begin xd := -xd; term := -term; end;
2209 dx2 -= dy2;
2211 // first move, to skip starting point
2212 // DON'T DO THIS! loop will take care of that
2213 if (xd = term) then
2214 begin
2215 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2216 if (result <> nil) and ((ptag and tagmask) <> 0) then result := nil;
2217 exit;
2218 end;
2220 prevx := xptr^+minx;
2221 prevy := yptr^+miny;
2223 // increase query counter
2224 Inc(mLastQuery);
2225 if (mLastQuery = 0) then
2226 begin
2227 // just in case of overflow
2228 mLastQuery := 1;
2229 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2230 end;
2231 lq := mLastQuery;
2233 ccidx := -1;
2234 // draw it; can omit checks
2235 while (xd <> term) do
2236 begin
2237 // check cell(s)
2238 // new tile?
2239 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2240 if (ga <> lastGA) then
2241 begin
2242 // yes
2243 lastGA := ga;
2244 ccidx := mGrid[lastGA];
2245 // no objects in cell == exit
2246 if (ccidx = -1) then exit;
2247 end;
2248 // has something to process in this tile?
2249 if (ccidx <> -1) then
2250 begin
2251 // process cell
2252 curci := ccidx;
2253 // convert coords to map (to avoid ajdusting coords inside the loop)
2254 x := xptr^+minx;
2255 y := yptr^+miny;
2256 wasHit := false;
2257 // process cell list
2258 while (curci <> -1) do
2259 begin
2260 cc := @mCells[curci];
2261 for f := 0 to GridCellBucketSize-1 do
2262 begin
2263 if (cc.bodies[f] = -1) then break;
2264 px := @mProxies[cc.bodies[f]];
2265 ptag := px.mTag;
2266 if ((ptag and TagDisabled) = 0) and (px.mQueryMark <> lq) then
2267 begin
2268 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
2269 // can we process this proxy?
2270 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2271 begin
2272 px.mQueryMark := lq; // mark as processed
2273 if ((ptag and tagmask) = 0) then
2274 begin
2275 result := px.mObj;
2276 ex := x;
2277 ey := y;
2278 exit;
2279 end;
2280 // march out of the panel/cell
2281 while (xd <> term) do
2282 begin
2283 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2284 xd += stx;
2285 // new cell?
2286 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2287 if (ga <> lastGA) then break;
2288 // out of panel?
2289 if not ((x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight)) then break;
2290 end;
2291 end;
2292 end;
2293 end;
2294 // next cell
2295 curci := cc.next;
2296 end;
2297 // still has something interesting in this cell?
2298 if not hasUntried then
2299 begin
2300 // nope, don't process this cell anymore; signal cell completion
2301 ccidx := -1;
2302 if assigned(cb) then
2303 begin
2304 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
2305 end
2306 else if wasHit then
2307 begin
2308 result := lastObj;
2309 exit;
2310 end;
2311 end;
2312 end;
2313 //putPixel(xptr^, yptr^);
2314 // move coords
2315 prevx := xptr^+minx;
2316 prevy := yptr^+miny;
2317 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2318 xd += stx;
2319 end;
2320 // we can travel less than one cell
2321 if wasHit and not assigned(cb) then
2322 begin
2323 result := lastObj;
2324 end
2325 else
2326 begin
2327 ex := ax1; // why not?
2328 ey := ay1; // why not?
2329 end;
2330 end;
2331 *)