Raycaster 显示虚拟垂直墙面

Raycaster displays phantom perpendicular wall faces

输出如下所示:

你应该只看到一面平坦连续的红墙,一面是蓝墙,另一面是绿墙,另一面是黄墙(看地图的定义,testMapTiles,它只是一张带有四面墙)。然而,有这些不同高度的幻影墙面,它们垂直于真实的墙壁。为什么?

请注意,白色 "gaps" 实际上并不是间隙:它试图绘制一堵高度为 Infinity 的墙(距离为 0)。如果你专门考虑它(这个版本的代码没有)并且只是将它限制在屏幕高度,那么你只会在那里看到一堵非常高的墙。

源代码如下。很简单 Haskell,使用 Haste to compile to JavaScript and render to canvas. It is based on the C++ code from this tutorial,但请注意,我用 tileXtileY 替换了 mapXmapY,而且我没有主循环中 posdirray 前缀。与 C++ 代码的任何差异都可能是破坏一切的原因,但在多次仔细研究这段代码后我似乎找不到任何差异。

有什么帮助吗?

import Data.Array.IArray
import Control.Arrow (first, second)

import Control.Monad (forM_)

import Haste
import Haste.Graphics.Canvas

data MapTile = Empty | RedWall | BlueWall | GreenWall | YellowWall deriving (Eq)

type TilemapArray = Array (Int, Int) MapTile

emptyTilemapArray :: (Int, Int) -> TilemapArray
emptyTilemapArray dim@(w, h) = listArray ((1, 1), dim) $ replicate (w * h) Empty

testMapTiles :: TilemapArray
testMapTiles =
    let arr = emptyTilemapArray (16, 16)
        myBounds@((xB, yB), (w, h)) = bounds arr
    in  listArray myBounds $ flip map (indices arr) (\(x, y) ->
            if x == xB then RedWall
            else if y == yB then BlueWall
            else if x == w then GreenWall
            else if y == h then YellowWall
            else Empty)

type Vec2 a = (a, a)
type DblVec2 = Vec2 Double
type IntVec2 = Vec2 Int

add :: (Num a) => Vec2 a -> Vec2 a -> Vec2 a
add (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)

mul :: (Num a) => Vec2 a -> a -> Vec2 a
mul (x, y) factor = (x * factor, y * factor)

rot :: (Floating a) => Vec2 a -> a -> Vec2 a
rot (x, y) angle =
    (x * (cos angle) - y * (sin angle), x * (sin angle) + y * (cos angle))

dbl :: Int -> Double
dbl = fromIntegral

-- fractional part of a float
-- `truncate` matches behaviour of C++'s int()
frac :: Double -> Double
frac d = d - dbl (truncate d)

-- get whole and fractional parts of a float
split :: Double -> (Int, Double)
split d = (truncate d, frac d)

-- stops 'Warning: Defaulting the following constraint(s) to type ‘Integer’'
square :: Double -> Double
square = (^ (2 :: Int))

-- raycasting algorithm based on code here:
-- http://lodev.org/cgtutor/raycasting.html#Untextured_Raycaster_

data HitSide = NorthSouth | EastWest deriving (Show)

-- direction, tile, distance
type HitInfo = (HitSide, IntVec2, Double)

-- pos: start position
-- dir: initial direction
-- plane: camera "plane" (a line, really, perpendicular to the direction)
traceRays :: TilemapArray -> Int -> DblVec2 -> DblVec2 -> DblVec2 -> [HitInfo]
traceRays arr numRays pos dir plane = 
    flip map [0..numRays] $ \x -> 
        let cameraX = 2 * ((dbl x) / (dbl numRays)) - 1
        in  traceRay arr pos $ dir `add` (plane `mul` cameraX)

