prepared parsing of meshes

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

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 :: B8.ByteString -> FilePath -> EitherT String IO Scene
-validateAndParseScene f = do
+validateAndParseScene f p = do
-            obs <- parseScene f
+            obs <- hoistEither $ parseScene f
-            cam <- findCamera obs
+            obs' <- initializeMeshes p obs
-            depth <- findDepth obs
+            cam <- hoistEither $ findCamera obs'
-            amb <- findAmbience obs
+            depth <- hoistEither $ findDepth obs'
-            back <- findBackground obs
+            amb <- hoistEither $ findAmbience obs'
-            lights <- return $ filterLights obs
+            back <- hoistEither $ findBackground obs'
-            objects <- return $ filterObjects 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..."

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
+parseRawMesh :: Parser ObjectParser
-parseMesh = do
+parseRawMesh = do
         name <- takeTill isSpace
         skipSpace
         shading <- string "FLAT" <|> string "PHONG"
         skipSpace
         mat <- parseMaterial
         let shading' = case shading of
-                    "FLAT"  = Flat
+                        "FLAT"  -> Flat
-                    "PHONG" = Phong
+                        "PHONG" -> Phong
-        return $ OpM Mesh
+        return $ OpM UIMesh
-                      { meshFilename = name
+                      { uimeshFilename = name
-                      , meshShading  = shading'
+                      , uimeshShading  = shading'
-                      , material     = mat
+                      , 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

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
+data UIMesh = UIMesh
-            { meshFilename :: String
+            { uimeshFilename :: ByteString
-            , meshShading  :: Shading
+            , uimeshShading  :: Shading
-            , material     :: Material
+            , 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)
             }
-
+            deriving (Show, Eq)
-data MeshObj = MeshObj
-             { meshVertices :: V.Vector (V3 Float)
-             , meshFaces    :: V.Vector (V3 Float)
-             , meshNormals  :: V.Vector (V3 Float)
-             , meshBounds   :: BoundingBox
-             }
 
 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