# Raycaster显示幻影垂直墙面Raycaster displays phantom perpendicular wall faces

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

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)
-- 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)
-- 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
]
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
EastWest    ->
let (RGB r g b) = wallColor
in  RGB (r `div` 2) (g `div` 2) (b `div` 2)
NorthSouth  -> wallColor
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>
``````

## 1 个回复1

### ===============>>#1 票数：3 已采纳

“幽灵面孔”正在发生，因为正在报告不正确的`HitSide` ：你说面部是在水平移动（ `EastWest` ）上被击中，但实际上是在垂直移动（ `NorthSouth` ）上被击中，反之亦然。

``````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. 移动

``````//perform DDA
while (hit == 0)
{
if (sideDistX < sideDistY)
{
mapX += stepX;
side = 0;
}
else
{
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`它是否移动：所以它是正确的每一个举动，但是当它撞到一堵墙，它报告它会移动的方式为它继续下去。

``````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)
``````

1回复

1回复

1回复

2回复

2回复

1回复

1回复

1回复

1回复

2回复