traceRay :: TilemapArray -> DblVec2 -> DblVec2 -> HitInfo
traceRay arr pos@(posX, posY) dir@(dirX, dirY) =
    -- map tile we're in (whole part of position)
    -- position within map tile (fractional part of position)
    let ((tileX, fracX), (tileY, fracY)) = (split posX, split posY)
        tile = (tileX, tileY)
    -- length of ray from one x or y-side to next x or y-side
        deltaDistX = sqrt $ 1 + (square dirY / square dirX)
        deltaDistY = sqrt $ 1 + (square dirX / square dirY)
        deltaDist  = (deltaDistX, deltaDistY)
    -- direction of step
        stepX = if dirX < 0 then -1 else 1
        stepY = if dirY < 0 then -1 else 1
        step  = (stepX, stepY)
    -- length of ray from current position to next x or y-side
        sideDistX = deltaDistX * if dirX < 0 then fracX else 1 - fracX
        sideDistY = deltaDistY * if dirY < 0 then fracY else 1 - fracY
        sideDist  = (sideDistX, sideDistY)
        (hitSide, wallTile) = traceRayInner arr step deltaDist tile sideDist
    in  (hitSide, wallTile, calculateDistance hitSide pos dir wallTile step)

traceRayInner :: TilemapArray -> IntVec2 -> DblVec2 -> IntVec2 -> DblVec2 -> (HitSide, IntVec2)
traceRayInner arr step@(stepX, stepY) deltaDist@(deltaDistX, deltaDistY) tile sideDist@(sideDistX, sideDistY)
    -- a wall has been hit, report hit direction and coördinates
    | arr ! tile /= Empty   = (hitSide, tile)
    -- advance until a wall is hit
    | otherwise             = case hitSide of
        EastWest ->
            let newSideDist = first (deltaDistX+) sideDist
                newTile     = first (stepX+) tile
            in
                traceRayInner arr step deltaDist newTile newSideDist
        NorthSouth ->
            let newSideDist = second (deltaDistY+) sideDist
                newTile     = second (stepY+) tile
            in
                traceRayInner arr step deltaDist newTile newSideDist
    where
        hitSide = if sideDistX < sideDistY then EastWest else NorthSouth

-- calculate distance projected on camera direction
-- (an oblique distance would give a fisheye effect)
calculateDistance :: HitSide -> DblVec2 -> DblVec2 -> IntVec2 -> IntVec2 -> Double
calculateDistance EastWest (startX, _) (dirX, _) (tileX, _) (stepX, _) =
    ((dbl tileX) - startX + (1 - dbl stepX) / 2) / dirX
calculateDistance NorthSouth (_, startY) (_, dirY) (_, tileY) (_, stepY) =
    ((dbl tileY) - startY + (1 - dbl stepY) / 2) / dirY

-- calculate the height of the vertical line on-screen based on the distance
calculateHeight :: Double -> Double -> Double
calculateHeight screenHeight 0 = screenHeight
calculateHeight screenHeight perpWallDist = screenHeight / perpWallDist

width   :: Double
height  :: Double
(width, height) = (640, 480)

main :: IO ()
main = do
    cvElem <- newElem "canvas" `with` [
            attr "width" =: show width,
            attr "height" =: show height
        ]
    addChild cvElem documentBody
    Just canvas <- getCanvas cvElem
    let pos     = (8, 8)
        dir     = (-1, 0)
        plane   = (0, 0.66)
    renderGame canvas pos dir plane

renderGame :: Canvas -> DblVec2 -> DblVec2 -> DblVec2 -> IO ()
renderGame canvas pos dir plane = do
    let rays    = traceRays testMapTiles (floor width) pos dir plane
    render canvas $ forM_ (zip [0..width - 1] rays) (\(x, (side, tile, dist)) ->
        let lineHeight  = calculateHeight height dist
            wallColor   = case testMapTiles ! tile of
                RedWall     -> RGB 255 0 0
                BlueWall    -> RGB 0 255 0
                GreenWall   -> RGB 0 0 255
                YellowWall  -> RGB 255 255 0
                _           -> RGB 255 255 255
            shadedWallColor = case side of
                EastWest    -> 
                    let (RGB r g b) = wallColor
                    in  RGB (r `div` 2) (g `div` 2) (b `div` 2)
                NorthSouth  -> wallColor
        in  color shadedWallColor $ do
                translate (x, height / 2) $ stroke $ do
                    line (0, -lineHeight / 2) (0, lineHeight / 2))
    -- 25fps
    let fps             = 25
        timeout         = (1000 `div` fps) :: Int
        rots_per_min    = 1
        rots_per_sec    = dbl rots_per_min / 60
        rots_per_frame  = rots_per_sec / dbl fps
        tau             = 2 * pi
        increment       = tau * rots_per_frame 

    setTimeout timeout $ do
       renderGame canvas pos (rot dir $ -increment) (rot plane $ -increment)

HTML 页数:

