X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_grid.pas;h=99533e9db18b18444f4634429499566071c761fd;hb=0944e70467355a7771d42015b6e548050e6fa3b7;hp=fae595dc6c0844388402cfaa738905a28eaacf54;hpb=723546f31b9eef4356639c443419be4a6e2b8ebb;p=d2df-sdl.git diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index fae595d..99533e9 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -25,6 +25,8 @@ 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 @@ -96,7 +96,7 @@ type private //mTileSize: Integer; - const mTileSize = GridDefaultTileSize; + const mTileSize = GridTileSize; type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object; public @@ -194,13 +194,24 @@ 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; // 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!) @@ -211,6 +222,7 @@ type // 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 @@ -231,6 +243,59 @@ 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 @@ -238,12 +303,10 @@ type 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 (or boxes overlaps) +// 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) -// if no collision was detected: -// u1 < 0: no collision at all -// u1 >= 0: boxes are overlapping at the start; u0 has no meaning, u1 is exit time, hitedge is undefined // 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; @@ -252,8 +315,8 @@ function sweepAABB (mex0, mey0, mew, meh: Integer; medx, medy: Integer; itx0, it 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 @@ -264,12 +327,252 @@ uses // ////////////////////////////////////////////////////////////////////////// // 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 @@ -648,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; @@ -668,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; @@ -692,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); @@ -700,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; @@ -929,7 +1232,7 @@ end; // ////////////////////////////////////////////////////////////////////////// // function TBodyGridBase.inserter (grida: Integer; bodyId: TBodyProxyId): Boolean; var - cidx: Integer; + ccidx: Integer; pc: Integer; pi: PGridCell; f: Integer; @@ -940,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 @@ -972,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); @@ -999,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 @@ -1018,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 @@ -1031,8 +1334,8 @@ begin exit; end; end; - pidx := cidx; - cidx := pc.next; + pidx := ccidx; + ccidx := pc.next; end; end; @@ -1281,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; @@ -1480,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 @@ -2546,15 +2849,15 @@ end; 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; + ccidx: Integer; cc: PGridCell; px: PBodyProxyRec; lq: LongWord; f, ptag: Integer; minu0: Single = 100000.0; u0: Single; - hedge: Integer; cx0, cy0, cx1, cy1: Integer; + hitpx: PBodyProxyRec = nil; begin result := Default(ITP); ex := ax0+dx; @@ -2591,16 +2894,14 @@ begin end; lq := mLastQuery; - gy := cy0; - while (gy <= cy1) do + for gy := cy0 div mTileSize to cy1 div mTileSize do begin - gx := cx0; - while (gx <= cx1) do + for gx := cx0 div mTileSize to cx1 div mTileSize do begin - cidx := mGrid[(gy div mTileSize)*mWidth+(gx div mTileSize)]; - while (cidx <> -1) do + ccidx := mGrid[gy*mWidth+gx]; + 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; @@ -2613,18 +2914,16 @@ begin begin if not cb(px.mObj, ptag) then continue; end; - if not sweepAABB(cx0+mMinX, cy0+mMinY, aw, ah, dx, dy, px.mX, px.mY, px.mWidth, px.mHeight, @u0, @hedge) then - begin - 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 := cx0+mMinX; - ey := cy0+mMinY; + ex := ax0; + ey := ay0; mInQuery := false; exit; end; @@ -2632,17 +2931,21 @@ begin end; end; // next cell - cidx := cc.next; + ccidx := cc.next; end; - Inc(gx, mTileSize); end; - Inc(gy, mTileSize); end; if (minu0 <= 1.0) then begin - ex := ax0+trunc(dx*minu0); - ey := ay0+trunc(dy*minu0); + 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; @@ -2781,4 +3084,135 @@ begin 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.