X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_grid.pas;h=049868c7821e7784afa08dbe18e68ab97c0d6a31;hb=a0b4df67e96c6b5e55e95269a87975df67692e6b;hp=346770246cfd96eb4bb196e9471360ef95763d13;hpb=836fd31457a6f741815605633f2fbfa157e37418;p=d2df-sdl.git diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index 3467702..049868c 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -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; @@ -71,6 +74,12 @@ type property height: Integer read mHeight; 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 @@ -81,20 +90,36 @@ type next: Integer; // in this cell; index in mCells end; + TCellArray = array of TGridCell; + TGridInternalCB = function (grida: Integer; bodyId: TBodyProxyId): Boolean of object; // return `true` to stop private //mTileSize: Integer; const mTileSize = GridDefaultTileSize; + type TGetProxyFn = function (pxidx: Integer): PBodyProxyRec of object; public const tileSize = mTileSize; + type + TAtPointEnumerator = record + private + mCells: TCellArray; + curidx, curbki: Integer; + getpx: TGetProxyFn; + public + constructor Create (acells: TCellArray; aidx: Integer; agetpx: TGetProxyFn); + function MoveNext (): Boolean; inline; + function getCurrent (): PBodyProxyRec; inline; + property Current: PBodyProxyRec read getCurrent; + end; + private mMinX, mMinY: Integer; // so grids can start at any origin mWidth, mHeight: Integer; // in tiles mGrid: array of Integer; // mWidth*mHeight, index in mCells - mCells: array of TGridCell; // cell pool + mCells: TCellArray; // cell pool mFreeCell: Integer; // first free cell index or -1 mLastQuery: LongWord; mUsedCells: Integer; @@ -161,6 +186,8 @@ 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 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) // cb with `(nil)` will be called before processing new tile @@ -170,8 +197,9 @@ 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 + 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) @@ -213,7 +241,7 @@ function maxInt (a, b: Integer): Integer; inline; implementation uses - SysUtils, e_log, g_console; + SysUtils, e_log, g_console, utils; // ////////////////////////////////////////////////////////////////////////// // @@ -419,6 +447,50 @@ 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); +begin + mCells := acells; + curidx := aidx; + curbki := -1; + getpx := agetpx; +end; + + +function TBodyGridBase.TAtPointEnumerator.MoveNext (): Boolean; inline; +begin + while (curidx <> -1) do + begin + while (curbki < GridCellBucketSize) do + begin + Inc(curbki); + if (mCells[curidx].bodies[curbki] = -1) then break; + result := true; + exit; + end; + curidx := mCells[curidx].next; + curbki := -1; + end; + result := false; +end; + + +function TBodyGridBase.TAtPointEnumerator.getCurrent (): PBodyProxyRec; inline; +begin + result := getpx(mCells[curidx].bodies[curbki]); +end; + // ////////////////////////////////////////////////////////////////////////// // constructor TBodyGridBase.Create (aMinPixX, aMinPixY, aPixWidth, aPixHeight: Integer{; aTileSize: Integer=GridDefaultTileSize}); @@ -1108,6 +1180,18 @@ begin end; +// ////////////////////////////////////////////////////////////////////////// // +function TBodyGridBase.atCellInPoint (x, y: Integer): TAtPointEnumerator; +var + cidx: 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); +end; + + // ////////////////////////////////////////////////////////////////////////// // // no callback: return `true` on the first hit function TBodyGridBase.forEachAtPoint (x, y: Integer; cb: TGridQueryCB; tagmask: Integer=-1; exittag: PInteger=nil): ITP; @@ -1589,18 +1673,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)} @@ -1623,13 +1695,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 @@ -1670,16 +1742,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 @@ -1690,16 +1762,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 @@ -1773,7 +1845,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -1784,7 +1856,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -1974,7 +2046,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; @@ -2189,23 +2261,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 @@ -2213,7 +2272,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]; @@ -2278,7 +2336,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Inc(yptr^, wkstep); - Inc(ga, mHeight); + Inc(ga, mWidth); end else begin @@ -2289,7 +2347,7 @@ begin {$ENDIF} if (wkstep >= wklen) then break; Dec(yptr^, wkstep); - Dec(ga, mHeight); + Dec(ga, mWidth); end; end; Dec(wklen, wkstep); @@ -2330,9 +2388,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 @@ -2387,4 +2442,135 @@ begin 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[y1-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.