From: Ketmar Dark Date: Fri, 8 Sep 2017 11:30:52 +0000 (+0300) Subject: hacked new ray tracer: it is complete shit, but at least it seems to work; i'll rewri... X-Git-Url: https://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=commitdiff_plain;h=7934e57057ee8f016b900c0c53c97204ac776244 hacked new ray tracer: it is complete shit, but at least it seems to work; i'll rewrite it later... maybe --- diff --git a/src/game/g_gfx.pas b/src/game/g_gfx.pas index 52c3b24..e75af88 100644 --- a/src/game/g_gfx.pas +++ b/src/game/g_gfx.pas @@ -527,7 +527,7 @@ procedure TParticle.thinkerBloodAndWater (); ex: Integer; begin state := TPartState.Stuck; - if (dX > 0) then stickDX := 1 else stickDX := -1; + if (dx > 0) then stickDX := 1 else stickDX := -1; freeze(); // find next floor transition findFloor(); @@ -587,7 +587,7 @@ label _done, _gravityagain, _stuckagain; var pan: TPanel; - dX, dY: SmallInt; + dx, dy: SmallInt; ex, ey: Integer; checkEnv: Boolean; floorJustTraced: Boolean; @@ -595,7 +595,7 @@ var oldFloorY: Integer; {$ENDIF} begin - if not gpart_dbg_phys_enabled then goto _done; + if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end; if gAdvBlood then begin @@ -682,8 +682,8 @@ begin end; // it is important to have it here - dX := round(velX); - dY := round(velY); + dx := round(velX); + dy := round(velY); if (state = TPartState.Normal) then checkAirStreams(); @@ -730,10 +730,10 @@ begin end; // trace movement - if (dX <> 0) then + if (dx <> 0) then begin // has some horizontal velocity - pan := g_Map_traceToNearest(x, y, x+dX, y+dY, GridTagObstacle, @ex, @ey); + pan := g_Map_traceToNearest(x, y, x+dx, y+dy, GridTagObstacle, @ex, @ey); checkEnv := (x <> ex); x := ex; y := ey; @@ -750,11 +750,11 @@ begin // we stuck // the only case when we can have both ceiling and wall is corner; stick to wall in this case // check if we stuck to a wall - if (dX < 0) then dX := -1 else dX := 1; - if (g_Map_PanelAtPoint(x+dX, y, GridTagObstacle) <> nil) then + if (dx < 0) then dx := -1 else dx := 1; + if (g_Map_PanelAtPoint(x+dx, y, GridTagObstacle) <> nil) then begin // stuck to a wall - stickToWall(dX); + stickToWall(dx); end else begin @@ -763,31 +763,31 @@ begin end; end; end - else if (dY <> 0) then + else if (dy <> 0) then begin // has only vertical velocity - if (dY < 0) then + if (dy < 0) then begin // flying up if (ceilingY = Unknown) then findCeiling(); // need to do this anyway - y += dY; + y += dy; if (y <= ceilingY) then begin y := ceilingY; stickToCeiling(); end; // oops, hit a ceiling // environment didn't changed end else begin - while (dY > 0) do + while (dy > 0) do begin // falling down floorJustTraced := (floorY = Unknown); if floorJustTraced then findFloor(); if (floorType = TFloorType.LiquidOut) then env := TEnvType.ELiquid else env := TEnvType.EAir; - y += dY; + y += dy; //e_LogWritefln('floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]); if (y >= floorY) then begin // floor transition - dY := y-floorY; + dy := y-floorY; y := floorY; //e_LogWritefln(' HIT FLOORY: floorY=%s; newy=%s; dY=%s; floorType=%s', [floorY, y, dY, floorType]); case floorType of @@ -845,10 +845,10 @@ begin else begin // simple blood - dX := round(velX); - dY := round(velY); - y += dY; - x += dX; + dx := round(velX); + dy := round(velY); + y += dy; + x += dx; if (g_Map_PanelAtPoint(x, y, GridTagObstacle) <> nil) then begin die(); exit; end; end; @@ -1120,14 +1120,14 @@ end; // ////////////////////////////////////////////////////////////////////////// // procedure TParticle.thinkerBubble (); var - dY: Integer; + dy: Integer; begin - dY := round(velY); + dy := round(velY); - if (dY <> 0) then + if (dy <> 0) then begin - y += dY; - if (dY < 0) then + y += dy; + if (dy < 0) then begin if (y <= ceilingY) then begin die(); exit; end; end @@ -1227,14 +1227,16 @@ procedure TParticle.thinkerSpark (); label _done; var - dX, dY: SmallInt; + dx, dy: SmallInt; pan: TPanel; ex, ey: Integer; begin - if not gpart_dbg_phys_enabled then goto _done; + if not gpart_dbg_phys_enabled then begin x += round(velX); y += round(velY); goto _done; end; - dX := round(velX); - dY := round(velY); + dx := round(velX); + dy := round(velY); + + //writeln('spark0: pos=(', x, ',', y, '); delta=(', dx, ',', dy, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY); // apply gravity if (abs(velX) < 0.1) and (abs(velY) < 0.1) then @@ -1244,10 +1246,10 @@ begin end; // flying - if (dX <> 0) then + if (dx <> 0) then begin // has some horizontal velocity - pan := g_Map_traceToNearest(x, y, x+dX, y+dY, (GridTagObstacle or GridTagLiquid), @ex, @ey); + pan := g_Map_traceToNearest(x, y, x+dx, y+dy, (GridTagObstacle or GridTagLiquid), @ex, @ey); if (x <> ex) then begin floorY := Unknown; ceilingY := Unknown; end; // dunno yet x := ex; y := ey; @@ -1259,14 +1261,14 @@ begin accelX := 0; end; end - else if (dY <> 0) then + else if (dy <> 0) then begin // has some vertical velocity - if (dY < 0) then + if (dy < 0) then begin // flying up if (ceilingY = Unknown) then findCeiling(); // need to do this anyway - y += dY; + y += dy; if (y <= ceilingY) then begin // oops, hit a ceiling @@ -1280,7 +1282,7 @@ begin begin // falling down if (floorY = Unknown) then findFloor(); // need to do this anyway - y += dY; + y += dy; if (y >= floorY) then begin // hit something except a floor? @@ -1304,6 +1306,8 @@ _done: velY += accelY; end; + //writeln('spark1: pos=(', x, ',', y, '); delta=(', velX:6:3, ',', velY:6:3, '); state=', state, '; ceilingY=', ceilingY, '; floorY=', floorY); + time += 1; end; diff --git a/src/game/g_grid.pas b/src/game/g_grid.pas index 38ee53b..1cb2534 100644 --- a/src/game/g_grid.pas +++ b/src/game/g_grid.pas @@ -21,6 +21,7 @@ {.$DEFINE D2F_DEBUG_MOVER} {$ENDIF} {.$DEFINE GRID_USE_ORTHO_ACCEL} +{$DEFINE LINEAABB2} unit g_grid; interface @@ -249,12 +250,10 @@ type 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 + stleft: Integer; // "steps left" + err, errinc, errmax: Integer; 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 + horiz: Boolean; public // call `setyp` after this @@ -278,18 +277,12 @@ type // 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; + public + // current coords + property x: Integer read xd; + property y: Integer read yd; end; @@ -331,6 +324,103 @@ procedure swapInt (var a: Integer; var b: Integer); inline; var t: Integer; begi function distanceSq (x0, y0, x1, y1: Integer): Integer; inline; begin result := (x1-x0)*(x1-x0)+(y1-y0)*(y1-y0); end; +// ////////////////////////////////////////////////////////////////////////// // +function clipLine (var x0, y0, x1, y1: Single; xmin, ymin, xmax, ymax: Single): Boolean; +const + Inside = 0; + Left = 1; + Right = 2; + Bottom = 4; + Top = 8; + + function xcode (x, y: Single): Byte; inline; + begin + result := Inside; + if (x < xmin) then result := result or Left else if (x > xmax) then result := result or Right; + if (y < ymin) then result := result or Bottom else if (y > ymax) then result := result or Top; + end; + +var + outcode0, outcode1, outcodeOut: Byte; + x: Single = 0; + y: Single = 0; +begin + result := false; // accept + outcode0 := xcode(x0, y0); + outcode1 := xcode(x1, y1); + while true do + begin + if ((outcode0 or outcode1) = 0) then begin result := true; exit; end; // accept + if ((outcode0 and outcode1) <> 0) then exit; // reject + outcodeOut := outcode0; + if (outcodeOut = 0) then outcodeOut := outcode1; + if ((outcodeOut and Top) <> 0) then + begin + x := x0+(x1-x0)*(ymax-y0)/(y1-y0); + y := ymax; + end + else if ((outcodeOut and Bottom) <> 0) then + begin + x := x0+(x1-x0)*(ymin-y0)/(y1-y0); + y := ymin; + end + else if ((outcodeOut and Right) <> 0) then + begin + y := y0+(y1-y0)*(xmax-x0)/(x1-x0); + x := xmax; + end + else if ((outcodeOut and Left) <> 0) then + begin + y := y0+(y1-y0)*(xmin-x0)/(x1-x0); + x := xmin; + end; + if (outcodeOut = outcode0) then + begin + x0 := x; + y0 := y; + outcode0 := xcode(x0, y0); + end + else + begin + x1 := x; + y1 := y; + outcode1 := xcode(x1, y1); + end; + end; +end; + + +// returns `true` if there is an intersection, and enter coords +// enter coords will be equal to (x0, y0) if starting point is inside the box +// if result is `false`, `inx` and `iny` are undefined +function lineAABBIntersects (x0, y0, x1, y1: Integer; bx, by, bw, bh: Integer; out inx, iny: Integer): Boolean; +var + sx0, sy0, sx1, sy1: Single; +begin + inx := x0; + iny := y0; + result := false; + if (bw < 1) or (bh < 1) then exit; + if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin result := true; exit; end; + sx0 := x0; sy0 := y0; + sx1 := x1; sy1 := y1; + result := clipLine(sx0, sy0, sx1, sy1, bx, by, bx+bw-1, by+bh-1); + if result then + begin + inx := trunc(sx0); + iny := trunc(sy0); + // hack! + if (inx = bx) then Dec(inx) else if (inx = bx+bw-1) then Inc(inx); + if (iny = by) then Dec(iny) else if (iny = by+bh-1) then Inc(iny); + end + else + begin + inx := x1; + iny := y1; + end; +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TLineWalker.Create (minx, miny, maxx, maxy: Integer); begin @@ -346,334 +436,225 @@ begin 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; - -function TLineWalker.stepToNextTile (): Boolean; inline; +function TLineWalker.setup (x0, y0, x1, y1: Integer): Boolean; var - ex, ey: Integer; - xwalk, ywalk, wklen: Integer; // to the respective edges - lstx, lsty, lterm: Integer; - le, ldx2, ldy2: Integer; - lxd, lyd: Integer; - f: Integer; + sx0, sy0, sx1, sy1: Single; begin - result := false; - - lstx := stx; - lsty := sty; - lterm := term; - lxd := xd; + if (wx1 < wx0) or (wy1 < wy0) then begin stleft := 0; xd := x0; yd := y0; result := false; exit; end; - // ortho? - if (lsty = 0) then + if (x0 >= wx0) and (y0 >= wy0) and (x0 <= wx1) and (y0 <= wy1) and + (x1 >= wx0) and (y1 >= wy0) and (x1 <= wx1) and (y1 <= wy1) then begin - // only xd - //assert(lsty <> 0); - if (lstx < 0) then - begin - // xd: to left edge - xd := (lxd and (not (TileSize-1)))-1; - result := (lxd <= lterm); - exit; - end - else - begin - // xd: to right edge - xd := (lxd or (TileSize-1))+1; - result := (lxd >= lterm); - exit; - end; - end; - - // not ortho - //assert(lstx <> 0); // invariant - - lyd := yd; - le := e; - ldx2 := dx2; - ldy2 := dy2; - - // calculate xwalk - if (lstx < 0) then - begin - ex := (lxd and (not (TileSize-1)))-1; - xwalk := lxd-ex; + result := true; end else begin - ex := (lxd or (TileSize-1))+1; - xwalk := ex-lxd; + sx0 := x0; sy0 := y0; + sx1 := x1; sy1 := y1; + result := clipLine(sx0, sy0, sx1, sy1, wx0, wy0, wx1, wy1); + if not result then begin stleft := 0; xd := x0; yd := y0; exit; end; + x0 := trunc(sx0); y0 := trunc(sy0); + x1 := trunc(sx1); y1 := trunc(sy1); end; - // calculate ywalk - if (lsty < 0) then + // check for ortho lines + if (y0 = y1) then begin - ey := (lyd and (not (TileSize-1)))-1; - ywalk := lyd-ey; + // horizontal + horiz := true; + stleft := abs(x1-x0)+1; + if (x0 < x1) then stx := 1 else stx := -1; + sty := 0; + errinc := 0; + errmax := 10; // anything that is greater than zero end - else + else if (x0 = x1) then begin - ey := (lyd or (TileSize-1))+1; - ywalk := ey-lyd; - end; - - while true do + // vertical + horiz := false; + stleft := abs(y1-y0)+1; + stx := 0; + if (y0 < y1) then sty := 1 else sty := -1; + errinc := 0; + errmax := 10; // anything that is greater than zero + end + else begin - // in which dir we want to walk? - if (xwalk <= ywalk) then wklen := xwalk else wklen := ywalk; - // walk x - if (lstx < 0) then + // diagonal + if (abs(x1-x0) >= abs(y1-y0)) then begin - lxd -= wklen; - if (lxd <= lterm) then begin xd := lxd; result := true; exit; end; + // horizontal + horiz := true; + stleft := abs(x1-x0)+1; + errinc := abs(y1-y0)+1; end else begin - lxd += wklen; - if (lxd >= lterm) then begin xd := lxd; result := true; exit; end; + // vertical + horiz := false; + stleft := abs(y1-y0)+1; + errinc := abs(x1-x0)+1; end; - // walk y - for f := 1 to wklen do if (le >= 0) then begin lyd += lsty; le -= ldx2; end else le += ldy2; - if (lxd = ex) or (lyd = ey) then break; - xwalk -= wklen; if (xwalk = 0) then xwalk := TileSize; - ywalk -= wklen; if (ywalk = 0) then ywalk := TileSize; + if (x0 < x1) then stx := 1 else stx := -1; + if (y0 < y1) then sty := 1 else sty := -1; + errmax := stleft; end; - //assert((xd div TileSize <> lxd div TileSize) or (yd div TileSize <> lyd div TileSize)); - xd := lxd; - yd := lyd; - e := le; + xd := x0; + yd := y0; + err := -errmax; end; -// NOT TESTED! -procedure TLineWalker.getPrevXY (out ox, oy: Integer); inline; +function TLineWalker.done (): Boolean; inline; begin result := (stleft <= 0); end; + +// true: done +function TLineWalker.step (): Boolean; inline; begin - //writeln('e=', e, '; dx2=', dx2, '; dy2=', dy2); - if xyswapped then + if horiz then begin - if (e >= 0) then ox := yd-sty else ox := yd; - oy := xd-stx; + xd += stx; + err += errinc; + if (err >= 0) then begin err -= errmax; yd += sty; end; end else begin - if (e >= 0) then oy := yd-sty else oy := yd; - ox := xd-stx; + yd += sty; + err += errinc; + if (err >= 0) then begin err -= errmax; xd += stx; end; end; + Dec(stleft); + result := (stleft <= 0); 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; begin a := a xor b; b := b xor a; a := a xor b; end; +// true: done +function TLineWalker.stepToNextTile (): Boolean; inline; var - dsx, dsy: Integer; // "lengthes" for x and y axes - rem: Integer; - xfixed: Boolean; - temp: Integer; + ex, ey: Integer; + xwalk, ywalk, wklen: Integer; // to the respective edges + f: 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 + if (stleft < 2) then begin result := true; exit; end; // max one pixel left, nothing to do + + // strictly horizontal? + if (sty = 0) then 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); + // only xd + if (stx < 0) then + begin + // xd: to left edge + ex := (xd and (not (TileSize-1)))-1; + stleft -= xd-ex; + end + else + begin + // xd: to right edge + ex := (xd or (TileSize-1))+1; + stleft -= ex-xd; + end; + result := (stleft <= 0); + xd := ex; + exit; end; - // vertical setup - if (y0 < y1) then + // strictly vertical? + if (stx = 0) 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); + // only xd + if (sty < 0) then + begin + // yd: to top edge + ey := (yd and (not (TileSize-1)))-1; + stleft -= yd-ey; + end + else + begin + // yd: to bottom edge + ey := (yd or (TileSize-1))+1; + stleft -= ey-yd; + end; + result := (stleft <= 0); + yd := ey; + exit; end; - dsx := x1-x0; - dsy := y1-y0; + // diagonal - if (dsx < dsy) then + // calculate xwalk + if (stx < 0) 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); + ex := (xd and (not (TileSize-1)))-1; + xwalk := xd-ex; 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; //BUGGY - if (xd < wx0) then begin xd += 1; e += dy2; end; //??? - xfixed := true; - end; + ex := (xd or (TileSize-1))+1; + xwalk := ex-xd; end; - if (not xfixed) and (x0 < wx0) then + // calculate ywalk + if (sty < 0) 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 + ey := (yd and (not (TileSize-1)))-1; + ywalk := yd-ey; + end + else begin - // clip at bottom - temp := dx2*(wy1-y0)+dsx; - term := x0+temp div dy2; - rem := temp mod dy2; - if (rem = 0) then Dec(term); + ey := (yd or (TileSize-1))+1; + ywalk := ey-yd; 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; - - -// ////////////////////////////////////////////////////////////////////////// // -// true: has something to draw -// based on paper by S.R.Kodituwakku, K.R.Wijeweera, M.A.P.Chamikara -function clipMY (var x0, y0, x1, y1: Single; minx, miny, maxx, maxy: Single): Boolean; -var - m, c: Single; -begin - // non vertical lines - if (x0 <> x1) then + { + while (xd <> ex) and (yd <> ey) do begin - // non vertical and non horizontal lines - if (y0 <> y1) then + if horiz then begin - m := (y0-y1)/(x0-x1); // gradient - c := (x0*y1-x1*y0)/(x0-x1); // y-intercept - if (x0 < minx) then begin x0 := minx; y0 := m*minx+c; end - else if (x0 > maxx) then begin x0 := maxx; y0 := m*maxx+c; end; - if (y0 < miny) then begin x0 := (miny-c)/m; y0 := miny; end - else if (y0 > maxy) then begin x0 := (maxy-c)/m; y0 := maxy; end; - if (x1 < minx) then begin x1 := minx; y1 := m*minx+c; end - else if (x1 > maxx) then begin x1 := maxx; y1 := m*maxx+c; end; - if (y1 < miny) then begin x1 := (miny-c)/m; y1 := miny; end - else if (y1 > maxy) then begin x1 := (maxy-c)/m; y1 := maxy; end; - result := not ((x0-x1 < 1) and (x1-x0 < 1)); // completely outside? + xd += stx; + err += errinc; + if (err >= 0) then begin err -= errmax; yd += sty; end; end else begin - // horizontal lines - if (y0 <= miny) or (y0 >= maxy) then begin result := false; exit; end; // completely outside - if (x0 < minx) then x0 := minx else if (x0 > maxx) then x0 := maxx; - if (x1 < minx) then x1 := minx else if (x1 > maxx) then x1 := maxx; - result := not ((x0-x1 < 1) and (x1-x0 < 1)); // completely outside? + yd += sty; + err += errinc; + if (err >= 0) then begin err -= errmax; xd += stx; end; end; - end - else + Dec(stleft); + if (stleft < 1) then begin result := true; exit; end; + end; + } + + if (xwalk <= ywalk) then wklen := xwalk else wklen := ywalk; + while true do begin - // vertical lines - // initial line is just a point - if (y0 = y1) then - begin - result := not ((y0 <= miny) or (y0 >= maxy) or (x0 <= minx) or (x0 >= maxx)); - end - else if (x0 <= minx) or (x0 >= maxx) then + // in which dir we want to walk? + stleft -= wklen; + if (stleft <= 0) then begin result := true; exit; end; + if horiz then begin - // completely outside - result := false; + xd += wklen*stx; + for f := 1 to wklen do + begin + err += errinc; + if (err >= 0) then begin err -= errmax; yd += sty; end; + end; end else begin - if (y0 < miny) then y0 := miny else if (y0 > maxy) then y0 := maxy; - if (y1 < miny) then y1 := miny else if (y1 > maxy) then y1 := maxy; - result := not ((y0-y1 < 1) and (y1-y0 < 1)); // completely outside? + yd += wklen*sty; + for f := 1 to wklen do + begin + err += errinc; + if (err >= 0) then begin err -= errmax; xd += stx; end; + end; end; + // check for walk completion + if (xd = ex) or (yd = ey) then exit; + wklen := 1; end; 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; -var - sx0, sy0, sx1, sy1: Single; -begin - if (bw < 1) or (bh < 1) then begin inx := x0; iny := y0; result := false; exit; end; - if (x0 >= bx) and (y0 >= by) and (x0 < bx+bw) and (y0 < by+bh) then begin inx := x0; iny := y0; result := true; exit; end; - sx0 := x0; sy0 := y0; - sx1 := x1; sy1 := y1; - result := clipMY(sx0, sy0, sx1, sy1, bx, by, bx+bw-1, by+bh-1); - if result then begin inx := trunc(sx0); iny := trunc(sy0); end else begin inx := x1; iny := y1; end; -end; +procedure TLineWalker.getXY (out ox, oy: Integer); inline; begin ox := xd; oy := yd; end; // ////////////////////////////////////////////////////////////////////////// // @@ -2065,7 +2046,7 @@ end; // 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; + lw: TLineWalker; ccidx: Integer; cc: PGridCell; px: PBodyProxyRec; @@ -2098,10 +2079,12 @@ begin 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 DEFINED(D2F_DEBUG)} + //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln('*** traceRay: (%s,%s)-(%s,%s)', [x0, y0, x1, y1]); + {$ENDIF} + if mInQuery then raise Exception.Create('recursive queries aren''t supported'); mInQuery := true; @@ -2117,6 +2100,9 @@ begin repeat lw.getXY(cx, cy); + {$IF DEFINED(D2F_DEBUG)} + if assigned(dbgRayTraceTileHitCB) then dbgRayTraceTileHitCB(cx+mMinX, cy+mMinY); + {$ENDIF} // check tile ccidx := mGrid[(cy div mTileSize)*gw+(cx div mTileSize)]; // process cells @@ -2141,6 +2127,9 @@ begin py0 := px.mY-miny; px1 := px0+px.mWidth-1; py1 := py0+px.mHeight-1; + {$IF DEFINED(D2F_DEBUG)} + //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' cxy=(%s,%s); pan=(%s,%s)-(%s,%s)', [cx, cy, px0, py0, px1, py1]); + {$ENDIF} // inside? if firstCell and (x0 >= px0) and (y0 >= py0) and (x0 <= px1) and (y0 <= py1) then begin @@ -2149,23 +2138,25 @@ begin ey := ay0; result := px.mObj; mInQuery := false; + {$IF DEFINED(D2F_DEBUG)} + if assigned(dbgRayTraceTileHitCB) then e_LogWriteln(' INSIDE!'); + {$ENDIF} exit; end; // do line-vs-aabb test - sweepw.setClip(px0, py0, px1, py1); - if sweepw.setup(x0, y0, x1, y1) then + if lineAABBIntersects(x0, y0, x1, y1, px0, py0, px1-px0+1, py1-py0+1, hx, hy) then begin // hit detected - sweepw.getPrevXY(hx, hy); distSq := distanceSq(x0, y0, hx, hy); + {$IF DEFINED(D2F_DEBUG)} + //if assigned(dbgRayTraceTileHitCB) then e_LogWritefln(' hit=(%s,%s); distSq=%s; lastDistSq=%s', [hx, hy, distSq, lastDistSq]); + {$ENDIF} 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; diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas index 6d52559..b6724a9 100644 --- a/src/game/g_holmes.pas +++ b/src/game/g_holmes.pas @@ -967,6 +967,8 @@ procedure plrDebugDraw (); procedure hilightCell1 (cx, cy: Integer); begin //e_WriteLog(Format('h1: (%d,%d)', [cx, cy]), MSG_NOTIFY); + cx := cx and (not (monsGrid.tileSize-1)); + cy := cy and (not (monsGrid.tileSize-1)); fillRect(cx, cy, monsGrid.tileSize, monsGrid.tileSize, 255, 255, 0, 92); end; @@ -1037,7 +1039,7 @@ procedure plrDebugDraw (); mon.getMapBox(mx, my, mw, mh); drawLine(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, 255, 0, 0, 255); {$IF DEFINED(D2F_DEBUG)} - //mapGrid.dbgRayTraceTileHitCB := hilightCell1; + mapGrid.dbgRayTraceTileHitCB := hilightCell1; {$ENDIF} if (g_Map_traceToNearestWall(mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, @ex, @ey) <> nil) then //if (mapGrid.traceRay(ex, ey, mx+mw div 2, my+mh div 2, emx+emw div 2, emy+emh div 2, hilightWallTrc, (GridTagWall or GridTagDoor)) <> nil) then @@ -1045,7 +1047,7 @@ procedure plrDebugDraw (); drawLine(mx+mw div 2, my+mh div 2, ex, ey, 0, 255, 0, 255); end; {$IF DEFINED(D2F_DEBUG)} - //mapGrid.dbgRayTraceTileHitCB := nil; + mapGrid.dbgRayTraceTileHitCB := nil; {$ENDIF} end; @@ -1205,6 +1207,8 @@ procedure plrDebugDraw (); var mon: TMonster; mx, my, mw, mh: Integer; + //pan: TPanel; + //ex, ey: Integer; begin if (gPlayer1 = nil) then exit; @@ -1241,6 +1245,22 @@ begin //drawGibsBoxes(); + + //pan := g_Map_traceToNearest(16, 608, 16, 8, (GridTagObstacle or GridTagLiquid), @ex, @ey); + (* + {$IF DEFINED(D2F_DEBUG)} + mapGrid.dbgRayTraceTileHitCB := hilightCell1; + {$ENDIF} + pan := mapGrid.traceRay(ex, ey, 16, 608, 16, 8, nil, (GridTagObstacle or GridTagLiquid)); + if (pan <> nil) then writeln('end=(', ex, ',', ey, ')'); + {$IF DEFINED(D2F_DEBUG)} + mapGrid.dbgRayTraceTileHitCB := nil; + {$ENDIF} + + pan := g_Map_PanelAtPoint(16, 608, (GridTagObstacle or GridTagLiquid)); + if (pan <> nil) then writeln('hit!'); + *) + glPopMatrix(); glDisable(GL_SCISSOR_TEST);