diff --git a/src/Main.hs b/src/Main.hs index 93a6754..051303f 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Scene/Parser.hs b/src/Scene/Parser.hs index 6282204..b140354 100644 --- a/src/Scene/Parser.hs +++ b/src/Scene/Parser.hs @@ -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 diff --git a/src/Scene/Renderer.hs b/src/Scene/Renderer.hs new file mode 100644 index 0000000..66a6231 --- /dev/null +++ b/src/Scene/Renderer.hs @@ -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) + diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index 1ddc5cf..44f4422 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -6,12 +6,15 @@ type Color = V3 Float type Intensity = Float data Camera = Camera - { eye :: V3 Float - , center :: V3 Float - , up :: V3 Float - , fovy :: Float - , width :: Int - , height :: Int + { eye :: V3 Float + , center :: V3 Float + , up :: V3 Float + , fovy :: Float + , width :: Int + , height :: Int + , lowerLeft :: V3 Float + , xDir :: V3 Float + , yDir :: V3 Float } deriving (Show, Eq)