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 public
92 {$IF DEFINED(D2F_DEBUG)}
94 {$ENDIF}
96 private
117 public
118 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
121 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
130 // `false` if `body` is surely invalid
135 //WARNING: don't modify grid while any query is in progress (no checks are made!)
136 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
137 // no callback: return `true` on the first hit
138 function forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
140 //WARNING: don't modify grid while any query is in progress (no checks are made!)
141 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
142 // no callback: return object on the first hit or nil
143 function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
145 //WARNING: don't modify grid while any query is in progress (no checks are made!)
146 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
147 // cb with `(nil)` will be called before processing new tile
148 // no callback: return object of the nearest hit or nil
149 // if `inverted` is true, trace will register bodies *exluding* tagmask
150 //WARNING: don't change tags in callbacks here!
151 function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
152 function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
154 //function traceRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
155 //function traceRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
157 //WARNING: don't modify grid while any query is in progress (no checks are made!)
158 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
159 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
160 //WARNING: don't change tags in callbacks here!
161 function forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
163 // debug
168 //WARNING! no sanity checks!
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;
191 implementation
193 uses
197 // ////////////////////////////////////////////////////////////////////////// //
198 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
199 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
200 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
202 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
205 // ////////////////////////////////////////////////////////////////////////// //
206 // you are not supposed to understand this
207 // returns `true` if there is an intersection, and enter coords
208 // enter coords will be equal to (x0, y0) if starting point is inside the box
209 // if result is `false`, `inx` and `iny` are undefined
210 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
211 var
219 //!term: Integer;
223 begin
225 // why not
231 begin
232 // check this point
234 exit;
237 // check if staring point is inside the box
238 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
240 // clip rectange
246 // horizontal setup
248 begin
249 // from left to right
252 end
253 else
254 begin
255 // from right to left
265 // vertical setup
267 begin
268 // from top to bottom
271 end
272 else
273 begin
274 // from bottom to top
288 begin
297 end
298 else
299 begin
309 //!term := x1;
313 begin
314 // clip at top
320 begin
329 begin
330 // clip at left
340 (*
341 if (y1 > wy1) then
342 begin
343 // clip at bottom
344 temp := dx2*(wy1-y0)+dsx;
345 term := x0+temp div dy2;
346 rem := temp mod dy2;
347 if (rem = 0) then Dec(term);
348 end;
350 if (term > wx1) then term := wx1; // clip at right
352 Inc(term); // draw last point
353 //if (term = xd) then exit; // this is the only point, get out of here
354 *)
358 //!dx2 -= dy2;
366 // ////////////////////////////////////////////////////////////////////////// //
367 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
368 begin
380 // ////////////////////////////////////////////////////////////////////////// //
381 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
382 var
384 begin
386 {$IF DEFINED(D2F_DEBUG)}
388 {$ENDIF}
389 {
390 if aTileSize < 1 then aTileSize := 1;
391 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
392 mTileSize := aTileSize;
393 }
404 // init free list
406 begin
412 // init grid
414 // init proxies
422 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
427 begin
435 // ////////////////////////////////////////////////////////////////////////// //
437 var
439 begin
442 begin
446 begin
452 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);
457 var
460 begin
463 begin
466 begin
469 begin
471 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
473 // next cell
481 var
484 begin
492 begin
495 begin
497 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
499 // next cell
505 // ////////////////////////////////////////////////////////////////////////// //
506 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
507 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
511 begin
512 // fix coords
520 begin
522 begin
525 end
526 else
527 begin
536 begin
538 begin
541 end
542 else
543 begin
551 function TBodyGridBase.getBodyDims (body: TBodyProxyId; out rx, ry, rw, rh: Integer): Boolean; inline;
552 begin
554 begin
557 end
558 else
559 begin
570 // ////////////////////////////////////////////////////////////////////////// //
572 begin
578 begin
580 begin
582 begin
584 end
585 else
586 begin
593 // ////////////////////////////////////////////////////////////////////////// //
595 var
598 begin
600 begin
601 // no free cells, want more
605 begin
617 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
622 begin
624 begin
626 begin
637 // ////////////////////////////////////////////////////////////////////////// //
638 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
639 var
642 begin
644 begin
645 // no free proxies, resize list
652 // get one from list
657 // add to used list
659 // statistics
665 begin
667 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
668 // add to free list
676 // ////////////////////////////////////////////////////////////////////////// //
677 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
678 const
680 var
683 begin
686 // fix coords
689 // go on
693 //tsize := mTileSize;
696 begin
700 begin
710 // ////////////////////////////////////////////////////////////////////////// //
712 var
717 begin
719 // add body to the given grid cell
722 begin
723 {$IF DEFINED(D2F_DEBUG)}
726 begin
729 begin
731 if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy');
735 {$ENDIF}
738 begin
740 // check "has room" flag
742 begin
743 // can add here
745 begin
747 begin
750 exit;
755 // no room, go to next cell in list (if there is any)
758 // no room in cells, add new cell to list
760 // either no room, or no cell at all
770 var
772 begin
779 // assume that we cannot have one object added to bucket twice
781 var
785 begin
787 // find and remove cell
791 begin
794 begin
796 begin
797 // i found her!
799 begin
800 // this cell contains no elements, remove it
803 exit;
805 // remove element from bucket
807 begin
812 exit;
821 var
823 begin
830 // ////////////////////////////////////////////////////////////////////////// //
831 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
832 begin
840 begin
847 // ////////////////////////////////////////////////////////////////////////// //
849 var
852 begin
859 {$IF DEFINED(D2F_DEBUG_MOVER)}
860 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);
861 {$ENDIF}
863 // map -> grid
868 // did any corner crossed tile boundary?
873 begin
880 end
881 else
882 begin
890 //TODO: optimize for horizontal/vertical moves
892 var
900 begin
902 // check if tile coords was changed
907 // map -> grid
912 // check for heavy work
923 {$IF DEFINED(D2F_DEBUG_MOVER)}
924 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);
925 {$ENDIF}
927 begin
928 // crossed tile boundary, do heavy work
931 // cycle with old rect, remove body where it is necessary
932 // optimized for horizontal moves
933 {$IF DEFINED(D2F_DEBUG_MOVER)}
934 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);
935 {$ENDIF}
936 // remove stale marks
939 begin
944 {$IF DEFINED(D2F_DEBUG_MOVER)}
946 {$ENDIF}
948 begin
950 begin
951 // this column is completely outside of new rect
953 begin
954 {$IF DEFINED(D2F_DEBUG_MOVER)}
956 {$ENDIF}
959 end
960 else
961 begin
962 // heavy checks
964 begin
966 begin
967 {$IF DEFINED(D2F_DEBUG_MOVER)}
969 {$ENDIF}
976 // cycle with new rect, add body where it is necessary
979 begin
984 {$IF DEFINED(D2F_DEBUG_MOVER)}
986 {$ENDIF}
988 begin
990 begin
991 // this column is completely outside of old rect
993 begin
994 {$IF DEFINED(D2F_DEBUG_MOVER)}
996 {$ENDIF}
999 end
1000 else
1001 begin
1002 // heavy checks
1004 begin
1006 begin
1007 {$IF DEFINED(D2F_DEBUG_MOVER)}
1009 {$ENDIF}
1016 // done
1017 end
1018 else
1019 begin
1020 {$IF DEFINED(D2F_DEBUG_MOVER)}
1021 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);
1022 {$ENDIF}
1024 // update coordinates
1030 var
1033 begin
1035 // check if tile coords was changed
1041 {$IF DEFINED(D2F_DEBUG_MOVER)}
1042 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);
1043 {$ENDIF}
1046 begin
1047 // crossed tile boundary, do heavy work
1052 end
1053 else
1054 begin
1055 // nothing to do with the grid, just fix size
1062 // ////////////////////////////////////////////////////////////////////////// //
1063 // no callback: return `true` on the first hit
1064 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP;
1065 var
1072 begin
1078 {$IF DEFINED(D2F_DEBUG_XXQ)}
1080 {$ENDIF}
1082 // make coords (0,0)-based
1089 {$IF DEFINED(D2F_DEBUG_XXQ)}
1090 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);
1091 {$ENDIF}
1093 // restore coords
1097 // increase query counter
1100 begin
1101 // just in case of overflow
1107 {$IF DEFINED(D2F_DEBUG_XXQ)}
1108 if (assigned(cb)) then e_WriteLog(Format('2: grid pointquery: (%d,%d); lq=%u', [x, y, lq]), MSG_NOTIFY);
1109 {$ENDIF}
1112 begin
1113 {$IF DEFINED(D2F_DEBUG_XXQ)}
1115 {$ENDIF}
1118 begin
1121 {$IF DEFINED(D2F_DEBUG_XXQ)}
1122 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);
1123 {$ENDIF}
1124 // shit. has to do it this way, so i can change tag in callback
1126 begin
1131 begin
1133 begin
1135 begin
1138 exit;
1140 end
1141 else
1142 begin
1145 exit;
1155 // ////////////////////////////////////////////////////////////////////////// //
1156 // no callback: return `true` on the first hit
1157 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
1158 const
1160 var
1171 begin
1180 // fix coords
1185 //tsize := mTileSize;
1190 // increase query counter
1193 begin
1194 // just in case of overflow
1198 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
1201 // go on
1203 begin
1207 begin
1210 // process cells
1213 begin
1216 begin
1219 // shit. has to do it this way, so i can change tag in callback
1228 begin
1230 end
1231 else
1232 begin
1234 exit;
1244 // ////////////////////////////////////////////////////////////////////////// //
1245 // no callback: return `true` on the nearest hit
1246 function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1247 var
1249 begin
1254 // no callback: return `true` on the nearest hit
1255 // you are not supposed to understand this
1256 function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1257 const
1259 var
1285 begin
1294 begin
1297 begin
1300 exit;
1312 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1313 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);
1314 {$ENDIF}
1321 // offset query coords to (0,0)-based
1327 // clip rectange
1333 // horizontal setup
1335 begin
1336 // from left to right
1339 end
1340 else
1341 begin
1342 // from right to left
1352 // vertical setup
1354 begin
1355 // from top to bottom
1358 end
1359 else
1360 begin
1361 // from bottom to top
1375 begin
1384 end
1385 else
1386 begin
1400 begin
1401 // clip at top
1407 begin
1416 begin
1417 // clip at left
1428 begin
1429 // clip at bottom
1439 //if (term = xd) then exit; // this is the only point, get out of here
1445 // first move, to skip starting point
1446 // DON'T DO THIS! loop will take care of that
1448 begin
1451 begin
1453 begin
1455 begin
1458 end
1459 else
1460 begin
1463 end
1464 else
1465 begin
1470 exit;
1475 (*
1476 // move coords
1477 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
1478 xd += stx;
1479 // done?
1480 if (xd = term) then exit;
1481 *)
1483 {$IF DEFINED(D2F_DEBUG)}
1484 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1485 {$ENDIF}
1486 // DON'T DO THIS! loop will take care of that
1487 //lastGA := (yptr^ div tsize)*gw+(xptr^ div tsize);
1488 //ccidx := mGrid[lastGA];
1490 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1491 //if assigned(dbgRayTraceTileHitCB) then e_WriteLog('1:TRACING!', MSG_NOTIFY);
1492 {$ENDIF}
1494 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1495 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1496 {$ENDIF}
1498 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1500 // increase query counter
1503 begin
1504 // just in case of overflow
1511 // draw it; can omit checks
1513 begin
1514 // check cell(s)
1515 {$IF DEFINED(D2F_DEBUG)}
1516 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ >= gh*tsize) then raise Exception.Create('raycaster internal error (0)');
1517 {$ENDIF}
1518 // new tile?
1520 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1521 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);
1522 {$ENDIF}
1524 begin
1525 // yes
1526 {$IF DEFINED(D2F_DEBUG)}
1527 if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB((xptr^ div tsize*tsize)+minx, (yptr^ div tsize*tsize)+miny);
1528 {$ENDIF}
1530 begin
1531 // signal cell completion
1533 begin
1535 end
1537 begin
1539 exit;
1545 // has something to process in this tile?
1547 begin
1548 // process cell
1550 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1551 // convert coords to map (to avoid ajdusting coords inside the loop)
1554 // process cell list
1556 begin
1559 begin
1564 begin
1565 // can we process this proxy?
1567 begin
1570 begin
1572 begin
1576 exit;
1578 (*
1579 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1580 distSq := distanceSq(ax0, ay0, prevx, prevy);
1581 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);
1582 if (distSq < lastDistSq) then
1583 begin
1584 wasHit := true;
1585 lastDistSq := distSq;
1586 ex := prevx;
1587 ey := prevy;
1588 lastObj := px.mObj;
1589 end;
1590 {$ENDIF}
1591 *)
1592 end
1593 else
1594 begin
1595 // remember this hitpoint if it is nearer than an old one
1597 {$IF DEFINED(D2F_DEBUG_RAYTRACE)}
1598 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);
1599 {$ENDIF}
1601 begin
1609 end
1610 else
1611 begin
1612 // this is possibly interesting proxy, set "has more to check" flag
1617 // next cell
1620 // still has something interesting in this cell?
1622 begin
1623 // nope, don't process this cell anymore; signal cell completion
1626 begin
1628 end
1630 begin
1632 exit;
1636 //putPixel(xptr^, yptr^);
1637 // move coords
1643 // we can travel less than one cell
1645 begin
1647 end
1648 else
1649 begin
1656 // ////////////////////////////////////////////////////////////////////////// //
1657 //FIXME! optimize this with real tile walking
1658 function TBodyGridBase.forEachAlongLine (const x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1659 const
1661 var
1680 //tedist: Integer;
1681 begin
1703 // `x` and `y` will be in grid coords
1707 // increase query counter
1710 begin
1711 // just in case of overflow
1717 // cache various things
1718 //tsize := mTileSize;
1724 // setup distance and flags
1727 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1730 // it is slightly faster this way
1734 if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1736 // now trace
1739 begin
1741 // do one step
1744 // invariant: one of those always changed
1745 {$IF DEFINED(D2F_DEBUG)}
1746 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1747 {$ENDIF}
1750 // invariant: we always doing a step
1751 {$IF DEFINED(D2F_DEBUG)}
1753 {$ENDIF}
1754 begin
1755 // check for crossing tile/grid boundary
1757 begin
1758 // we're still in grid
1760 // check for tile edge crossing
1766 // crossed tile edge?
1768 begin
1769 // setup new cell index
1771 if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1772 end
1773 else
1775 begin
1776 // we have nothing interesting here anymore, jump directly to tile edge
1777 (*
1778 if (incx = 0) then
1779 begin
1780 // vertical line
1781 if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1782 if (tedist > 1) then
1783 begin
1784 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);
1785 y += incy*tedist;
1786 Inc(i, tedist);
1787 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);
1788 end;
1789 end
1790 else if (incy = 0) then
1791 begin
1792 // horizontal line
1793 if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1794 if (tedist > 1) then
1795 begin
1796 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);
1797 x += incx*tedist;
1798 Inc(i, tedist);
1799 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);
1800 end;
1801 end;
1802 *)
1803 (*
1804 else if (
1805 // get minimal distance to tile edges
1806 if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1807 {$IF DEFINED(D2F_DEBUG)}
1808 if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1809 {$ENDIF}
1810 if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1811 {$IF DEFINED(D2F_DEBUG)}
1812 if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1813 {$ENDIF}
1814 if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1815 // do jump
1816 if (tedist > 1) then
1817 begin
1818 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);
1819 xerr += dx*tedist;
1820 yerr += dy*tedist;
1821 if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1822 if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1823 Inc(i, tedist);
1824 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);
1825 end;
1826 *)
1828 end
1829 else
1830 begin
1831 // out of grid
1836 // has something to process in the current cell?
1838 begin
1839 // process cell
1841 // convert coords to map (to avoid ajdusting coords inside the loop)
1842 //Inc(x, minx);
1843 //Inc(y, miny);
1844 // process cell list
1846 begin
1849 begin
1854 begin
1859 // next cell
1863 // convert coords to grid
1864 //Dec(x, minx);
1865 //Dec(y, miny);
1871 // ////////////////////////////////////////////////////////////////////////// //
1872 (*
1873 function TBodyGridBase.traceRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload;
1874 var
1875 ex, ey: Integer;
1876 begin
1877 result := traceRayWhileIn(ex, ey, x0, y0, x1, y1, tagmask);
1878 end;
1881 // FUCKIN' PASTA!
1882 function TBodyGridBase.traceRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP;
1883 const
1884 tsize = mTileSize;
1885 var
1886 wx0, wy0, wx1, wy1: Integer; // window coordinates
1887 stx, sty: Integer; // "steps" for x and y axes
1888 dsx, dsy: Integer; // "lengthes" for x and y axes
1889 dx2, dy2: Integer; // "double lengthes" for x and y axes
1890 xd, yd: Integer; // current coord
1891 e: Integer; // "error" (as in bresenham algo)
1892 rem: Integer;
1893 term: Integer;
1894 xptr, yptr: PInteger;
1895 xfixed: Boolean;
1896 temp: Integer;
1897 prevx, prevy: Integer;
1898 lastDistSq: Integer;
1899 ccidx, curci: Integer;
1900 hasUntried: Boolean;
1901 lastGA: Integer = -1;
1902 ga, x, y: Integer;
1903 lastObj: ITP;
1904 wasHit: Boolean = false;
1905 gw, gh, minx, miny, maxx, maxy: Integer;
1906 cc: PGridCell;
1907 px: PBodyProxyRec;
1908 lq: LongWord;
1909 f, ptag, distSq: Integer;
1910 x0, y0, x1, y1: Integer;
1911 inx, iny: Integer;
1912 begin
1913 result := Default(ITP);
1914 lastObj := Default(ITP);
1915 tagmask := tagmask and TagFullMask;
1916 ex := ax1; // why not?
1917 ey := ay1; // why not?
1918 if (tagmask = 0) then exit;
1920 if (ax0 = ax1) and (ay0 = ay1) then exit; // doesn't matter
1922 // we should start inside
1923 if (forEachAtPoint(ax0, ay0, nil, tagmask, @ptag) = nil) then
1924 begin
1925 ex := ax0; // why not?
1926 ey := ay0; // why not?
1927 exit;
1928 end;
1930 lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1;
1932 gw := mWidth;
1933 gh := mHeight;
1934 minx := mMinX;
1935 miny := mMinY;
1936 maxx := gw*tsize-1;
1937 maxy := gh*tsize-1;
1939 x0 := ax0;
1940 y0 := ay0;
1941 x1 := ax1;
1942 y1 := ay1;
1944 // offset query coords to (0,0)-based
1945 Dec(x0, minx);
1946 Dec(y0, miny);
1947 Dec(x1, minx);
1948 Dec(y1, miny);
1950 // clip rectange
1951 wx0 := 0;
1952 wy0 := 0;
1953 wx1 := maxx;
1954 wy1 := maxy;
1956 // horizontal setup
1957 if (x0 < x1) then
1958 begin
1959 // from left to right
1960 if (x0 > wx1) or (x1 < wx0) then exit; // out of screen
1961 stx := 1; // going right
1962 end
1963 else
1964 begin
1965 // from right to left
1966 if (x1 > wx1) or (x0 < wx0) then exit; // out of screen
1967 stx := -1; // going left
1968 x0 := -x0;
1969 x1 := -x1;
1970 wx0 := -wx0;
1971 wx1 := -wx1;
1972 swapInt(wx0, wx1);
1973 end;
1975 // vertical setup
1976 if (y0 < y1) then
1977 begin
1978 // from top to bottom
1979 if (y0 > wy1) or (y1 < wy0) then exit; // out of screen
1980 sty := 1; // going down
1981 end
1982 else
1983 begin
1984 // from bottom to top
1985 if (y1 > wy1) or (y0 < wy0) then exit; // out of screen
1986 sty := -1; // going up
1987 y0 := -y0;
1988 y1 := -y1;
1989 wy0 := -wy0;
1990 wy1 := -wy1;
1991 swapInt(wy0, wy1);
1992 end;
1994 dsx := x1-x0;
1995 dsy := y1-y0;
1997 if (dsx < dsy) then
1998 begin
1999 xptr := @yd;
2000 yptr := @xd;
2001 swapInt(x0, y0);
2002 swapInt(x1, y1);
2003 swapInt(dsx, dsy);
2004 swapInt(wx0, wy0);
2005 swapInt(wx1, wy1);
2006 swapInt(stx, sty);
2007 end
2008 else
2009 begin
2010 xptr := @xd;
2011 yptr := @yd;
2012 end;
2014 dx2 := 2*dsx;
2015 dy2 := 2*dsy;
2016 xd := x0;
2017 yd := y0;
2018 e := 2*dsy-dsx;
2019 term := x1;
2021 xfixed := false;
2022 if (y0 < wy0) then
2023 begin
2024 // clip at top
2025 temp := dx2*(wy0-y0)-dsx;
2026 xd += temp div dy2;
2027 rem := temp mod dy2;
2028 if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do
2029 if (xd+1 >= wx0) then
2030 begin
2031 yd := wy0;
2032 e -= rem+dsx;
2033 if (rem > 0) then begin Inc(xd); e += dy2; end;
2034 xfixed := true;
2035 end;
2036 end;
2038 if (not xfixed) and (x0 < wx0) then
2039 begin
2040 // clip at left
2041 temp := dy2*(wx0-x0);
2042 yd += temp div dx2;
2043 rem := temp mod dx2;
2044 if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit;
2045 xd := wx0;
2046 e += rem;
2047 if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
2048 end;
2050 if (y1 > wy1) then
2051 begin
2052 // clip at bottom
2053 temp := dx2*(wy1-y0)+dsx;
2054 term := x0+temp div dy2;
2055 rem := temp mod dy2;
2056 if (rem = 0) then Dec(term);
2057 end;
2059 if (term > wx1) then term := wx1; // clip at right
2061 Inc(term); // draw last point
2062 //if (term = xd) then exit; // this is the only point, get out of here
2064 if (sty = -1) then yd := -yd;
2065 if (stx = -1) then begin xd := -xd; term := -term; end;
2066 dx2 -= dy2;
2068 // first move, to skip starting point
2069 // DON'T DO THIS! loop will take care of that
2070 if (xd = term) then
2071 begin
2072 result := forEachAtPoint(ax0, ay0, nil, tagmask, @ptag);
2073 if (result <> nil) and ((ptag and tagmask) <> 0) then result := nil;
2074 exit;
2075 end;
2077 prevx := xptr^+minx;
2078 prevy := yptr^+miny;
2080 // increase query counter
2081 Inc(mLastQuery);
2082 if (mLastQuery = 0) then
2083 begin
2084 // just in case of overflow
2085 mLastQuery := 1;
2086 for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0;
2087 end;
2088 lq := mLastQuery;
2090 ccidx := -1;
2091 // draw it; can omit checks
2092 while (xd <> term) do
2093 begin
2094 // check cell(s)
2095 // new tile?
2096 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2097 if (ga <> lastGA) then
2098 begin
2099 // yes
2100 lastGA := ga;
2101 ccidx := mGrid[lastGA];
2102 // no objects in cell == exit
2103 if (ccidx = -1) then exit;
2104 end;
2105 // has something to process in this tile?
2106 if (ccidx <> -1) then
2107 begin
2108 // process cell
2109 curci := ccidx;
2110 // convert coords to map (to avoid ajdusting coords inside the loop)
2111 x := xptr^+minx;
2112 y := yptr^+miny;
2113 wasHit := false;
2114 // process cell list
2115 while (curci <> -1) do
2116 begin
2117 cc := @mCells[curci];
2118 for f := 0 to GridCellBucketSize-1 do
2119 begin
2120 if (cc.bodies[f] = -1) then break;
2121 px := @mProxies[cc.bodies[f]];
2122 ptag := px.mTag;
2123 if ((ptag and TagDisabled) = 0) and (px.mQueryMark <> lq) then
2124 begin
2125 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
2126 // can we process this proxy?
2127 if (x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight) then
2128 begin
2129 px.mQueryMark := lq; // mark as processed
2130 if ((ptag and tagmask) = 0) then
2131 begin
2132 result := px.mObj;
2133 ex := x;
2134 ey := y;
2135 exit;
2136 end;
2137 // march out of the panel/cell
2138 while (xd <> term) do
2139 begin
2140 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2141 xd += stx;
2142 // new cell?
2143 ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
2144 if (ga <> lastGA) then break;
2145 // out of panel?
2146 if not ((x >= px.mX) and (y >= px.mY) and (x < px.mX+px.mWidth) and (y < px.mY+px.mHeight)) then break;
2147 end;
2148 end;
2149 end;
2150 end;
2151 // next cell
2152 curci := cc.next;
2153 end;
2154 // still has something interesting in this cell?
2155 if not hasUntried then
2156 begin
2157 // nope, don't process this cell anymore; signal cell completion
2158 ccidx := -1;
2159 if assigned(cb) then
2160 begin
2161 if cb(nil, 0, x, y, prevx, prevy) then begin result := lastObj; exit; end;
2162 end
2163 else if wasHit then
2164 begin
2165 result := lastObj;
2166 exit;
2167 end;
2168 end;
2169 end;
2170 //putPixel(xptr^, yptr^);
2171 // move coords
2172 prevx := xptr^+minx;
2173 prevy := yptr^+miny;
2174 if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2;
2175 xd += stx;
2176 end;
2177 // we can travel less than one cell
2178 if wasHit and not assigned(cb) then
2179 begin
2180 result := lastObj;
2181 end
2182 else
2183 begin
2184 ex := ax1; // why not?
2185 ey := ay1; // why not?
2186 end;
2187 end;
2188 *)