camera works correctly, picture upside down
This commit is contained in:
parent
494c03f988
commit
1ee771cf98
59
src/Main.hs
59
src/Main.hs
@ -1,20 +1,16 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Main where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Arrow
|
||||
import Codec.Picture.Png
|
||||
import Codec.Picture.Types
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
import Data.Vector hiding ((++),map, foldl, filter, foldl1)
|
||||
import Data.Word (Word8)
|
||||
import Data.Maybe
|
||||
import Linear (V3(..), (^+^), (^*), (^-^), dot, axisAngle, rotate, cross)
|
||||
|
||||
import Data.Attoparsec
|
||||
|
||||
import Scene.Parser
|
||||
import Scene.Renderer
|
||||
import Scene.Types
|
||||
|
||||
import Debug.Trace
|
||||
@ -75,59 +71,6 @@ validateAndParseScene f = do
|
||||
, sceneObjects = objects
|
||||
}
|
||||
|
||||
render :: Int -> Int -> Scene -> Int -> PixelRGB8
|
||||
render w h s index = case pcolls of
|
||||
[] -> PixelRGB8 (ci br) (ci bg) (ci bb) --no collision -> Background
|
||||
_ -> PixelRGB8 (ci ar) (ci ag) (ci ab) --collission -> git color
|
||||
where
|
||||
(V3 ar ag ab) = materialAmbience $ getMaterial coll
|
||||
(Background (V3 br bg bb)) = sceneBackground s
|
||||
pcolls = map fromJust $ filter isJust $ (intersect ray) <$> (sceneObjects s)
|
||||
(Collision pos _ coll) = foldl1 min pcolls
|
||||
ray = Ray (eye cam) $ rotCam x y w h (center cam) (up cam) (fovy cam)
|
||||
cam = sceneCamera s
|
||||
y = fromIntegral $ index `mod` w
|
||||
x = fromIntegral $ index `div` w
|
||||
ci = floor . (*255)
|
||||
|
||||
rotCam :: Float -> Float -> Int -> Int -> V3 Float -> V3 Float -> Float -> V3 Float
|
||||
rotCam x y w h dir up fovy = rotxy
|
||||
where
|
||||
rotxy = rotateDegAx (rad $ fovy*dy) (cross up roty) roty
|
||||
roty = rotateDegAx (rad $ fovy*dx) up dir
|
||||
dx = (x - (fromIntegral w) / 2)/(fromIntegral w)
|
||||
dy = (y - (fromIntegral h) / 2)/(fromIntegral h)
|
||||
rad = (*pi).(/180)
|
||||
|
||||
rotateDegAx :: Float -> V3 Float -> V3 Float -> V3 Float
|
||||
rotateDegAx phi axis = rotate q
|
||||
where
|
||||
q = axisAngle axis phi
|
||||
|
||||
data Ray = Ray (V3 Float) (V3 Float)
|
||||
|
||||
data Collision = Collision (V3 Float) Float Collidable
|
||||
deriving (Eq)
|
||||
|
||||
instance Ord Collision where
|
||||
compare (Collision _ a _) (Collision _ b _) = compare a b
|
||||
|
||||
intersect :: Ray -> Collidable -> Maybe Collision
|
||||
intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
|
||||
Just (Collision (ro ^+^ (rd ^* int)) int s)
|
||||
else
|
||||
Nothing
|
||||
where
|
||||
a = dot rd rd
|
||||
b = 2 * dot rd oc
|
||||
c = dot oc oc - sr*sr
|
||||
d = b * b - 4 * a * c
|
||||
oc = ro ^-^ sc
|
||||
int = case ints of
|
||||
[] -> 0
|
||||
a -> foldl1 min a
|
||||
ints = filter (uncurry (&&).(&&&) (>0.00001) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)]
|
||||
intersect _ _ = undefined
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
||||
@ -1,12 +1,12 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Scene.Parser where
|
||||
module Scene.Parser (parseScene) where
|
||||
|
||||
import Control.Applicative
|
||||
import Data.Attoparsec.ByteString.Char8
|
||||
import Data.Functor
|
||||
import Data.ByteString as B
|
||||
import Data.ByteString.Char8 as B8
|
||||
import Linear.V3
|
||||
import Linear
|
||||
|
||||
import Scene.Types
|
||||
|
||||
@ -89,6 +89,17 @@ parseCamera = do
|
||||
skipSpace
|
||||
height' <- decimal
|
||||
endOfLine
|
||||
let xDir' = (normalize $ cross (center' ^-^ eye') up') ^* (im_width / w)
|
||||
yDir' = (normalize $ cross xDir' view) ^* (im_height / h)
|
||||
lowerLeft' = center' ^-^ (0.5 * w *^ xDir')
|
||||
^-^ (0.5 * h *^ yDir')
|
||||
im_height = 2*dist* tan (0.5*(frtr fovy')/180*pi)
|
||||
im_width = w/h * im_height
|
||||
view = (center' ^-^ eye')
|
||||
dist = norm view
|
||||
w = fromIntegral width'
|
||||
h = fromIntegral height'
|
||||
frtr = fromRational . toRational
|
||||
return $ OpC $ Camera
|
||||
{ eye = eye'
|
||||
, center = center'
|
||||
@ -96,7 +107,12 @@ parseCamera = do
|
||||
, fovy = (fromRational . toRational) fovy'
|
||||
, width = width'
|
||||
, height = height'
|
||||
, lowerLeft = lowerLeft'
|
||||
, xDir = xDir'
|
||||
, yDir = yDir'
|
||||
}
|
||||
where
|
||||
|
||||
|
||||
parsePlane :: Parser ObjectParser
|
||||
parsePlane = do
|
||||
|
||||
78
src/Scene/Renderer.hs
Normal file
78
src/Scene/Renderer.hs
Normal file
@ -0,0 +1,78 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Scene.Renderer (render) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Arrow
|
||||
import Codec.Picture.Png
|
||||
import Codec.Picture.Types
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as B8
|
||||
import Data.Vector hiding ((++),map, foldl, filter, foldl1)
|
||||
import Data.Word (Word8)
|
||||
import Data.Maybe
|
||||
import Linear
|
||||
|
||||
import Scene.Parser
|
||||
import Scene.Types
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
data Ray = Ray (V3 Float) (V3 Float)
|
||||
|
||||
data Collision = Collision (V3 Float) Float Collidable
|
||||
deriving (Eq)
|
||||
|
||||
instance Ord Collision where
|
||||
compare (Collision _ a _) (Collision _ b _) = compare a b
|
||||
|
||||
render :: Int -> Int -> Scene -> Int -> PixelRGB8
|
||||
render w h s index = case pcolls of
|
||||
[] -> PixelRGB8 (ci br) (ci bg) (ci bb) --no collision -> Background
|
||||
_ -> PixelRGB8 (ci ar) (ci ag) (ci ab) --collission -> git color
|
||||
where
|
||||
(V3 ar ag ab) = materialAmbience $ getMaterial coll
|
||||
(Background (V3 br bg bb)) = sceneBackground s
|
||||
pcolls = map fromJust $ filter isJust $ (intersect ray) <$> (sceneObjects s)
|
||||
(Collision pos _ coll) = foldl1 min pcolls
|
||||
ray = camRay x y (sceneCamera s) --Ray (eye cam) $ rotCam x y w h (center cam ^-^ eye cam) (up cam) (fovy cam)
|
||||
cam = sceneCamera s
|
||||
y = fromIntegral $ index `mod` w
|
||||
x = fromIntegral $ index `div` w
|
||||
ci = floor . (*255)
|
||||
|
||||
camRay :: Float -> Float -> Camera -> Ray
|
||||
camRay x y c = Ray (eye c) (lowerLeft c ^+^ x *^ xDir c ^+^ y *^ yDir c ^-^ eye c)
|
||||
|
||||
rotateDegAx :: Float -> V3 Float -> V3 Float -> V3 Float
|
||||
rotateDegAx phi axis = rotate q
|
||||
where
|
||||
q = axisAngle axis phi
|
||||
|
||||
intersect :: Ray -> Collidable -> Maybe Collision
|
||||
intersect (Ray ro rd) s@(S (Sphere sc sr _)) = if (d > 0 && int > 0) then
|
||||
Just (Collision (ro ^+^ (rd ^* int)) int s)
|
||||
else
|
||||
Nothing
|
||||
where
|
||||
a = dot rd rd
|
||||
b = 2 * dot rd oc
|
||||
c = dot oc oc - sr*sr
|
||||
d = b * b - 4 * a * c
|
||||
oc = ro ^-^ sc
|
||||
int = case ints of
|
||||
[] -> 0
|
||||
a -> foldl1 min a
|
||||
ints = filter (uncurry (&&).(&&&) (>0.00001) (not.isNaN)) [(-b-(sqrt d))/(2*a),(-b+(sqrt d))/(2*a)]
|
||||
intersect _ _ = undefined
|
||||
|
||||
|
||||
-- deprecated - wrong calculation of rays.
|
||||
rotCam :: Float -> Float -> Int -> Int -> V3 Float -> V3 Float -> Float -> V3 Float
|
||||
rotCam x y w h dir up fovy = rotxy
|
||||
where
|
||||
rotxy = rotateDegAx (rad $ fovy*dy) (cross up roty) roty
|
||||
roty = rotateDegAx (rad $ fovy*dx*(-1)) up dir
|
||||
dx = (x - (fromIntegral w) / 2)/(fromIntegral w)
|
||||
dy = (y - (fromIntegral h) / 2)/(fromIntegral h)
|
||||
rad = (*pi).(/180)
|
||||
|
||||
@ -12,6 +12,9 @@ data Camera = Camera
|
||||
, fovy :: Float
|
||||
, width :: Int
|
||||
, height :: Int
|
||||
, lowerLeft :: V3 Float
|
||||
, xDir :: V3 Float
|
||||
, yDir :: V3 Float
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user