finished sce-parser sans meshes

.gitignore

@@ -1,3 +1,4 @@
 .cabal-sandbox/
 cabal.sandbox.config
 dist/
+*.swp

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

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

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])
+preprocess :: ByteString -> ByteString
-parseScene f = do
+preprocess = B8.unlines . clean . B8.lines
-            s <- B.readFile f
+            where
-            return . partitionEithers $ eitherResult . parse parseObject <$> B8.lines s
+              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

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
+            , up     :: V3 Float
-            , fovy :: Float
+            , fovy   :: Float
-            , width :: Int
+            , 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
+            { materialAmbience   :: V3 Float
-            , materialDiffuse :: V3 Float
+            , materialDiffuse    :: V3 Float
-            , materialSpec :: V3 Float
+            , materialSpec       :: V3 Float
-            , materialShinyness :: Int
+            , materialShinyness  :: Float
             , materialReflection :: Float
             }
+                deriving (Show, Eq)
             
 
 data Sphere = Sphere
-            { sphereCenter :: V3 Float
+            { sphereCenter   :: V3 Float
-            , sphereRadius :: Float
+            , sphereRadius   :: Float
             , sphereMaterial :: Material
             }
+                deriving (Show, Eq)
 
 data Plane = Plane
-            { planeCenter :: V3 Float
+            { planeCenter   :: V3 Float
-            , planeNormal :: V3 Float
+            , planeNormal   :: V3 Float
             , planeMaterial :: Material
             }
+                deriving (Show, Eq)
 
 data Shading = Flat | Phong
+                deriving (Show, Eq)
 
 data Mesh = Mesh
             { meshFilename :: String
-            , meshShading :: Shading
+            , meshShading  :: Shading
-            , material :: Material
+            , 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)