seperate FOV in vertical and horizontal

This commit is contained in:
nek0 2018-10-28 01:29:45 +02:00
parent 4c5ae86a01
commit 985e64dfae
1 changed files with 9 additions and 6 deletions

View File

@ -34,8 +34,11 @@ step = V2 0 0.5
rotStep :: Double
rotStep = 0.174533
fov :: Double
fov = pi / 2
hfov :: Double
hfov = pi / 1.5
vfov :: Double
vfov = pi / 2
main :: IO ()
main = do
@ -119,8 +122,8 @@ castRay
-> Maybe Double
castRay prot ppos (w, h) (ddw, ddh) =
let iter = V.generate (1000) ((/ 100) . fromIntegral) :: V.Vector Double
collPos a = (ppos + (V2 0 (a * cos (- fov / 2 + ddh * fov / h))
`rotVec` (prot - fov / 2 + ddw * fov / w)))
collPos a = (ppos + (V2 0 (a * cos (- vfov / 2 + ddh * vfov / h))
`rotVec` (prot - hfov / 2 + ddw * hfov / w)))
in V.foldl (\acc a ->
if isNothing acc
then
@ -138,7 +141,7 @@ castRay2
-> (Double, Double)
-> Maybe Double
castRay2 prot ppos@(V2 ux uy) (w, h) (ddw, ddh) =
let v@(V2 vx vy) = V2 0 1 `rotVec` (prot + (- fov / 2 + ddw * fov / w))
let v@(V2 vx vy) = V2 0 1 `rotVec` (prot + (- hfov / 2 + ddw * hfov / w))
stepx = signum vx
stepy = signum vy
tmaxx = (((fromIntegral :: Int -> Double) . floor) ux + stepx - ux) / vx
@ -146,7 +149,7 @@ castRay2 prot ppos@(V2 ux uy) (w, h) (ddw, ddh) =
tdeltax = stepx / vx
tdeltay = stepy / vy
tiles = (ux, uy) : buildTileList (tmaxx, tmaxy) (tdeltax, tdeltay) (stepx, stepy) (ux, uy) ppos
in fmap (/ cos (- fov / 2 + ddh * fov / h)) (getRayColl ppos v tiles)
in fmap (/ cos (- vfov / 2 + ddh * vfov / h)) (getRayColl ppos v tiles)
{-# INLINE castRay2 #-}
getRayColl