X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;ds=sidebyside;f=src%2Fgame%2Fg_grid.pas;h=092f13ee201a53a54939da7ceced246ef4e39c24;hb=8cd6b5c965cd6cae75db5f554e61d0d150d08b46;hp=442a776ea831b8fc1a103001c51331cecf7e4a3b;hpb=12091923618f35554e5b21cd088d39f202a770d0;p=d2df-sdl.git diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index 442a776..092f13e 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -20,7 +20,7 @@ {.$DEFINE D2F_DEBUG_XXQ} {.$DEFINE D2F_DEBUG_MOVER} {$ENDIF} -{$DEFINE GRID_USE_ORTHO_ACCEL} +{.$DEFINE GRID_USE_ORTHO_ACCEL} unit g_grid; interface @@ -64,6 +64,9 @@ type function getEnabled (): Boolean; inline; procedure setEnabled (v: Boolean); inline; + function getX1 (): Integer; inline; + function getY1 (): Integer; inline; + public property x: Integer read mX; property y: Integer read mY; @@ -72,6 +75,11 @@ type property tag: Integer read getTag write setTag; property enabled: Boolean read getEnabled write setEnabled; property obj: ITP read mObj; + + property x0: Integer read mX; + property y0: Integer read mY; + property x1: Integer read getX1; + property y1: Integer read getY1; end; private @@ -178,7 +186,7 @@ type // no callback: return object on the first hit or nil function forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP; - function atPoint (x, y: Integer): TAtPointEnumerator; + function atCellInPoint (x, y: Integer): TAtPointEnumerator; //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) @@ -189,8 +197,11 @@ type function traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload; function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; - //function traceOrthoRayWhileIn (const x0, y0, x1, y1: Integer; tagmask: Integer=-1): ITP; overload; - //function traceOrthoRayWhileIn (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): ITP; + // return `false` if we're still inside at the end + // line should be either strict horizontal, or strict vertical, otherwise an exception will be thrown + // `true`: endpoint will point at the last "inside" pixel + // `false`: endpoint will be (ax1, ay1) + function traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean; //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) @@ -198,6 +209,10 @@ type //WARNING: don't change tags in callbacks here! function forEachAlongLine (ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1; log: Boolean=false): ITP; + // trace box with the given velocity; return object hit (if any) + // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object + function traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; + // debug procedure forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB); function forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP; @@ -222,6 +237,16 @@ type // 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): Boolean; +// sweep two AABB's to see if and when they are overlapping +// returns `true` if collision was detected (but boxes doesn't overlap) +// u1 and u1 has no sense if no collision was detected +// u0 = normalized time of first collision (i.e. collision starts at myMove*u0) +// u1 = normalized time of second collision (i.e. collision stops after myMove*u1) +// hitedge for `it`: 0: top; 1: right; 2: bottom; 3: left +// enter/exit coords will form non-intersecting configuration (i.e. will be before/after the actual collision) +function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; + u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean; + function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; procedure swapInt (var a: Integer; var b: Integer); inline; @@ -232,7 +257,7 @@ function maxInt (a, b: Integer): Integer; inline; implementation uses - SysUtils, e_log, g_console; + SysUtils, e_log, g_console, utils; // ////////////////////////////////////////////////////////////////////////// // @@ -404,6 +429,86 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, ity0, itw, ith: Integer; + u0: PSingle=nil; hitedge: PInteger=nil; u1: PSingle=nil): Boolean; +var + tin, tout: Single; + + function axisOverlap (me0, me1, it0, it1, d, he0, he1: Integer): Boolean; inline; + var + t: Single; + begin + result := false; + + if (me1 < it0) then + begin + if (d >= 0) then exit; // oops, no hit + t := (me1-it0+1)/d; + if (t > tin) then begin tin := t; hitedge^ := he1; end; + end + else if (it1 < me0) then + begin + if (d <= 0) then exit; // oops, no hit + t := (me0-it1-1)/d; + if (t > tin) then begin tin := t; hitedge^ := he0; end; + end; + + if (d < 0) and (it1 > me0) then + begin + t := (me0-it1-1)/d; + if (t < tout) then tout := t; + end + else if (d > 0) and (me1 > it0) then + begin + t := (me1-it0+1)/d; + if (t < tout) then tout := t; + end; + + result := true; + end; + +var + mex1, mey1, itx1, ity1, vx, vy: Integer; + htt: Integer = -1; +begin + result := false; + if (u0 <> nil) then u0^ := -1.0; + if (u1 <> nil) then u1^ := -1.0; + if (hitedge = nil) then hitedge := @htt else hitedge^ := -1; + + if (mew < 1) or (meh < 1) or (itw < 1) or (ith < 1) then exit; + + mex1 := mex0+mew-1; + mey1 := mey0+meh-1; + itx1 := itx0+itw-1; + ity1 := ity0+ith-1; + + // check if they are overlapping right now (SAT) + //if (mex1 >= itx0) and (mex0 <= itx1) and (mey1 >= ity0) and (mey0 <= ity1) then begin result := true; exit; end; + + if (medx = 0) and (medy = 0) then exit; // both boxes are sationary + + // treat b as stationary, so invert v to get relative velocity + vx := -medx; + vy := -medy; + + tin := -100000000.0; + tout := 100000000.0; + + if not axisOverlap(mex0, mex1, itx0, itx1, vx, 1, 3) then exit; + if not axisOverlap(mey0, mey1, ity0, ity1, vy, 2, 0) then exit; + + if (u0 <> nil) then u0^ := tin; + if (u1 <> nil) then u1^ := tout; + + if (tin <= tout) and (tin >= 0.0) and (tin <= 1.0) then + begin + result := true; + end; +end; + + // ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.TBodyProxyRec.setup (aX, aY, aWidth, aHeight: Integer; aObj: ITP; aTag: Integer); begin @@ -438,6 +543,16 @@ begin if v then mTag := mTag and (not TagDisabled) else mTag := mTag or TagDisabled; end; +function TBodyGridBase.TBodyProxyRec.getX1 (): Integer; inline; +begin + result := mX+mWidth-1; +end; + +function TBodyGridBase.TBodyProxyRec.getY1 (): Integer; inline; +begin + result := mY+mHeight-1; +end; + // ////////////////////////////////////////////////////////////////////////// // constructor TBodyGridBase.TAtPointEnumerator.Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn); @@ -666,13 +781,13 @@ end; // ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.getProxyEnabled (pid: TBodyProxyId): Boolean; inline; begin - if (pid >= 0) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false; + if (pid >= 0) and (pid < Length(mProxies)) then result := ((mProxies[pid].mTag and TagDisabled) = 0) else result := false; end; procedure TBodyGridBase.setProxyEnabled (pid: TBodyProxyId; val: Boolean); inline; begin - if (pid >= 0) then + if (pid >= 0) and (pid < Length(mProxies)) then begin if val then begin @@ -688,7 +803,7 @@ end; function TBodyGridBase.getProxyById (idx: TBodyProxyId): PBodyProxyRec; inline; begin - if (idx >= 0) and (idx < High(mProxies)) then result := @mProxies[idx] else result := nil; + if (idx >= 0) and (idx < Length(mProxies)) then result := @mProxies[idx] else result := nil; end; @@ -1162,7 +1277,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // -function TBodyGridBase.atPoint (x, y: Integer): TAtPointEnumerator; +function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator; var cidx: Integer = -1; begin @@ -1654,18 +1769,6 @@ begin // one of those will never change x := xptr^+minx; y := yptr^+miny; - //prevx := x; - //prevy := y; - {$IF DEFINED(D2F_DEBUG)} - if hopt then - begin - if (y <> ay0) then raise Exception.Create('htrace fatal internal error'); - end - else - begin - if (x <> ax0) then raise Exception.Create('vtrace fatal internal error'); - end; - {$ENDIF} while (wklen > 0) do begin {$IF DEFINED(D2F_DEBUG)} @@ -1688,13 +1791,13 @@ begin ptag := px.mTag; if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) and // constant coord should be inside - ((hopt and (y >= px.mY) and (y < px.mY+px.mHeight)) or - ((not hopt) and (x >= px.mX) and (x < px.mX+px.mWidth))) then + ((hopt and (y >= px.y0) and (y <= px.y1)) or + ((not hopt) and (x >= px.x0) and (x <= px.x1))) then begin px.mQueryMark := lq; // mark as processed // inside the proxy? - if (hopt and (x > px.mX) and (x < px.mX+px.mWidth-1)) or - ((not hopt) and (y > px.mY) and (y < px.mY+px.mHeight-1)) then + if (hopt and (x > px.x0) and (x < px.x1)) or + ((not hopt) and (y > px.y0) and (y < px.y1)) then begin // setup prev[xy] if assigned(cb) then @@ -1735,16 +1838,16 @@ begin if (stx < 0) then begin // going left - if (x < px.mX+px.mWidth-1) then continue; // not on the right edge - prevx := px.mX+px.mWidth; - x := prevx-1; + if (x < px.x1) then continue; // not on the right edge + x := px.x1; + prevx := x+1; end else begin // going right - if (x > px.mX) then continue; // not on the left edge - prevx := px.mX-1; - x := prevx+1; + if (x > px.x0) then continue; // not on the left edge + x := px.x0; + prevx := x-1; end; end else @@ -1755,16 +1858,16 @@ begin if (stx < 0) then begin // going up - if (y < px.mY+px.mHeight-1) then continue; // not on the bottom edge - prevy := px.mY+px.mHeight; - y := prevy-1; + if (y < px.y1) then continue; // not on the bottom edge + y := px.y1; + prevy := x+1; end else begin // going down - if (y > px.mY) then continue; // not on the top edge - prevy := px.mY-1; - y := prevy+1; + if (y > px.y0) then continue; // not on the top edge + y := px.y0; + prevy := y-1; end; end; if assigned(cb) then @@ -1838,7 +1941,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -1849,7 +1952,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -2039,7 +2142,7 @@ var temp: Integer; ccidx, curci: Integer; lastGA: Integer = -1; - ga, x, y: Integer; + ga: Integer; gw, gh, minx, miny, maxx, maxy: Integer; cc: PGridCell; px: PBodyProxyRec; @@ -2254,23 +2357,10 @@ begin if dbgShowTraceLog then e_LogWritefln('optimized htrace; wklen=%d', [wklen]); {$ENDIF} ga := (yptr^ div tsize)*gw+(xptr^ div tsize); - // one of those will never change - x := xptr^+minx; - y := yptr^+miny; - {$IF DEFINED(D2F_DEBUG)} - if hopt then - begin - if (y <> ay0) then raise Exception.Create('htrace fatal internal error'); - end - else - begin - if (x <> ax0) then raise Exception.Create('vtrace fatal internal error'); - end; - {$ENDIF} while (wklen > 0) do begin {$IF DEFINED(D2F_DEBUG)} - if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; y=%d; y=%d', [ga, xptr^+minx, yptr^+miny, y, ay0]); + if dbgShowTraceLog then e_LogWritefln(' htrace; ga=%d; x=%d, y=%d; ay0=%d', [ga, xptr^+minx, yptr^+miny, ay0]); {$ENDIF} // new tile? if (ga <> lastGA) then @@ -2278,7 +2368,6 @@ begin lastGA := ga; ccidx := mGrid[lastGA]; // convert coords to map (to avoid ajdusting coords inside the loop) - if hopt then x := xptr^+minx else y := yptr^+miny; while (ccidx <> -1) do begin cc := @mCells[ccidx]; @@ -2343,7 +2432,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -2354,7 +2443,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -2395,9 +2484,6 @@ begin begin // process cell curci := ccidx; - // convert coords to map (to avoid ajdusting coords inside the loop) - x := xptr^+minx; - y := yptr^+miny; // process cell list while (curci <> -1) do begin @@ -2452,4 +2538,252 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +// trace box with the given velocity; return object hit (if any) +// `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object +function TBodyGridBase.traceBox (out ex, ey: Integer; const ax0, ay0, aw, ah: Integer; const dx, dy: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; +var + gx, gy: Integer; + cidx: Integer; + cc: PGridCell; + px: PBodyProxyRec; + lq: LongWord; + f, ptag: Integer; + minu0: Single = 100000.0; + u0, u1: Single; + hedge: Integer; + cx0, cy0, cx1, cy1: Integer; +begin + result := Default(ITP); + ex := ax0+dx; + ey := ay0+dy; + if (aw < 1) or (ah < 1) then exit; + + if mInQuery then raise Exception.Create('recursive queries aren''t supported'); + mInQuery := true; + + cx0 := nmin(ax0, ax0+dx); + cy0 := nmin(ay0, ay0+dy); + cx1 := nmax(ax0+aw-1, ax0+aw-1+dx); + cy1 := nmax(ay0+ah-1, ay0+ah-1+dy); + + cx0 -= mMinX; cy0 -= mMinY; + cx1 -= mMinX; cy1 -= mMinY; + + if (cx1 < 0) or (cy1 < 0) or (cx0 >= mWidth*mTileSize) or (cy0 >= mHeight*mTileSize) then exit; + + if (cx0 < 0) then cx0 := 0; + if (cy0 < 0) then cy0 := 0; + if (cx1 >= mWidth*mTileSize) then cx1 := mWidth*mTileSize-1; + if (cy1 >= mHeight*mTileSize) then cy1 := mHeight*mTileSize-1; + // just in case + if (cx0 > cx1) or (cy0 > cy1) then exit; + + // increase query counter + Inc(mLastQuery); + if (mLastQuery = 0) then + begin + // just in case of overflow + mLastQuery := 1; + for f := 0 to High(mProxies) do mProxies[f].mQueryMark := 0; + end; + lq := mLastQuery; + + for gy := cy0 div mTileSize to cy1 div mTileSize do + begin + for gx := cx0 div mTileSize to cx1 div mTileSize do + begin + cidx := mGrid[gy*mWidth+gx]; + while (cidx <> -1) do + begin + cc := @mCells[cidx]; + for f := 0 to GridCellBucketSize-1 do + begin + if (cc.bodies[f] = -1) then break; + px := @mProxies[cc.bodies[f]]; + ptag := px.mTag; + if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and (px.mQueryMark <> lq) then + begin + px.mQueryMark := lq; // mark as processed + if assigned(cb) then + begin + if not cb(px.mObj, ptag) then continue; + end; + if not sweepAABB(ax0, ay0, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0, @hedge, @u1) then + begin + { + if (u1 >= 0) then + begin + // overlapping + ex := ax0; + ey := ay0; + result := px.mObj; + mInQuery := false; + exit; + end; + } + continue; + end; + if (minu0 > u0) then + begin + result := px.mObj; + minu0 := u0; + if (u0 = 0.0) then + begin + ex := ax0; + ey := ay0; + mInQuery := false; + exit; + end; + end; + end; + end; + // next cell + cidx := cc.next; + end; + end; + end; + + if (minu0 <= 1.0) then + begin + ex := ax0+trunc(dx*minu0); + ey := ay0+trunc(dy*minu0); + end; + + mInQuery := false; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +{.$DEFINE D2F_DEBUG_OTR} +function TBodyGridBase.traceOrthoRayWhileIn (out ex, ey: Integer; ax0, ay0, ax1, ay1: Integer; tagmask: Integer=-1): Boolean; +var + ccidx: Integer; + cc: PGridCell; + px: PBodyProxyRec; + ptag: Integer; + minx, miny: Integer; + f, c0, c1: Integer; + x0, y0, x1, y1: Integer; + celly0, celly1: Integer; + dy: Integer; + filled: array[0..mTileSize-1] of Byte; + {$IF DEFINED(D2F_DEBUG_OTR)} + s: AnsiString = ''; + {$ENDIF} +begin + result := false; + ex := ax1; + ey := ay1; + if not ((ax0 = ax1) or (ay0 = ay1)) then raise Exception.Create('orthoray is not orthogonal'); + + tagmask := tagmask and TagFullMask; + if (tagmask = 0) then exit; + + if (forEachAtPoint(ax0, ay0, nil, tagmask) = nil) then exit; + + minx := mMinX; + miny := mMinY; + + // offset query coords to (0,0)-based + x0 := ax0-minx; + y0 := ay0-miny; + x1 := ax1-minx; + y1 := ay1-miny; + + if (x0 = x1) then + begin + if (x0 < 0) or (x0 >= mWidth*mTileSize) then exit; // oops + // vertical + if (y0 < y1) then + begin + // down + if (y1 < 0) or (y0 >= mHeight*mTileSize) then exit; + //if (ay0 < 0) then ay0 := 0; + if (y0 < 0) then exit; + if (y1 >= mHeight*mTileSize) then y1 := mHeight*mTileSize-1; + dy := 1; + end + else + begin + // up + if (y0 < 0) or (y1 >= mHeight*mTileSize) then exit; + //if (ay1 < 0) then ay1 := 0; + if (y1 < 0) then exit; + if (y0 >= mHeight*mTileSize) then y0 := mHeight*mTileSize-1; + dy := -1; + end; + // check tile + while true do + begin + ccidx := mGrid[(y0 div mTileSize)*mWidth+(x0 div mTileSize)]; + FillChar(filled, sizeof(filled), 0); + celly0 := y0 and (not (mTileSize-1)); + celly1 := celly0+mTileSize-1; + while (ccidx <> -1) do + begin + cc := @mCells[ccidx]; + for f := 0 to GridCellBucketSize-1 do + begin + if (cc.bodies[f] = -1) then break; + px := @mProxies[cc.bodies[f]]; + ptag := px.mTag; + if ((ptag and TagDisabled) = 0) and ((ptag and tagmask) <> 0) and + (ax0 >= px.x0) and (ax0 <= px.x1) then + begin + // bound c0 and c1 to cell + c0 := nclamp(px.y0-miny, celly0, celly1); + c1 := nclamp(px.y1-miny, celly0, celly1); + // fill the thing + {$IF DEFINED(D2F_DEBUG_OTR)} + e_LogWritefln('**px.y0=%s; px.y1=%s; c0=%s; c1=%s; celly0=%s; celly1=%s; [%s..%s]', [px.y0-miny, px.y1-miny, c0, c1, celly0, celly1, c0-celly0, (c0-celly0)+(c1-c0)]); + {$ENDIF} + //assert(c0 <= c1); + FillChar(filled[c0-celly0], c1-c0+1, 1); + end; + end; + // next cell + ccidx := cc.next; + end; + {$IF DEFINED(D2F_DEBUG_OTR)} + s := formatstrf(' x=%s; ay0=%s; ay1=%s; y0=%s; celly0=%s; celly1=%s; dy=%s; [', [ax0, ay0, ay1, y0, celly0, celly1, dy]); + for f := 0 to High(filled) do if (filled[f] <> 0) then s += '1' else s += '0'; + s += ']'; + e_LogWriteln(s); + {$ENDIF} + // now go till we hit cell boundary or empty space + if (dy < 0) then + begin + // up + while (y0 >= celly0) and (filled[y0-celly0] <> 0) do + begin + {$IF DEFINED(D2F_DEBUG_OTR)} + e_LogWritefln(' filled: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]); + {$ENDIF} + Dec(y0); + Dec(ay0); + end; + {$IF DEFINED(D2F_DEBUG_OTR)} + e_LogWritefln(' span done: cdy=%s; y0=%s; celly0=%s; ay0=%s; ay1=%s', [y0-celly0, y0, celly0, ay0, ay1]); + {$ENDIF} + if (ay0 <= ay1) then begin ey := ay1; result := false; exit; end; + if (y0 >= celly0) then begin ey := ay0+1; {assert(forEachAtPoint(ex, ey, nil, tagmask) <> nil);} result := true; exit; end; + end + else + begin + // down + while (y0 <= celly1) and (filled[y0-celly0] <> 0) do begin Inc(y0); Inc(ay0); end; + if (ay0 >= ay1) then begin ey := ay1; result := false; exit; end; + if (y0 <= celly1) then begin ey := ay0-1; result := true; exit; end; + end; + end; + end + else + begin + // horizontal + assert(false); + end; +end; + + end.