<!doctype html>
<meta charset=utf-8>
<title>Raycaster</title>

<noscript>If you're seeing this message, either your browser doesn't support JavaScript, or it is disabled for some reason. This game requires JavaScript to play, so you'll need to make sure you're using a browser which supports it, and enable it, to play.</noscript>
<script src=raycast.js></script>

出现 "phantom faces" 是因为报告了不正确的 HitSide:您说的是面部在水平移动中被击中 (EastWest),但实际上是在垂直移动 (NorthSouth),反之亦然。

那为什么它报告的值不正确呢? if sideDistX < sideDistY then EastWest else NorthSouth 看起来很简单,对吧?确实如此。

问题不在于我们如何计算该值。我们在 时计算了该值。距离计算函数需要知道我们移动到墙的方向。然而,我们实际给出的是如果我们继续前进我们将移动的方向(也就是说,如果那个瓷砖不是墙,或者我们出于某种原因要忽略它)。

查看Haskell代码:

traceRayInner arr step@(stepX, stepY) deltaDist@(deltaDistX, deltaDistY) tile sideDist@(sideDistX, sideDistY)
    -- a wall has been hit, report hit direction and coördinates
    | arr ! tile /= Empty   = (hitSide, tile)
    -- advance until a wall is hit
    | otherwise             = case hitSide of
        EastWest ->
            let newSideDist = first (deltaDistX+) sideDist
                newTile     = first (stepX+) tile
            in
                traceRayInner arr step deltaDist newTile newSideDist
        NorthSouth ->
            let newSideDist = second (deltaDistY+) sideDist
                newTile     = second (stepY+) tile
            in
                traceRayInner arr step deltaDist newTile newSideDist
    where
        hitSide = if sideDistX < sideDistY then EastWest else NorthSouth

注意我们按以下顺序做事:

  1. 计算hitSide
  2. 检查是否撞墙,如果是,报告hitSide
  3. 移动

将此与原始 C++ 代码进行比较:

//perform DDA
while (hit == 0)
{
  //jump to next map square, OR in x-direction, OR in y-direction
  if (sideDistX < sideDistY)
  {
    sideDistX += deltaDistX;
    mapX += stepX;
    side = 0;
  }
  else
  {
    sideDistY += deltaDistY;
    mapY += stepY;
    side = 1;
  }
  //Check if ray has hit a wall
  if (worldMap[mapX][mapY] > 0) hit = 1;
}

它以不同的顺序做事:

  1. 检查是否被撞墙,如果是,则报告side(相当于hitSide
  2. 移动计算side

C++ 代码仅在移动时计算 side,然后在撞墙时报告该值。因此,它会报告它为了撞墙而移动的方式。

Haskell 代码计算 side 它是否移动:所以每次移动都是正确的,但是当它撞到墙上时,它会报告它会移动的方式,如果它保持去。

因此,Haskell 代码可以通过重新排序来修复,以便它在 移动 之后检查命中,如果是,则报告 hitSide 该移动的价值。这不是漂亮的代码,但它有效:

traceRayInner arr step@(stepX, stepY) deltaDist@(deltaDistX, deltaDistY) tile sideDist@(sideDistX, sideDistY) =
    let hitSide = if sideDistX < sideDistY then EastWest else NorthSouth
    in  case hitSide of
        EastWest ->
            let newSideDist = first (deltaDistX+) sideDist
                newTile     = first (stepX+) tile
            in  case arr ! newTile of
                -- advance until a wall is hit
                Empty   ->  traceRayInner arr step deltaDist newTile newSideDist
                -- a wall has been hit, report hit direction and coördinates
                _       ->  (hitSide, newTile)
        NorthSouth ->
            let newSideDist = second (deltaDistY+) sideDist
                newTile     = second (stepY+) tile
            in  case arr ! newTile of
                -- advance until a wall is hit
                Empty   ->  traceRayInner arr step deltaDist newTile newSideDist
                -- a wall has been hit, report hit direction and coördinates
                _       ->  (hitSide, newTile)

问题已解决!


旁注:我在纸上执行算法后发现了问题所在。虽然在那种特殊情况下,最后两个 HitSide 值恰好匹配,但很明显它们可能并非在所有情况下都匹配。因此,非常感谢 Freenode 的 #algorithms 上的 Madsy 建议在纸上进行尝试。 :)