X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_grid.pas;h=99533e9db18b18444f4634429499566071c761fd;hb=0944e70467355a7771d42015b6e548050e6fa3b7;hp=06790755698dfce7e15d73241fdabd65b4cbe689;hpb=1a10061a1cd706f5f06b923740e45a462d2bd885;p=d2df-sdl.git diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index 0679075..99533e9 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -20,11 +20,13 @@ {.$DEFINE D2F_DEBUG_XXQ} {.$DEFINE D2F_DEBUG_MOVER} {$ENDIF} -{$DEFINE GRID_USE_ORTHO_ACCEL} +{.$DEFINE GRID_USE_ORTHO_ACCEL} unit g_grid; interface +const + GridTileSize = 32; // must be power of two! type TBodyProxyId = Integer; @@ -33,7 +35,6 @@ type public type TGridQueryCB = function (obj: ITP; tag: Integer): Boolean is nested; // return `true` to stop type TGridRayQueryCB = function (obj: ITP; tag: Integer; x, y, prevx, prevy: Integer): Boolean is nested; // return `true` to stop - type TCellQueryCB = procedure (x, y: Integer) is nested; // top-left cell corner coords const TagDisabled = $40000000; @@ -41,7 +42,6 @@ type private const - GridDefaultTileSize = 32; // must be power of two! GridCellBucketSize = 8; // WARNING! can't be less than 2! public @@ -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 @@ -88,7 +96,7 @@ type private //mTileSize: Integer; - const mTileSize = GridDefaultTileSize; + const mTileSize = GridTileSize; type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object; public @@ -186,11 +194,25 @@ type // no callback: return object of the nearest hit or nil // if `inverted` is true, trace will register bodies *exluding* tagmask //WARNING: don't change tags in callbacks here! - 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 traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; overload; + function traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; + + //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) + // cb with `(nil)` will be called before processing new tile + // no callback: return object of the nearest hit or nil + // if `inverted` is true, trace will register bodies *exluding* tagmask + // `cb` is used unconvetionally here: if it returns `false`, tracer will ignore the object + //WARNING: don't change tags in callbacks here! + function traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; overload; + function traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; 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) + //WARNING: don't change tags in callbacks here! + 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 +220,11 @@ 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 + //WARNING: don't change tags in callbacks here! + 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; @@ -216,33 +243,336 @@ type end; +type + // common structure for all line tracers + TLineWalker = record + public + const TileSize = GridTileSize; + + private + wx0, wy0, wx1, wy1: Integer; // window coordinates + stx, sty: Integer; // "steps" for x and y axes + dx2, dy2: Integer; // "double lengthes" for x and y axes + xd, yd: Integer; // current coord + e: Integer; // "error" (as in bresenham algo) + term: Integer; // end for xd (xd = term: done) + //xptr, yptr: PInteger; + xyswapped: Boolean; // true: xd is y + + public + // call `setyp` after this + constructor Create (minx, miny, maxx, maxy: Integer); + + procedure setClip (minx, miny, maxx, maxy: Integer); inline; + + // this will use `w[xy][01]` to clip coords + // return `false` if the whole line was clipped away + // on `true`, you should process first point, and go on + function setup (x0, y0, x1, y1: Integer): Boolean; + + // call this *after* doing a step + // WARNING! if you will do a step when this returns `true`, you will fall into limbo + function done (): Boolean; inline; + + // as you will prolly call `done()` after doing a step anyway, this will do it for you + // move to next point, return `true` when the line is complete (i.e. you should stop) + function step (): Boolean; inline; + + // move to next tile; return `true` if the line is complete (and walker state is undefined then) + function stepToNextTile (): Boolean; inline; + + // hack for line-vs-aabb; NOT PROPERLY TESTED! + procedure getPrevXY (out ox, oy: Integer); inline; + + // current coords + function x (): Integer; inline; + function y (): Integer; inline; + + procedure getXY (out ox, oy: Integer); inline; + + // move directions; always [-1..1] (can be zero!) + function dx (): Integer; inline; + function dy (): Integer; inline; + end; + + // you are not supposed to understand this // 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): 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; -function minInt (a, b: Integer): Integer; inline; -function maxInt (a, b: Integer): Integer; inline; +//function minInt (a, b: Integer): Integer; inline; +//function maxInt (a, b: Integer): Integer; inline; implementation uses - SysUtils, e_log, g_console; + SysUtils, e_log, g_console, utils; // ////////////////////////////////////////////////////////////////////////// // 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 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; +// ////////////////////////////////////////////////////////////////////////// // +constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer); +begin + setClip(minx, miny, maxx, maxy); +end; + +procedure TLineWalker.setClip (minx, miny, maxx, maxy: Integer); inline; +begin + // clip rectange + wx0 := minx; + wy0 := miny; + wx1 := maxx; + wy1 := maxy; +end; + +function TLineWalker.done (): Boolean; inline; begin result := (xd = term); end; + +function TLineWalker.step (): Boolean; inline; +begin + if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2; + xd += stx; + result := (xd = term); +end; + +// move to next tile; return `true` if the line is complete (and walker state is undefined then) +function TLineWalker.stepToNextTile (): Boolean; inline; +var + ex, ey, wklen, f: Integer; +begin + result := false; + + //writeln('stx=', stx, '; sty=', sty); + + // ortho? + if (sty = 0) then + begin + // only xd + assert(sty <> 0); + if (stx < 0) then + begin + // xd: to left edge + xd := (xd and (not (TileSize-1)))-1; + result := (xd <= term); + exit; + end + else + begin + // xd: to right edge + xd := (xd or (TileSize-1))+1; + result := (xd >= term); + exit; + end; + end; + + assert(stx <> 0); // invariant + + // not ortho + if (sty < 0) then ey := (yd and (not (TileSize-1)))-1 else ey := (yd or (TileSize-1))+1; + + //FIXME: do some math to avoid single-stepping + if (stx < 0) then + begin + // xd: to left edge + ex := (xd and (not (TileSize-1)))-1; + if (ex <= term) then begin result := true; exit; end; + wklen := xd-ex; + end + else + begin + // xd: to right edge + ex := (xd or (TileSize-1))+1; + if (ex >= term) then begin result := true; exit; end; + wklen := ex-xd; + end; + + //writeln('xd=', xd, '; yd=', yd, '; ex=', ex, '; ey=', ey, '; term=', term, '; wklen=', wklen); + + for f := wklen downto 1 do + begin + // do step + if (e >= 0) then begin yd += sty; e -= dx2; end else e += dy2; + xd += stx; + if (xd = term) then begin result := true; exit; end; + if (xd = ex) or (yd = ey) then exit; // done + end; + + raise Exception.Create('TLineWalker.stepToNextTile: the thing that should not be!'); +end; + +// NOT TESTED! +procedure TLineWalker.getPrevXY (out ox, oy: Integer); inline; +begin + //writeln('e=', e, '; dx2=', dx2, '; dy2=', dy2); + if xyswapped then + begin + if (e >= 0) then ox := yd-sty else ox := yd; + oy := xd-stx; + end + else + begin + if (e >= 0) then oy := yd-sty else oy := yd; + ox := xd-stx; + end; +end; + +function TLineWalker.x (): Integer; inline; begin if xyswapped then result := yd else result := xd; end; +function TLineWalker.y (): Integer; inline; begin if xyswapped then result := xd else result := yd; end; +procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin if xyswapped then begin ox := yd; oy := xd; end else begin ox := xd; oy := yd; end; end; + +function TLineWalker.dx (): Integer; inline; begin if xyswapped then result := stx else result := sty; end; +function TLineWalker.dy (): Integer; inline; begin if xyswapped then result := sty else result := stx; end; + +function TLineWalker.setup (x0, y0, x1, y1: Integer): Boolean; + procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begin t := a; a := b; b := t; end; +var + dsx, dsy: Integer; // "lengthes" for x and y axes + rem: Integer; + xfixed: Boolean; + temp: Integer; +begin + result := false; + xyswapped := false; + + // horizontal setup + if (x0 < x1) then + begin + // from left to right + if (x0 > wx1) or (x1 < wx0) then exit; // out of screen + stx := 1; // going right + end + else + begin + // from right to left + if (x1 > wx1) or (x0 < wx0) then exit; // out of screen + stx := -1; // going left + x0 := -x0; + x1 := -x1; + wx0 := -wx0; + wx1 := -wx1; + swapInt(wx0, wx1); + end; + + // vertical setup + if (y0 < y1) then + begin + // from top to bottom + if (y0 > wy1) or (y1 < wy0) then exit; // out of screen + sty := 1; // going down + end + else + begin + // from bottom to top + if (y1 > wy1) or (y0 < wy0) then exit; // out of screen + sty := -1; // going up + y0 := -y0; + y1 := -y1; + wy0 := -wy0; + wy1 := -wy1; + swapInt(wy0, wy1); + end; + + dsx := x1-x0; + dsy := y1-y0; + + if (dsx < dsy) then + begin + xyswapped := true; + //xptr := @yd; + //yptr := @xd; + swapInt(x0, y0); + swapInt(x1, y1); + swapInt(dsx, dsy); + swapInt(wx0, wy0); + swapInt(wx1, wy1); + swapInt(stx, sty); + end + else + begin + //xptr := @xd; + //yptr := @yd; + end; + + dx2 := 2*dsx; + dy2 := 2*dsy; + xd := x0; + yd := y0; + e := 2*dsy-dsx; + term := x1; + + xfixed := false; + if (y0 < wy0) then + begin + // clip at top + temp := dx2*(wy0-y0)-dsx; + xd += temp div dy2; + rem := temp mod dy2; + if (xd > wx1) then exit; // x is moved out of clipping rect, nothing to do + if (xd+1 >= wx0) then + begin + yd := wy0; + e -= rem+dsx; + if (rem > 0) then begin Inc(xd); e += dy2; end; + xfixed := true; + end; + end; + + if (not xfixed) and (x0 < wx0) then + begin + // clip at left + temp := dy2*(wx0-x0); + yd += temp div dx2; + rem := temp mod dx2; + if (yd > wy1) or (yd = wy1) and (rem >= dsx) then exit; + xd := wx0; + e += rem; + if (rem >= dsx) then begin Inc(yd); e -= dx2; end; + end; + + if (y1 > wy1) then + begin + // clip at bottom + temp := dx2*(wy1-y0)+dsx; + term := x0+temp div dy2; + rem := temp mod dy2; + if (rem = 0) then Dec(term); + end; + + if (term > wx1) then term := wx1; // clip at right + + Inc(term); // draw last point (it is ok to inc here, as `term` sign will be changed later + //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; + + result := true; +end; + + // ////////////////////////////////////////////////////////////////////////// // // you are not supposed to understand this // returns `true` if there is an intersection, and enter coords @@ -404,6 +734,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 +848,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); @@ -531,17 +951,17 @@ end; // ////////////////////////////////////////////////////////////////////////// // procedure TBodyGridBase.dumpStats (); var - idx, mcb, cidx, cnt: Integer; + idx, mcb, ccidx, cnt: Integer; begin mcb := 0; for idx := 0 to High(mGrid) do begin - cidx := mGrid[idx]; + ccidx := mGrid[idx]; cnt := 0; - while cidx >= 0 do + while ccidx >= 0 do begin Inc(cnt); - cidx := mCells[cidx].next; + ccidx := mCells[ccidx].next; end; if (mcb < cnt) then mcb := cnt; end; @@ -551,23 +971,23 @@ end; procedure TBodyGridBase.forEachBodyCell (body: TBodyProxyId; cb: TCellQueryCB); var - g, f, cidx: Integer; + g, f, ccidx: Integer; cc: PGridCell; begin if (body < 0) or (body > High(mProxies)) or not assigned(cb) then exit; for g := 0 to High(mGrid) do begin - cidx := mGrid[g]; - while (cidx <> -1) do + ccidx := mGrid[g]; + while (ccidx <> -1) do begin - cc := @mCells[cidx]; + cc := @mCells[ccidx]; for f := 0 to GridCellBucketSize-1 do begin if (cc.bodies[f] = -1) then break; if (cc.bodies[f] = body) then cb((g mod mWidth)*mTileSize+mMinX, (g div mWidth)*mTileSize+mMinY); end; // next cell - cidx := cc.next; + ccidx := cc.next; end; end; end; @@ -575,7 +995,7 @@ end; function TBodyGridBase.forEachInCell (x, y: Integer; cb: TGridQueryCB): ITP; var - f, cidx: Integer; + f, ccidx: Integer; cc: PGridCell; begin result := Default(ITP); @@ -583,17 +1003,17 @@ begin Dec(x, mMinX); Dec(y, mMinY); if (x < 0) or (y < 0) or (x >= mWidth*mTileSize) or (y > mHeight*mTileSize) then exit; - cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)]; - while (cidx <> -1) do + ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)]; + while (ccidx <> -1) do begin - cc := @mCells[cidx]; + cc := @mCells[ccidx]; for f := 0 to GridCellBucketSize-1 do begin if (cc.bodies[f] = -1) then break; if cb(mProxies[cc.bodies[f]].mObj, mProxies[cc.bodies[f]].mTag) then begin result := mProxies[cc.bodies[f]].mObj; exit; end; end; // next cell - cidx := cc.next; + ccidx := cc.next; end; end; @@ -666,13 +1086,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 +1108,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; @@ -812,7 +1232,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean; var - cidx: Integer; + ccidx: Integer; pc: Integer; pi: PGridCell; f: Integer; @@ -823,22 +1243,22 @@ begin if (pc <> -1) then begin {$IF DEFINED(D2F_DEBUG)} - cidx := pc; - while (cidx <> -1) do + ccidx := pc; + while (ccidx <> -1) do begin - pi := @mCells[cidx]; + pi := @mCells[ccidx]; for f := 0 to GridCellBucketSize-1 do begin if (pi.bodies[f] = -1) then break; if (pi.bodies[f] = bodyId) then raise Exception.Create('trying to insert already inserted proxy'); end; - cidx := pi.next; + ccidx := pi.next; end; {$ENDIF} - cidx := pc; - while (cidx <> -1) do + ccidx := pc; + while (ccidx <> -1) do begin - pi := @mCells[cidx]; + pi := @mCells[ccidx]; // check "has room" flag if (pi.bodies[GridCellBucketSize-1] = -1) then begin @@ -855,17 +1275,17 @@ begin raise Exception.Create('internal error in grid inserter'); end; // no room, go to next cell in list (if there is any) - cidx := pi.next; + ccidx := pi.next; end; // no room in cells, add new cell to list end; // either no room, or no cell at all - cidx := allocCell(); - pi := @mCells[cidx]; + ccidx := allocCell(); + pi := @mCells[ccidx]; pi.bodies[0] := bodyId; pi.bodies[1] := -1; pi.next := pc; - mGrid[grida] := cidx; + mGrid[grida] := ccidx; end; procedure TBodyGridBase.insertInternal (body: TBodyProxyId); @@ -882,16 +1302,16 @@ end; function TBodyGridBase.remover (grida: Integer; bodyId: TBodyProxyId): Boolean; var f, c: Integer; - pidx, cidx: Integer; + pidx, ccidx: Integer; pc: PGridCell; begin result := false; // never stop // find and remove cell pidx := -1; // previous cell index - cidx := mGrid[grida]; // current cell index - while (cidx <> -1) do + ccidx := mGrid[grida]; // current cell index + while (ccidx <> -1) do begin - pc := @mCells[cidx]; + pc := @mCells[ccidx]; for f := 0 to GridCellBucketSize-1 do begin if (pc.bodies[f] = bodyId) then @@ -901,7 +1321,7 @@ begin begin // this cell contains no elements, remove it if (pidx = -1) then mGrid[grida] := pc.next else mCells[pidx].next := pc.next; - freeCell(cidx); + freeCell(ccidx); exit; end; // remove element from bucket @@ -914,8 +1334,8 @@ begin exit; end; end; - pidx := cidx; - cidx := pc.next; + pidx := ccidx; + ccidx := pc.next; end; end; @@ -1164,12 +1584,12 @@ end; // ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator; var - cidx: Integer = -1; + ccidx: Integer = -1; begin Dec(x, mMinX); Dec(y, mMinY); - if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then cidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)]; - result := TAtPointEnumerator.Create(mCells, cidx, getProxyById); + if (x >= 0) and (y >= 0) and (x < mWidth*mTileSize) and (y < mHeight*mTileSize) then ccidx := mGrid[(y div mTileSize)*mWidth+(x div mTileSize)]; + result := TAtPointEnumerator.Create(mCells, ccidx, getProxyById); end; @@ -1363,17 +1783,17 @@ end; // ////////////////////////////////////////////////////////////////////////// // // no callback: return `true` on the nearest hit -function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; +function TBodyGridBase.traceRayOld (const x0, y0, x1, y1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; var ex, ey: Integer; begin - result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask); + result := traceRayOld(ex, ey, x0, y0, x1, y1, cb, tagmask); end; // no callback: return `true` on the nearest hit // you are not supposed to understand this -function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; +function TBodyGridBase.traceRayOld (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridRayQueryCB; tagmask: Integer=-1): ITP; const tsize = mTileSize; var @@ -1654,8 +2074,6 @@ begin // one of those will never change x := xptr^+minx; y := yptr^+miny; - //prevx := x; - //prevy := y; while (wklen > 0) do begin {$IF DEFINED(D2F_DEBUG)} @@ -1678,13 +2096,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 @@ -1725,16 +2143,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 @@ -1745,16 +2163,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 @@ -1828,7 +2246,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -1839,7 +2257,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -2319,7 +2737,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -2330,7 +2748,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -2425,4 +2843,376 @@ 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; + ccidx: Integer; + cc: PGridCell; + px: PBodyProxyRec; + lq: LongWord; + f, ptag: Integer; + minu0: Single = 100000.0; + u0: Single; + cx0, cy0, cx1, cy1: Integer; + hitpx: PBodyProxyRec = nil; +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 + ccidx := mGrid[gy*mWidth+gx]; + 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 (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) then continue; + if (minu0 > u0) then + begin + hitpx := px; + result := px.mObj; + minu0 := u0; + if (u0 = 0.0) then + begin + ex := ax0; + ey := ay0; + mInQuery := false; + exit; + end; + end; + end; + end; + // next cell + ccidx := cc.next; + end; + end; + end; + + if (minu0 <= 1.0) then + begin + ex := ax0+round(dx*minu0); + ey := ay0+round(dy*minu0); + // just in case, compensate for floating point inexactness + if (ex >= hitpx.mX) and (ey >= hitpx.mY) and (ex < hitpx.mX+hitpx.mWidth) and (ey < hitpx.mY+hitpx.mHeight) then + begin + ex := ax0+trunc(dx*minu0); + ey := ay0+trunc(dy*minu0); + end; + 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; + + +// ////////////////////////////////////////////////////////////////////////// // +function TBodyGridBase.traceRay (const x0, y0, x1, y1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; +var + ex, ey: Integer; +begin + result := traceRay(ex, ey, x0, y0, x1, y1, cb, tagmask); +end; + + +// no callback: return `true` on the nearest hit +// you are not supposed to understand this +function TBodyGridBase.traceRay (out ex, ey: Integer; const ax0, ay0, ax1, ay1: Integer; cb: TGridQueryCB; tagmask: Integer=-1): ITP; +var + lw, sweepw: TLineWalker; + ccidx: Integer; + gw, gh, minx, miny: Integer; + cc: PGridCell; + px: PBodyProxyRec; + lq: LongWord; + f, ptag: Integer; + x0, y0, x1, y1, cx, cy, px0, py0, px1, py1: Integer; + lastDistSq, distSq, hx, hy: Integer; + firstCell: Boolean = true; + wasHit: Boolean; +begin + result := Default(ITP); + tagmask := tagmask and TagFullMask; + if (tagmask = 0) then exit; + + gw := mWidth; + gh := mHeight; + minx := mMinX; + miny := mMinY; + + // make query coords to (0,0)-based + x0 := ax0-minx; + y0 := ay0-miny; + x1 := ax1-minx; + y1 := ay1-miny; + + lw := TLineWalker.Create(0, 0, gw*mTileSize-1, gh*mTileSize-1); + if not lw.setup(x0, y0, x1, y1) then exit; // out of screen + + sweepw := TLineWalker.Create(0, 0, 1, 1); // doesn't matter, just shut ups the compiler + + lastDistSq := distanceSq(ax0, ay0, ax1, ay1)+1; + + if mInQuery then raise Exception.Create('recursive queries aren''t supported'); + mInQuery := true; + + // 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; + + ccidx := -1; + repeat + lw.getXY(cx, cy); + // check tile + ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)]; + // process cells + wasHit := false; + 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 (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; + // get adjusted proxy coords + px0 := px.mX-minx; + py0 := px.mY-miny; + px1 := px0+px.mWidth-1; + py1 := py0+px.mHeight-1; + // inside? + if firstCell and (x0 >= px0) and (y0 >= py0) and (x0 <= px1) and (y0 <= py1) then + begin + // oops + ex := ax0; + ey := ay0; + result := px.mObj; + mInQuery := false; + exit; + end; + // do line-vs-aabb test + sweepw.setClip(px0, py0, px1, py1); + if sweepw.setup(x0, y0, x1, y1) then + begin + // hit detected + sweepw.getPrevXY(hx, hy); + distSq := distanceSq(x0, y0, hx, hy); + if (distSq < lastDistSq) then + begin + lastDistSq := distSq; + ex := hx+minx; + ey := hy+miny; + result := px.mObj; + // if this is not a first cell, get outta here + if not firstCell then begin mInQuery := false; exit; end; + wasHit := true; + end; + end; + end; + end; + // next cell + ccidx := cc.next; + end; + // done processing cells; exit if we registered a hit + // next cells can't have better candidates, obviously + if wasHit then begin mInQuery := false; exit; end; + firstCell := false; + // move to next tile + until lw.stepToNextTile(); + + mInQuery := false; +end; + + end.