From 7a0f9382012f7eb61664c5b3d98c0d85198fc09a Mon Sep 17 00:00:00 2001 From: Stefan Dresselhaus Date: Wed, 22 Oct 2014 00:29:57 +0200 Subject: [PATCH] finished sce-parser sans meshes --- .gitignore | 1 + scenes/test.sce | 24 ++++++++ src/Main.hs | 10 +++- src/Scene/Parser.hs | 133 ++++++++++++++++++++++++++++++++++++++++---- src/Scene/Types.hs | 61 +++++++++++++++----- 5 files changed, 203 insertions(+), 26 deletions(-) create mode 100644 scenes/test.sce diff --git a/.gitignore b/.gitignore index 05d4d64..bb66e00 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ .cabal-sandbox/ cabal.sandbox.config dist/ +*.swp diff --git a/scenes/test.sce b/scenes/test.sce new file mode 100644 index 0000000..4a70eef --- /dev/null +++ b/scenes/test.sce @@ -0,0 +1,24 @@ +# camera: eye, center, up, fovy, width, height +camera 1 3 8 1 1 0 0 1 0 45 500 500 + +# recursion depth +depth 5 + +# background color +background 0 0 0 + +# global ambient light +ambience 0.2 0.2 0.2 + +# light: position and color +light 0 50 0 0.3 0.3 0.3 +light 50 50 50 0.3 0.3 0.3 +light -50 50 50 0.3 0.3 0.3 + +# spheres: center, radius, material +sphere 0.0 1.0 0.0 1.0 1.0 0.0 0.0 1.0 0.0 0.0 1.0 1.0 1.0 100.0 0.2 +sphere -1.0 0.5 2.0 0.5 0.0 1.0 0.0 0.0 1.0 0.0 1.0 1.0 1.0 200.0 0.2 +sphere 3.0 2.0 1.5 2.0 0.0 0.0 1.0 0.0 0.0 1.0 1.0 1.0 1.0 50.0 0.2 + +# planes: center, normal, material +plane 0 0 0 0 1 0 0.2 0.2 0.2 0.2 0.2 0.2 0.0 0.0 0.0 100.0 0.1 diff --git a/src/Main.hs b/src/Main.hs index 5db68a7..f25020b 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,15 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where +import Control.Applicative +import Data.ByteString as B +import Data.ByteString.Char8 as B8 + +import Data.Attoparsec + import Scene.Parser main :: IO () main = do - putStrLn "foo" + f <- B.readFile "scenes/test.sce" + print $ parseScene f diff --git a/src/Scene/Parser.hs b/src/Scene/Parser.hs index 9766b93..6282204 100644 --- a/src/Scene/Parser.hs +++ b/src/Scene/Parser.hs @@ -1,23 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} module Scene.Parser where -import Data.Attoparsec +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 Scene.Types +import Debug.Trace + partitionEithers :: [Either a b] -> ([a],[b]) partitionEithers e = go e ([],[]) where go (Left a:as) (xs,ys) = go as (a:xs,ys) go (Right b:bs) (xs,ys) = go bs (xs,b:ys) + go [] (xs,ys) = (xs,ys) -parseScene :: FilePath -> IO ([String],[SceneObject]) -parseScene f = do - s <- B.readFile f - return . partitionEithers $ eitherResult . parse parseObject <$> B8.lines s +preprocess :: ByteString -> ByteString +preprocess = B8.unlines . clean . B8.lines + where + clean :: [ByteString] -> [ByteString] + clean (a:as) = if B8.all isWhitespace a + || B8.head a == '#' + then clean as else a:clean as + clean [] = [] + isWhitespace :: Char -> Bool + isWhitespace ' ' = True + isWhitespace '\t' = True + isWhitespace '\n' = True + isWhitespace '\r' = True + isWhitespace _ = False -parseObject :: Parser SceneObject + +parseScene :: ByteString -> Either String [ObjectParser] +parseScene s = parseOnly (many parseObject) (preprocess s) + +parseObject :: Parser ObjectParser parseObject = do t <- string "camera" <|> string "depth" <|> @@ -29,12 +50,104 @@ parseObject = do string "mesh" case t of "camera" -> parseCamera - _ -> undefined + "depth" -> do + skipSpace + d <- decimal + endOfLine + return $ OpR d + "background" -> do + c <- parseVector + endOfLine + return $ OpB (Background c) + "ambience" -> do + c <- parseVector + endOfLine + return $ OpA (Ambience c) + "light" -> do + p <- parseVector + skipSpace + c <- parseVector + intensity <- double <|> return 0 + i <- return $ if intensity == 0 + then Nothing + else Just (fromRational . toRational $ intensity) + endOfLine + return $ OpL (Light p c i) + "sphere" -> parseSphere + "plane" -> parsePlane + _ -> undefined -parseCamera :: Parser SceneObject +parseCamera :: Parser ObjectParser parseCamera = do - pos <- parseVector + eye' <- parseVector + center' <- parseVector + up' <- parseVector + skipSpace + fovy' <- double + skipSpace + width' <- decimal + skipSpace + height' <- decimal + endOfLine + return $ OpC $ Camera + { eye = eye' + , center = center' + , up = up' + , fovy = (fromRational . toRational) fovy' + , width = width' + , height = height' + } + +parsePlane :: Parser ObjectParser +parsePlane = do + c <- parseVector + n <- parseVector + m <- parseMaterial + endOfLine + return $ OpP Plane + { planeCenter = c + , planeNormal = n + , planeMaterial = m + } + +parseSphere :: Parser ObjectParser +parseSphere = do + p <- parseVector + skipSpace + r <- double + m <- parseMaterial + endOfLine + return $ OpS Sphere + { sphereCenter = p + , sphereRadius = (fromRational . toRational) r + , sphereMaterial = m + } + +parseMaterial :: Parser Material +parseMaterial = do + a <- parseVector + d <- parseVector + s <- parseVector + skipSpace + sh <- double + skipSpace + r <- double + return $ Material + { materialAmbience = a + , materialDiffuse = d + , materialSpec = s + , materialShinyness = (fromRational . toRational) sh + , materialReflection = (fromRational . toRational) r + } parseVector :: Parser (V3 Float) parseVector = do - undefined + skipSpace + a <- double + skipSpace + b <- double + skipSpace + c <- double + return $ V3 (f a) (f b) (f c) + where + f = fromRational . toRational --convert Double to Float diff --git a/src/Scene/Types.hs b/src/Scene/Types.hs index 54b7c44..b19bff5 100644 --- a/src/Scene/Types.hs +++ b/src/Scene/Types.hs @@ -6,50 +6,81 @@ type Color = V3 Float type Intensity = Float data Camera = Camera - { eye :: V3 Float + { eye :: V3 Float , center :: V3 Float - , up :: V3 Float - , fovy :: Float - , width :: Int + , up :: V3 Float + , fovy :: Float + , width :: Int , height :: Int } + deriving (Show, Eq) type RecursionDepth = Int data Background = Background Color + deriving (Show, Eq) data Ambience = Ambience Color + deriving (Show, Eq) data Light = Light (V3 Float) Color (Maybe Intensity) + deriving (Show, Eq) data Material = Material - { materialAmbience :: V3 Float - , materialDiffuse :: V3 Float - , materialSpec :: V3 Float - , materialShinyness :: Int + { materialAmbience :: V3 Float + , materialDiffuse :: V3 Float + , materialSpec :: V3 Float + , materialShinyness :: Float , materialReflection :: Float } + deriving (Show, Eq) data Sphere = Sphere - { sphereCenter :: V3 Float - , sphereRadius :: Float + { sphereCenter :: V3 Float + , sphereRadius :: Float , sphereMaterial :: Material } + deriving (Show, Eq) data Plane = Plane - { planeCenter :: V3 Float - , planeNormal :: V3 Float + { planeCenter :: V3 Float + , planeNormal :: V3 Float , planeMaterial :: Material } + deriving (Show, Eq) data Shading = Flat | Phong + deriving (Show, Eq) data Mesh = Mesh { meshFilename :: String - , meshShading :: Shading - , material :: Material + , meshShading :: Shading + , material :: Material } + deriving (Show, Eq) -data SceneObject = S Sphere | P Plane | M Mesh | C Camera | L Light | +data ObjectParser = OpS Sphere + | OpP Plane + | OpM Mesh + | OpC Camera + | OpL Light + | OpR RecursionDepth + | OpA Ambience + | OpB Background + deriving (Show, Eq) +data Collidable = S Sphere + | P Plane + | M Mesh + deriving (Show, Eq) + +data Scene = Scene + { ambientLight :: Ambience + , sceneCamera :: Camera + , sceneLights :: [Light] + , sceneBackground :: Background + , sceneRecursions :: RecursionDepth + , sceneObjects :: [Collidable] + } + deriving (Show, Eq)