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

finished sce-parser sans meshes

Browse Source
This commit is contained in:
Nicole Dresselhaus 2014-10-22 00:29:57 +02:00
parent 66e7d475d2
commit 7a0f938201
5 changed files with 203 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

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

24
scenes/test.sce Normal file
View File

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

10
src/Main.hs
View File

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

131
src/Scene/Parser.hs
View File

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

35
src/Scene/Types.hs
View File

@ -13,22 +13,27 @@ data Camera = Camera
, 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
, materialShinyness :: Float
, materialReflection :: Float
}
deriving (Show, Eq)
data Sphere = Sphere
@ -36,20 +41,46 @@ data Sphere = Sphere
, sphereRadius :: Float
, sphereMaterial :: Material
}
deriving (Show, Eq)
data Plane = Plane
{ 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
}
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)