diff --git a/raytrace.cabal b/raytrace.cabal index 7f4971d..4e83db5 100644 --- a/raytrace.cabal +++ b/raytrace.cabal @@ -63,7 +63,11 @@ executable raytrace JuicyPixels >= 3.1, parallel >= 3.2, vector >= 0.10, - deepseq >= 1.3 + deepseq >= 1.3, + either >= 4.3, + containers >= 0.2, + mtl >= 2.1, + filepath >= 1.3 -- Directories containing source files. hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs index 25da04b..e8c58e6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,9 +10,13 @@ import Linear (V3(..)) import Data.Word (Word8) import Data.Functor import Data.Maybe +import Data.Traversable import Control.Parallel.Strategies +import Control.Monad.Trans +import Control.Monad.Trans.Either import Control.DeepSeq import System.Environment +import System.FilePath.Posix import Scene.Parser import Scene.Renderer @@ -54,19 +58,20 @@ filterObjects :: [ObjectParser] -> [Collidable] filterObjects [] = [] filterObjects (a:as) = case a of OpS s -> S s:filterObjects as - OpM m -> M m:filterObjects as + OpI m -> M m:filterObjects as OpP p -> P p:filterObjects as _ -> filterObjects as -validateAndParseScene :: B8.ByteString -> Either String Scene -validateAndParseScene f = do - obs <- parseScene f - cam <- findCamera obs - depth <- findDepth obs - amb <- findAmbience obs - back <- findBackground obs - lights <- return $ filterLights obs - objects <- return $ filterObjects obs +validateAndParseScene :: B8.ByteString -> FilePath -> EitherT String IO Scene +validateAndParseScene f p = do + obs <- hoistEither $ parseScene f + obs' <- initializeMeshes p obs + cam <- hoistEither $ findCamera obs' + depth <- hoistEither $ findDepth obs' + amb <- hoistEither $ findAmbience obs' + back <- hoistEither $ findBackground obs' + lights <- return $ filterLights obs' + objects <- return $ filterObjects obs' return $ Scene { ambientLight = amb , sceneCamera = cam @@ -76,6 +81,19 @@ validateAndParseScene f = do , sceneObjects = objects } +initializeMeshes :: FilePath -> [ObjectParser] -> EitherT String IO [ObjectParser] +initializeMeshes p = traverse (initializeMeshes' p) + where + initializeMeshes' :: FilePath -> ObjectParser -> EitherT String IO ObjectParser + initializeMeshes' p (OpM (UIMesh f s m)) = + let filename = p (B8.unpack f) in + do + d <- lift $ B.readFile filename + mesh <- hoistEither $ parseMesh s m d + return mesh + initializeMeshes' _ a = return a + + instance NFData PixelRGB8 where rnf (PixelRGB8 r g b) = r `seq` g `seq` b `seq` () @@ -88,7 +106,8 @@ main = do (a:_) -> do putStrLn $ "reading and parsing "++ show a !f <- B.readFile a - case validateAndParseScene f of + r <- runEitherT $ validateAndParseScene f (dropFileName a) + case r of Left error -> putStrLn $ "Error: " ++ error Right s -> do putStrLn "redering..." diff --git a/src/Scene/Parser.hs b/src/Scene/Parser.hs index c245d80..6927b68 100644 --- a/src/Scene/Parser.hs +++ b/src/Scene/Parser.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Scene.Parser (parseScene) where +module Scene.Parser (parseScene, parseMesh) where import Control.Applicative import Data.Attoparsec.ByteString.Char8 @@ -75,7 +75,7 @@ parseObject = do return $ OpL (Light p c i) "sphere" -> parseSphere "plane" -> parsePlane - "mesh" -> parseMesh + "mesh" -> parseRawMesh _ -> undefined parseCamera :: Parser ObjectParser @@ -167,19 +167,24 @@ parseVector = do where f = fromRational . toRational --convert Double to Float -parseMesh :: Parser ObjectParser -parseMesh = do +parseRawMesh :: Parser ObjectParser +parseRawMesh = do name <- takeTill isSpace skipSpace shading <- string "FLAT" <|> string "PHONG" skipSpace mat <- parseMaterial let shading' = case shading of - "FLAT" = Flat - "PHONG" = Phong - return $ OpM Mesh - { meshFilename = name - , meshShading = shading' - , material = mat + "FLAT" -> Flat + "PHONG" -> Phong + return $ OpM UIMesh + { uimeshFilename = name + , uimeshShading = shading' + , uimaterial = mat } +parseMesh :: Shading -> Material -> ByteString -> Either String ObjectParser +parseMesh s m f = parseOnly (parseMesh' s m) (preprocess f) + +parseMesh' :: Shading -> Material -> Parser ObjectParser +parseMesh' s m = undefined diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index 09c35cf..d27e334 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -1,7 +1,9 @@ module Scene.Types where import Linear (V3) +import Data.IntMap import qualified Data.Vector as V +import Data.ByteString type Color = V3 Float type Intensity = Float @@ -61,29 +63,35 @@ data Plane = Plane data Shading = Flat | Phong deriving (Show, Eq) -data Mesh = Mesh - { meshFilename :: String - , meshShading :: Shading - , material :: Material +data UIMesh = UIMesh + { uimeshFilename :: ByteString + , uimeshShading :: Shading + , uimaterial :: Material } deriving (Show, Eq) +data Mesh = Mesh + { meshShading :: Shading + , meshMaterial :: Material + , meshVertices :: IntMap (V3 Float) + , meshFaces :: IntMap (V3 Int) + , meshNormals :: IntMap (V3 Float) + , meshFaceNormals :: IntMap (V3 Float) + , meshBounds :: BoundingBox + } + deriving (Show, Eq) + data BoundingBox = BoundingBox { boundX :: (Float, Float) , boundY :: (Float, Float) , boundZ :: (Float, Float) } - -data MeshObj = MeshObj - { meshVertices :: V.Vector (V3 Float) - , meshFaces :: V.Vector (V3 Float) - , meshNormals :: V.Vector (V3 Float) - , meshBounds :: BoundingBox - } + deriving (Show, Eq) data ObjectParser = OpS Sphere | OpP Plane - | OpM Mesh + | OpM UIMesh + | OpI Mesh | OpC Camera | OpL Light | OpR RecursionDepth @@ -109,4 +117,4 @@ data Scene = Scene getMaterial :: Collidable -> Material getMaterial (S (Sphere _ _ m)) = m getMaterial (P (Plane _ _ m)) = m -getMaterial (M (Mesh _ _ m)) = m +getMaterial (M (Mesh _ m _ _ _ _ _)) = m