HRay-1.2.2: HRayParser.y
{
{-
module HRayParser, which contains a parser which allows to use files containing scene descriptions
intended for usage with the other modules in the HRay package
author: Kenneth Hoste, 2004-2005
part of a masters thesis at the University of Ghent, Belgium
-}
module HRayParser (RenderDescr(RenderDescr), readDescr) where
import HRayEngine (Scene(Scene), Texture(Texture), Diff(Solid,Perlin), TexturedObject,
Light(AmbientLight, PointLight), Camera(Camera))
import HRayPerlin (perlinSolid, perlinSemiTurbulence,perlinTurbulence,perlinFire,perlinPlasma,perlinMarble,
perlinMarbleBase,perlinWood)
import HRayMath (Dimension, Resolution, Object(Sphere,Plane,Meta), MetaPoint(MetaPoint))
import Char (isSpace, isAlpha, isDigit)
}
%name parseScene
%tokentype { Token }
%token
int { TokenInt $$ }
double { TokenDouble $$ }
camera { TokenCamera }
background { TokenBackground }
diff { TokenDiff }
solid { TokenSolid }
perlinSolid { TokenPerlinSolid }
perlinSemiTurb { TokenPerlinSemiTurb }
perlinTurb { TokenPerlinTurb }
perlinFire { TokenPerlinFire }
perlinPlasma { TokenPerlinPlasma }
perlinMarble { TokenPerlinMarble }
perlinMarbleBase { TokenPerlinMarbleBase }
perlinWood { TokenPerlinWood }
perlin { TokenPerlin }
texture { TokenTexture }
sphere { TokenSphere }
plane { TokenPlane }
meta { TokenMeta }
object { TokenTexturedObject }
objects { TokenObjects }
pointLight { TokenPointLight }
ambientLight { TokenAmbientLight }
lights { TokenLights }
scene { TokenScene }
resolution { TokenResolution }
renderDescr { TokenRenderDescr }
'{' { TokenOpenAcc }
'}' { TokenCloseAcc }
'(' { TokenOpenBrack }
')' { TokenCloseBrack }
'[' { TokenOpenHook }
']' { TokenCloseHook }
',' { TokenComma }
%%
RenderDescr : renderDescr Resolution int '[' Scene ']' { RenderDescr $2 $3 $5}
Resolution : '(' resolution '(' int ',' int ')' ')' { ($4,$6) }
Scene : scene '{' Camera '}' '{' Background '}'
'{' objects Objects '}' '{' lights Lights '}' { Scene $3 $6 $10 $14 }
Camera : camera '(' double ',' double ',' double ')'
'(' int ',' int ')' { Camera ($3,$5,$7) ($10,$12) }
Background : background '(' double ',' double ',' double ')' { ($3,$5,$7) }
Object : sphere double '(' double ',' double ',' double ')' { Sphere $2 ($4,$6,$8) }
| plane '(' double ',' double ',' double ',' double ')' { Plane ($3,$5,$7,$9) }
| meta MetaPoints double { Meta $2 $3 }
MetaPoint : '(' '(' double ',' double ',' double ')' ',' double ')' { MetaPoint ($3,$5,$7) $10 }
MetaPoints : {- empty -} { [] }
| MetaPoints MetaPoint { $2 : $1 }
NoiseF : perlinSolid '(' double ',' double ',' double ')' double { perlinSolid ($3,$5,$7) $9 }
| perlinSemiTurb '(' double ',' double ',' double ')' int double { perlinSemiTurbulence ($3,$5,$7) $9 $10 }
| perlinTurb '(' double ',' double ',' double ')' int double { perlinTurbulence ($3,$5,$7) $9 $10 }
| perlinFire '(' double ',' double ',' double ')'
'(' double ',' double ',' double ')' int double { perlinFire ($3,$5,$7) ($10,$12,$14)
$16 $17 }
| perlinPlasma double { perlinPlasma $2 }
| perlinMarble '(' double ',' double ',' double ')' int double
'(' double ',' double ',' double ')' double { perlinMarble ($3,$5,$7) $9 $10
($12,$14,$16) $18 }
| perlinMarbleBase '(' double ',' double ',' double ')'
'(' double ',' double ',' double ')' int double
'(' double ',' double ',' double ')' double { perlinMarbleBase ($3,$5,$7)
($10,$12,$14)
$16 $17
($19,$21,$23) $25 }
| perlinWood '(' double ',' double ',' double ')' int double
double double { perlinWood ($3,$5,$7) $9 $10 $11 $12 }
Diff : solid '(' double ',' double ',' double ')' { Solid ($3,$5,$7) }
| perlin '(' NoiseF ')' { Perlin $3 }
Texture : '(' texture '(' diff Diff ')' double int double double')' { Texture $5 $7 $8 $9 $10 }
TexturedObject : '(' object '(' Object ')' Texture ')' { ($4,$6) }
Objects : {- empty -} { [] }
| Objects TexturedObject { $2 : $1 }
Light : '(' pointLight '(' double ',' double ',' double ')'
'(' double ',' double ',' double ')' ')' { PointLight ($4,$6,$8) ($11,$13,$15) }
| '(' ambientLight '(' double ',' double ',' double ')' ')' { AmbientLight ($4,$6,$8) }
Lights : {- empty -} { [] }
| Lights Light { $2 : $1 }
{
-- representation of a full description of scene which should be rendered
data RenderDescr = RenderDescr Resolution Int Scene
readDescr :: String -> RenderDescr
readDescr = parseScene.lexer
happyError :: [Token] -> a
happyError _ = error "Parse error ! ! !"
data Token
= TokenInt Int
| TokenDouble Double
| TokenCamera
| TokenBackground
| TokenDiff
| TokenSolid
| TokenPerlinSolid
| TokenPerlinSemiTurb
| TokenPerlinTurb
| TokenPerlinFire
| TokenPerlinPlasma
| TokenPerlinMarble
| TokenPerlinMarbleBase
| TokenPerlinWood
| TokenPerlin
| TokenTexture
| TokenSphere
| TokenPlane
| TokenMeta
| TokenObjType
| TokenTexturedObject
| TokenObjects
| TokenPointLight
| TokenAmbientLight
| TokenLight
| TokenLights
| TokenScene
| TokenResolution
| TokenRenderDescr
| TokenOpenAcc
| TokenCloseAcc
| TokenOpenBrack
| TokenCloseBrack
| TokenOpenHook
| TokenCloseHook
| TokenComma
lexer :: String -> [Token]
lexer [] = []
lexer (c:cs)
| isSpace c = lexer cs
| isAlpha c = lexVar (c:cs)
| isDigit c = lexNum (c:cs) 1
lexer ('{':cs) = TokenOpenAcc : lexer cs
lexer ('}':cs) = TokenCloseAcc : lexer cs
lexer ('(':cs) = TokenOpenBrack : lexer cs
lexer (')':cs) = TokenCloseBrack : lexer cs
lexer ('[':cs) = TokenOpenHook : lexer cs
lexer (']':cs) = TokenCloseHook : lexer cs
lexer (',':cs) = TokenComma : lexer cs
lexer ('-':cs) = lexNum cs (-1)
lexNum cs mul
| (r == '.') = TokenDouble (mul * (read (num++[r]++num2) :: Double)) : lexer rest2
| otherwise = TokenInt (round (mul * (read num))) : lexer (r:rest)
where (num,(r:rest)) = span isDigit cs
(num2,rest2) = span isDigit rest
lexVar cs =
case span isAlpha cs of
("camera",rest) -> TokenCamera : lexer rest
("background",rest) -> TokenBackground : lexer rest
("diff",rest) -> TokenDiff : lexer rest
("solid",rest) -> TokenSolid : lexer rest
("perlinSolid",rest) -> TokenPerlinSolid : lexer rest
("perlinSemiTurb",rest) -> TokenPerlinSemiTurb : lexer rest
("perlinTurb",rest) -> TokenPerlinTurb : lexer rest
("perlinFire",rest) -> TokenPerlinFire : lexer rest
("perlinPlasma",rest) -> TokenPerlinPlasma : lexer rest
("perlinMarble",rest) -> TokenPerlinMarble : lexer rest
("perlinMarbleBase",rest) -> TokenPerlinMarbleBase : lexer rest
("perlinWood",rest) -> TokenPerlinWood : lexer rest
("perlin",rest) -> TokenPerlin : lexer rest
("texture",rest) -> TokenTexture : lexer rest
("sphere",rest) -> TokenSphere : lexer rest
("plane",rest) -> TokenPlane : lexer rest
("meta",rest) -> TokenMeta : lexer rest
("object",rest) -> TokenTexturedObject : lexer rest
("objects",rest) -> TokenObjects : lexer rest
("pointLight",rest) -> TokenPointLight : lexer rest
("ambientLight",rest) -> TokenAmbientLight : lexer rest
("light",rest) -> TokenLight : lexer rest
("lights",rest) -> TokenLights : lexer rest
("scene",rest) -> TokenScene : lexer rest
("resolution",rest) -> TokenResolution : lexer rest
("renderDescr",rest) -> TokenRenderDescr : lexer rest
}