Drezil/htrace
1
1
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

prepared parsing of meshes

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-11-27 21:14:16 +01:00
parent ff38526158
commit 2068d86e1b
4 changed files with 71 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
raytrace.cabal
View File

@ -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

41
src/Main.hs
View File

@ -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..."

25
src/Scene/Parser.hs
View File

@ -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

34
src/Scene/Types.hs
View File

@ -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