diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas
index 9424278d0dcbc14e55d6c7f8a582ebe8594f6c46..c6fe09534a639f958ca7c300f354120d08a9eee7 100644 (file)
--- a/src/game/g_grid.pas
+++ b/src/game/g_grid.pas
private
const
- GridDefaultTileSize = 32;
+ GridDefaultTileSize = 32; // must be power of two!
GridCellBucketSize = 8; // WARNING! can't be less than 2!
private
//mTileSize: Integer;
const mTileSize = GridDefaultTileSize;
+ public
+ const tileSize = mTileSize;
+
private
mMinX, mMinY: Integer; // so grids can start at any origin
mWidth, mHeight: Integer; // in tiles
function insertBody (aObj: ITP; ax, ay, aWidth, aHeight: Integer; aTag: Integer=-1): TBodyProxyId;
procedure removeBody (body: TBodyProxyId); // WARNING! this WILL destroy proxy!
- procedure moveBody (body: TBodyProxyId; dx, dy: Integer);
- procedure resizeBody (body: TBodyProxyId; sx, sy: Integer);
- procedure moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
+ procedure moveBody (body: TBodyProxyId; nx, ny: Integer);
+ procedure resizeBody (body: TBodyProxyId; nw, nh: Integer);
+ procedure moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
function insideGrid (x, y: Integer): Boolean; inline;
//WARNING: don't modify grid while any query is in progress (no checks are made!)
// you can set enabled/disabled flag, tho (but iterator can still return objects disabled inside it)
// trace line along the grid, calling `cb` for all objects in passed cells, in no particular order
- function forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1): ITP;
+ function forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
procedure dumpStats ();
// returns `true` if there is an intersection, and enter coords
// enter coords will be equal to (x0, y0) if starting point is inside the box
// if result is `false`, `inx` and `iny` are undefined
-function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer; log: Boolean=false): Boolean;
+function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
+function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
procedure swapInt (var a: Integer; var b: Integer); inline;
-function distanceSq (x0, y0, x1, y1: Integer): Integer; inline;
+function minInt (a, b: Integer): Integer; inline;
+function maxInt (a, b: Integer): Integer; inline;
implementation
// ////////////////////////////////////////////////////////////////////////// //
procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end;
+function minInt (a, b: Integer): Integer; inline; begin if (a < b) then result := a else result := b; end;
+function maxInt (a, b: Integer): Integer; inline; begin if (a > b) then result := a else result := b; end;
function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end;
// returns `true` if there is an intersection, and enter coords
// enter coords will be equal to (x0, y0) if starting point is inside the box
// if result is `false`, `inx` and `iny` are undefined
-function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer; log: Boolean=false): Boolean;
+function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean;
var
wx0, wy0, wx1, wy1: Integer; // window coordinates
stx, sty: Integer; // "steps" for x and y axes
xd, yd: Integer; // current coord
e: Integer; // "error" (as in bresenham algo)
rem: Integer;
- term: Integer;
+ //!term: Integer;
d0, d1: PInteger;
xfixed: Boolean;
temp: Integer;
wx1 := bx+bw-1;
wy1 := by+bh-1;
- if log then e_WriteLog('lineAABBIntersects: 0', MSG_NOTIFY);
// horizontal setup
if (x0 < x1) then
begin
swapInt(wx0, wx1);
end;
- if log then e_WriteLog('lineAABBIntersects: 1', MSG_NOTIFY);
// vertical setup
if (y0 < y1) then
begin
xd := x0;
yd := y0;
e := 2*dsy-dsx;
- term := x1;
+ //!term := x1;
- if log then e_WriteLog('lineAABBIntersects: 2', MSG_NOTIFY);
xfixed := false;
if (y0 < wy0) then
begin
end;
end;
- if log then e_WriteLog('lineAABBIntersects: 3', MSG_NOTIFY);
if (not xfixed) and (x0 < wx0) then
begin
// clip at left
if (rem >= dsx) then begin Inc(yd); e -= dx2; end;
end;
- if log then e_WriteLog('lineAABBIntersects: 4', MSG_NOTIFY);
+ (*
if (y1 > wy1) then
begin
// clip at bottom
Inc(term); // draw last point
//if (term = xd) then exit; // this is the only point, get out of here
+ *)
if (sty = -1) then yd := -yd;
- if (stx = -1) then begin xd := -xd; term := -term; end;
- dx2 -= dy2;
+ if (stx = -1) then begin xd := -xd; {!term := -term;} end;
+ //!dx2 -= dy2;
- if log then e_WriteLog('lineAABBIntersects: 5', MSG_NOTIFY);
inx := d0^;
iny := d1^;
result := true;
// ////////////////////////////////////////////////////////////////////////// //
-procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; dx, dy, sx, sy: Integer);
+procedure TBodyGridBase.moveResizeBody (body: TBodyProxyId; nx, ny, nw, nh: Integer);
var
px: PBodyProxyRec;
x0, y0, w, h: Integer;
begin
if (body < 0) or (body > High(mProxies)) then exit; // just in case
- if (dx = 0) and (dy = 0) and (sx = 0) and (sy = 0) then exit;
px := @mProxies[body];
x0 := px.mX;
y0 := px.mY;
w := px.mWidth;
h := px.mHeight;
+ if (nx = x0) and (ny = y0) and (nw = w) and (nh = h) then exit;
// did any corner crossed tile boundary?
- if (x0 div mTileSize <> (x0+dx) div mTileSize) or
- (y0 div mTileSize <> (y0+dx) div mTileSize) or
- ((x0+w) div mTileSize <> (x0+w+sx) div mTileSize) or
- ((y0+h) div mTileSize <> (y0+h+sy) div mTileSize) then
+ if (x0 div mTileSize <> nx div mTileSize) or
+ (y0 div mTileSize <> ny div mTileSize) or
+ ((x0+w) div mTileSize <> (nx+nw) div mTileSize) or
+ ((y0+h) div mTileSize <> (ny+nh) div mTileSize) then
begin
removeInternal(body);
- Inc(px.mX, dx);
- Inc(px.mY, dy);
- Inc(px.mWidth, sx);
- Inc(px.mHeight, sy);
+ px.mX := nx;
+ px.mY := ny;
+ px.mWidth := nw;
+ px.mHeight := nh;
insertInternal(body);
end
else
begin
- Inc(px.mX, dx);
- Inc(px.mY, dy);
- Inc(px.mWidth, sx);
- Inc(px.mHeight, sy);
+ px.mX := nx;
+ px.mY := ny;
+ px.mWidth := nw;
+ px.mHeight := nh;
end;
end;
-procedure TBodyGridBase.moveBody (body: TBodyProxyId; dx, dy: Integer);
+procedure TBodyGridBase.moveBody (body: TBodyProxyId; nx, ny: Integer);
var
px: PBodyProxyRec;
- nx, ny: Integer;
+ x0, y0: Integer;
begin
if (body < 0) or (body > High(mProxies)) then exit; // just in case
- if (dx = 0) and (dy = 0) then exit;
// check if tile coords was changed
px := @mProxies[body];
- nx := px.mX+dx;
- ny := px.mY+dy;
- if (nx div mTileSize <> px.mX div mTileSize) or (ny div mTileSize <> px.mY div mTileSize) then
+ x0 := px.mX;
+ y0 := px.mY;
+ if (nx = x0) and (ny = y0) then exit;
+ if (nx div mTileSize <> x0 div mTileSize) or (ny div mTileSize <> y0 div mTileSize) then
begin
// crossed tile boundary, do heavy work
- moveResizeBody(body, dx, dy, 0, 0);
+ removeInternal(body);
+ px.mX := nx;
+ px.mY := ny;
+ insertInternal(body);
end
else
begin
end;
end;
-procedure TBodyGridBase.resizeBody (body: TBodyProxyId; sx, sy: Integer);
+procedure TBodyGridBase.resizeBody (body: TBodyProxyId; nw, nh: Integer);
var
px: PBodyProxyRec;
- x0, y0: Integer;
- nw, nh: Integer;
+ x0, y0, w, h: Integer;
begin
if (body < 0) or (body > High(mProxies)) then exit; // just in case
- if (sx = 0) and (sy = 0) then exit;
// check if tile coords was changed
px := @mProxies[body];
x0 := px.mX;
y0 := px.mY;
- nw := px.mWidth+sx;
- nh := px.mHeight+sy;
- if ((x0+px.mWidth) div mTileSize <> (x0+nw) div mTileSize) or
- ((y0+px.mHeight) div mTileSize <> (y0+nh) div mTileSize) then
+ w := px.mWidth;
+ h := px.mHeight;
+ if ((x0+w) div mTileSize <> (x0+nw) div mTileSize) or
+ ((y0+h) div mTileSize <> (y0+nh) div mTileSize) then
begin
// crossed tile boundary, do heavy work
- moveResizeBody(body, 0, 0, sx, sy);
+ removeInternal(body);
+ px.mWidth := nw;
+ px.mHeight := nh;
+ insertInternal(body);
end
else
begin
// done?
if (xd = term) then exit;
+ {$IF DEFINED(D2F_DEBUG)}
if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
+ {$ENDIF}
//if (dbgShowTraceLog) then e_WriteLog(Format('raycast start: (%d,%d)-(%d,%d); xptr^=%d; yptr^=%d', [ax0, ay0, ax1, ay1, xptr^, yptr^]), MSG_NOTIFY);
while (xd <> term) do
begin
// check cell(s)
+ {$IF DEFINED(D2F_DEBUG)}
if (xptr^ < 0) or (yptr^ < 0) or (xptr^ >= gw*tsize) and (yptr^ > mHeight*tsize) then raise Exception.Create('raycaster internal error (0)');
+ {$ENDIF}
// new tile?
ga := (yptr^ div tsize)*gw+(xptr^ div tsize);
if (ga <> lastGA) then
// ////////////////////////////////////////////////////////////////////////// //
//FIXME! optimize this with real tile walking
-function TBodyGridBase.forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1): ITP;
+function TBodyGridBase.forEachAlongLine (x0, y0, x1, y1: Integer; cb: TGridAlongQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP;
const
tsize = mTileSize;
var
lastWasInGrid: Boolean;
tbcross: Boolean;
f: Integer;
+ //tedist: Integer;
begin
+ log := false;
result := Default(ITP);
tagmask := tagmask and TagFullMask;
- if (tagmask = 0) then exit;
+ if (tagmask = 0) or not assigned(cb) then exit;
minx := mMinX;
miny := mMinY;
if (dx > 0) then incx := 1 else if (dx < 0) then incx := -1 else incx := 0;
if (dy > 0) then incy := 1 else if (dy < 0) then incy := -1 else incy := 0;
+ if (incx = 0) and (incy = 0) then exit; // just incase
+
dx := abs(dx);
dy := abs(dy);
xerr := -d;
yerr := -d;
+ if (log) then e_WriteLog(Format('tracing: (%d,%d)-(%d,%d)', [x, y, x1-minx, y1-miny]), MSG_NOTIFY);
+
// now trace
- for i := 1 to d do
+ i := 0;
+ while (i < d) do
begin
+ Inc(i);
// do one step
xerr += dx;
yerr += dy;
// invariant: one of those always changed
+ {$IF DEFINED(D2F_DEBUG)}
if (xerr < 0) and (yerr < 0) then raise Exception.Create('internal bug in grid raycaster (0)');
+ {$ENDIF}
if (xerr >= 0) then begin xerr -= d; x += incx; stepx := incx; end else stepx := 0;
if (yerr >= 0) then begin yerr -= d; y += incy; stepy := incy; end else stepy := 0;
// invariant: we always doing a step
+ {$IF DEFINED(D2F_DEBUG)}
if ((stepx or stepy) = 0) then raise Exception.Create('internal bug in grid raycaster (1)');
+ {$ENDIF}
begin
// check for crossing tile/grid boundary
if (x >= 0) and (y >= 0) and (x <= maxx) and (y <= maxy) then
begin
// setup new cell index
ccidx := mGrid[(y div tsize)*gw+(x div tsize)];
+ if (log) then e_WriteLog(Format(' stepped to new tile (%d,%d) -- (%d,%d)', [(x div tsize), (y div tsize), x, y]), MSG_NOTIFY);
+ end
+ else
+ if (ccidx = -1) then
+ begin
+ // we have nothing interesting here anymore, jump directly to tile edge
+ (*
+ if (incx = 0) then
+ begin
+ // vertical line
+ if (incy < 0) then tedist := y-(y and (not tsize)) else tedist := (y or (tsize-1))-y;
+ if (tedist > 1) then
+ begin
+ 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);
+ y += incy*tedist;
+ Inc(i, tedist);
+ 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);
+ end;
+ end
+ else if (incy = 0) then
+ begin
+ // horizontal line
+ if (incx < 0) then tedist := x-(x and (not tsize)) else tedist := (x or (tsize-1))-x;
+ if (tedist > 1) then
+ begin
+ 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);
+ x += incx*tedist;
+ Inc(i, tedist);
+ 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);
+ end;
+ end;
+ *)
+ (*
+ else if (
+ // get minimal distance to tile edges
+ if (incx < 0) then tedist := x-(x and (not tsize)) else if (incx > 0) then tedist := (x or (tsize+1))-x else tedist := 0;
+ {$IF DEFINED(D2F_DEBUG)}
+ if (tedist < 0) then raise Exception.Create('internal bug in grid raycaster (2.x)');
+ {$ENDIF}
+ if (incy < 0) then f := y-(y and (not tsize)) else if (incy > 0) then f := (y or (tsize+1))-y else f := 0;
+ {$IF DEFINED(D2F_DEBUG)}
+ if (f < 0) then raise Exception.Create('internal bug in grid raycaster (2.y)');
+ {$ENDIF}
+ if (tedist = 0) then tedist := f else if (f <> 0) then tedist := minInt(tedist, f);
+ // do jump
+ if (tedist > 1) then
+ begin
+ 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);
+ xerr += dx*tedist;
+ yerr += dy*tedist;
+ if (xerr >= 0) then begin x += incx*((xerr div d)+1); xerr := (xerr mod d)-d; end;
+ if (yerr >= 0) then begin y += incy*((yerr div d)+1); yerr := (yerr mod d)-d; end;
+ Inc(i, tedist);
+ 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);
+ end;
+ *)
end;
end
else
// process cell
curci := ccidx;
// convert coords to map (to avoid ajdusting coords inside the loop)
- Inc(x, minx);
- Inc(y, miny);
+ //Inc(x, minx);
+ //Inc(y, miny);
// process cell list
while (curci <> -1) do
begin
end;
ccidx := -1; // don't process this anymore
// convert coords to grid
- Dec(x, minx);
- Dec(y, miny);
+ //Dec(x, minx);
+ //Dec(y, miny);
end;
end;
end;