27b553a30b26e98a9ad63dbfeb63aa2c890dee54
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}
20 interface
23 type
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
37 private
38 const
42 private
43 type
46 private
53 private
63 TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop
65 private
66 //mTileSize: Integer;
69 public
72 private
85 public
88 private
109 public
110 constructor Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
113 function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
122 // `false` if `body` is surely invalid
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 forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
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 // no callback: return `true` on the first hit
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 // cb with `(nil)` will be called before processing new tile
138 // no callback: return `true` on the nearest hit
139 function traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload;
140 function traceRay (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
142 //WARNING: don't modify grid while any query is in progress (no checks are made!)
143 // you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
144 // trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
145 function forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
147 // debug
152 //WARNING! no sanity checks!
162 // you are not supposed to understand this
163 // returns `true` if there is an intersection, and enter coords
164 // enter coords will be equal to (x0, y0) if starting point is inside the box
165 // if result is `false`, `inx` and `iny` are undefined
166 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
175 implementation
177 uses
181 // ////////////////////////////////////////////////////////////////////////// //
182 procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
183 function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
184 function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
186 function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
189 // ////////////////////////////////////////////////////////////////////////// //
190 // you are not supposed to understand this
191 // returns `true` if there is an intersection, and enter coords
192 // enter coords will be equal to (x0, y0) if starting point is inside the box
193 // if result is `false`, `inx` and `iny` are undefined
194 function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
195 var
203 //!term: Integer;
207 begin
209 // why not
215 begin
216 // check this point
218 exit;
221 // check if staring point is inside the box
222 if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end;
224 // clip rectange
230 // horizontal setup
232 begin
233 // from left to right
236 end
237 else
238 begin
239 // from right to left
249 // vertical setup
251 begin
252 // from top to bottom
255 end
256 else
257 begin
258 // from bottom to top
272 begin
281 end
282 else
283 begin
293 //!term := x1;
297 begin
298 // clip at top
304 begin
313 begin
314 // clip at left
324 (*
325 if (y1 > wy1) then
326 begin
327 // clip at bottom
328 temp := dx2*(wy1-y0)+dsx;
329 term := x0+temp div dy2;
330 rem := temp mod dy2;
331 if (rem = 0) then Dec(term);
332 end;
334 if (term > wx1) then term := wx1; // clip at right
336 Inc(term); // draw last point
337 //if (term = xd) then exit; // this is the only point, get out of here
338 *)
342 //!dx2 -= dy2;
350 // ////////////////////////////////////////////////////////////////////////// //
351 procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer);
352 begin
364 // ////////////////////////////////////////////////////////////////////////// //
365 constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize});
366 var
368 begin
370 {
371 if aTileSize < 1 then aTileSize := 1;
372 if aTileSize > 8192 then aTileSize := 8192; // arbitrary limit
373 mTileSize := aTileSize;
374 }
385 // init free list
387 begin
392 // init grid
394 // init proxies
402 e_WriteLog(Format('created grid with size: %dx%d (tile size: %d); pix: %dx%d', [mWidth, mHeight, mTileSize, mWidth*mTileSize, mHeight*mTileSize]), MSG_NOTIFY);
407 begin
415 // ////////////////////////////////////////////////////////////////////////// //
417 var
419 begin
422 begin
426 begin
432 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);
437 var
440 //px: PBodyProxyRec;
441 begin
444 begin
447 begin
450 begin
452 if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY);
453 //px := @mProxies[cc.bodies[f]];
455 // next cell
463 var
466 begin
474 begin
477 begin
479 if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end;
481 // next cell
487 // ////////////////////////////////////////////////////////////////////////// //
488 function TBodyGridBase.getGridWidthPx (): Integer; inline; begin result := mWidth*mTileSize; end;
489 function TBodyGridBase.getGridHeightPx (): Integer; inline; begin result := mHeight*mTileSize; end;
493 begin
494 // fix coords
502 begin
504 begin
507 end
508 else
509 begin
517 // ////////////////////////////////////////////////////////////////////////// //
519 begin
525 begin
527 begin
529 begin
531 end
532 else
533 begin
540 // ////////////////////////////////////////////////////////////////////////// //
542 var
544 begin
546 begin
547 // no free cells, want more
551 begin
562 //e_WriteLog(Format('grid: allocated new cell #%d (total: %d)', [result, mUsedCells]), MSG_NOTIFY);
567 begin
569 begin
570 //if mCells[idx].body = -1 then exit; // the thing that should not be
579 // ////////////////////////////////////////////////////////////////////////// //
580 function TBodyGridBase.allocProxy (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer): TBodyProxyId;
581 var
584 begin
586 begin
587 // no free proxies, resize list
594 // get one from list
599 // add to used list
601 // statistics
607 begin
609 if (mProxyCount = 0) then raise Exception.Create('wutafuuuuu in grid (no allocated proxies, what i should free now?)');
610 // add to free list
618 // ////////////////////////////////////////////////////////////////////////// //
619 function TBodyGridBase.forGridRect (x, y, w, h: Integer; cb: TGridInternalCB; bodyId: TBodyProxyId): Boolean;
620 const
622 var
625 begin
628 // fix coords
631 // go on
635 //tsize := mTileSize;
638 begin
642 begin
652 // ////////////////////////////////////////////////////////////////////////// //
654 var
659 begin
661 // add body to the given grid cell
664 begin
668 begin
670 begin
671 // can add here
674 exit;
678 // either no room, or no cell at all
687 var
689 begin
696 // absolutely not tested
698 var
702 begin
704 // find and remove cell
708 begin
713 begin
715 begin
716 // i found her!
718 begin
719 // this cell contains no elements, remove it
723 end
724 else
725 begin
726 // remove element from bucket
729 begin
745 // absolutely not tested
747 var
749 begin
756 // ////////////////////////////////////////////////////////////////////////// //
757 function TBodyGridBase.insertBody (aObj: ITP; aX, aY, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
758 begin
766 begin
773 // ////////////////////////////////////////////////////////////////////////// //
775 var
778 begin
786 // did any corner crossed tile boundary?
791 begin
798 end
799 else
800 begin
809 var
812 begin
814 // check if tile coords was changed
820 begin
821 // crossed tile boundary, do heavy work
826 end
827 else
828 begin
829 // nothing to do with the grid, just fix coordinates
836 var
839 begin
841 // check if tile coords was changed
849 begin
850 // crossed tile boundary, do heavy work
855 end
856 else
857 begin
858 // nothing to do with the grid, just fix size
865 // ////////////////////////////////////////////////////////////////////////// //
866 // no callback: return `true` on the first hit
867 function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP;
868 var
875 begin
880 // make coords (0,0)-based
886 // restore coords
890 // increase query counter
893 begin
894 // just in case of overflow
901 begin
904 begin
909 begin
911 begin
914 begin
916 end
917 else
918 begin
920 exit;
930 // ////////////////////////////////////////////////////////////////////////// //
931 // no callback: return `true` on the first hit
932 function TBodyGridBase.forEachInAABB (x, y, w, h: Integer; cb: TGridQueryCB; tagmask: Integer=-1; allowDisabled: Boolean=false): ITP;
933 const
935 var
946 begin
955 // fix coords
960 //tsize := mTileSize;
965 // increase query counter
968 begin
969 // just in case of overflow
973 //e_WriteLog(Format('grid: query #%d: (%d,%d)-(%dx%d)', [mLastQuery, minx, miny, maxx, maxy]), MSG_NOTIFY);
976 // go on
978 begin
982 begin
985 // process cells
988 begin
991 begin
997 //if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
998 //if ( ((ptag and TagDisabled) = 0) = ignoreDisabled) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then
999 begin
1004 begin
1006 end
1007 else
1008 begin
1010 exit;
1021 // ////////////////////////////////////////////////////////////////////////// //
1022 // no callback: return `true` on the nearest hit
1023 function TBodyGridBase.traceRay (x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1024 var
1026 begin
1031 // no callback: return `true` on the nearest hit
1032 // you are not supposed to understand this
1033 function TBodyGridBase.traceRay (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP;
1034 const
1036 var
1062 begin
1070 if (ax0 = ax1) and (ay0 = ay1) then exit; // as the first point is ignored, just get outta here
1086 // offset query coords to (0,0)-based
1092 // clip rectange
1098 // horizontal setup
1100 begin
1101 // from left to right
1104 end
1105 else
1106 begin
1107 // from right to left
1117 // vertical setup
1119 begin
1120 // from top to bottom
1123 end
1124 else
1125 begin
1126 // from bottom to top
1140 begin
1149 end
1150 else
1151 begin
1165 begin
1166 // clip at top
1172 begin
1181 begin
1182 // clip at left
1193 begin
1194 // clip at bottom
1204 //if (term = xd) then exit; // this is the only point, get out of here
1210 // first move, to skip starting point
1214 // move coords
1217 // done?
1220 {$IF DEFINED(D2F_DEBUG)}
1221 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
1222 {$ENDIF}
1224 //if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
1226 // restore query coords
1229 //Inc(ax1, minx);
1230 //Inc(ay1, miny);
1232 // increase query counter
1235 begin
1236 // just in case of overflow
1243 // draw it; can omit checks
1245 begin
1246 // check cell(s)
1247 {$IF DEFINED(D2F_DEBUG)}
1248 if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
1249 {$ENDIF}
1250 // new tile?
1253 begin
1254 // yes
1256 begin
1257 // signal cell completion
1259 begin
1261 end
1263 begin
1265 exit;
1271 // has something to process in this tile?
1273 begin
1274 // process cell
1276 hasUntried := false; // this will be set to `true` if we have some proxies we still want to process at the next step
1277 // convert coords to map (to avoid ajdusting coords inside the loop)
1280 // process cell list
1282 begin
1285 begin
1290 begin
1291 // can we process this proxy?
1293 begin
1296 begin
1298 begin
1302 exit;
1304 end
1305 else
1306 begin
1307 // remember this hitpoint if it is nearer than an old one
1310 begin
1318 end
1319 else
1320 begin
1321 // this is possibly interesting proxy, set "has more to check" flag
1326 // next cell
1329 // still has something interesting in this cell?
1331 begin
1332 // nope, don't process this cell anymore; signal cell completion
1335 begin
1337 end
1339 begin
1341 exit;
1345 //putPixel(xptr^, yptr^);
1346 // move coords
1355 // ////////////////////////////////////////////////////////////////////////// //
1356 //FIXME! optimize this with real tile walking
1357 function TBodyGridBase.forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
1358 const
1360 var
1379 //tedist: Integer;
1380 begin
1402 // `x` and `y` will be in grid coords
1406 // increase query counter
1409 begin
1410 // just in case of overflow
1416 // cache various things
1417 //tsize := mTileSize;
1423 // setup distance and flags
1426 // setup starting tile ('cause we'll adjust tile vars only on tile edge crossing)
1429 // it is slightly faster this way
1433 if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
1435 // now trace
1438 begin
1440 // do one step
1443 // invariant: one of those always changed
1444 {$IF DEFINED(D2F_DEBUG)}
1445 if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
1446 {$ENDIF}
1449 // invariant: we always doing a step
1450 {$IF DEFINED(D2F_DEBUG)}
1452 {$ENDIF}
1453 begin
1454 // check for crossing tile/grid boundary
1456 begin
1457 // we're still in grid
1459 // check for tile edge crossing
1465 // crossed tile edge?
1467 begin
1468 // setup new cell index
1470 if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
1471 end
1472 else
1474 begin
1475 // we have nothing interesting here anymore, jump directly to tile edge
1476 (*
1477 if (incx = 0) then
1478 begin
1479 // vertical line
1480 if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
1481 if (tedist > 1) then
1482 begin
1483 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);
1484 y += incy*tedist;
1485 Inc(i, tedist);
1486 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);
1487 end;
1488 end
1489 else if (incy = 0) then
1490 begin
1491 // horizontal line
1492 if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
1493 if (tedist > 1) then
1494 begin
1495 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);
1496 x += incx*tedist;
1497 Inc(i, tedist);
1498 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);
1499 end;
1500 end;
1501 *)
1502 (*
1503 else if (
1504 // get minimal distance to tile edges
1505 if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
1506 {$IF DEFINED(D2F_DEBUG)}
1507 if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
1508 {$ENDIF}
1509 if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
1510 {$IF DEFINED(D2F_DEBUG)}
1511 if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
1512 {$ENDIF}
1513 if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
1514 // do jump
1515 if (tedist > 1) then
1516 begin
1517 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);
1518 xerr += dx*tedist;
1519 yerr += dy*tedist;
1520 if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
1521 if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
1522 Inc(i, tedist);
1523 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);
1524 end;
1525 *)
1527 end
1528 else
1529 begin
1530 // out of grid
1535 // has something to process in the current cell?
1537 begin
1538 // process cell
1540 // convert coords to map (to avoid ajdusting coords inside the loop)
1541 //Inc(x, minx);
1542 //Inc(y, miny);
1543 // process cell list
1545 begin
1548 begin
1553 begin
1558 // next cell
1562 // convert coords to grid
1563 //Dec(x, minx);
1564 //Dec(y, miny);