lambdacube-engine-0.1.1: Graphics/LambdaCube/Loader/CompositorScript.hs
{-# LANGUAGE NoMonomorphismRestriction #-}
module Graphics.LambdaCube.Loader.CompositorScript (loadCompositor,parseCompositor) where
-- import the the library functions from uulib
import UU.Parsing
import UU.Scanner
import Data.Maybe
import Data.Either
import qualified Data.IntMap as IntMap
-- import our custom made Alex-scanner
import Graphics.LambdaCube.Loader.Generated.CompositorScriptScanner
import Graphics.LambdaCube.Loader.ParserUtil
import Graphics.LambdaCube.Compositor
import Graphics.LambdaCube.Types
import Graphics.LambdaCube.Common
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.PixelFormat
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.GpuProgram
----------------------
-- Boilerplate code --
----------------------
loadCompositor path file = do
txt <- readFile file
parseCompositor file txt
parseCompositor file txt
= let res = parseTokens pCompositorScript (tokenize file txt)
in case res of
Left errs -> do
mapM_ putStrLn errs
return Nothing
Right tree -> return (Just tree)
type TokenParser a = Parser Token a
parseTokens :: TokenParser a -> [Token] -> Either [String] a
parseTokens p tks = if null msgs then final `seq` Right v else Left (map show msgs)
where
steps = parse p tks
msgs = getMsgs steps
(Pair v final) = evalSteps steps
----------------------------------------------------
-- Compositor script top level parser combinators --
----------------------------------------------------
-- * AST definitions
data (Texture t, LinkedGpuProgram lp) => CS_Attr t lp
= CS_compositor (Compositor t lp)
data (Texture t, LinkedGpuProgram lp) => C_Attr t lp
= C_technique (CompositionTechnique t lp)
data (Texture t, LinkedGpuProgram lp) => T_Attr t lp
= T_target (CompositionTargetPass t lp)
| T_targetoutput (CompositionTargetPass t lp)
| T_texture String (Either Int FloatType) (Either Int FloatType) [PixelFormat] Bool
data (Texture t, LinkedGpuProgram lp) => TR_Attr t lp
= TR_input InputMode
| TR_onlyinitial Bool
| TR_visibilitymask Int
| TR_lodbias FloatType
| TR_shadows Bool
| TR_materialscheme String
| TR_pass (CompositionPass t lp)
data P_Attr
= P_material String
| P_input Int String Int
| P_identifier Int
| P_firstrenderqueue Int
| P_lastrenderqueue Int
| P_buffers [String]
| P_colourvalue ColourValue
| P_depthvalue FloatType
| P_stencilvalue Int
| P_check Bool
| P_compfunc CompareFunction
| P_refvalue Int
| P_mask Int
| P_failop StencilOperation
| P_depthfailop StencilOperation
| P_passop StencilOperation
| P_twosided Bool
-- * Compositor parser combinators
pCompositorScript = mkCompositorScript <$> pList pCompositorScriptContent
mkCompositorScript l = [x | CS_compositor x <- l]
pCompositorScriptContent = pCompositor
-- * Compositor
pCompositor = (CS_compositor .) . mkCompositor <$= "compositor" <*> pName <*= "{" <*> pList pCompositorContent <*= "}"
pCompositorContent = pTechnique
mkCompositor name l = Compositor
{ cmpName = name
, cmpTechniques = [x | C_technique x <- l]
, cmpSupportedTechniques = Nothing
}
-- * Technique
pTechnique = C_technique . mkTechnique <$= "technique" <*= "{" <*> pList pTechniqueContent <*= "}"
pTechniqueContent = T_texture <$= "texture" <*> pName <*> pTexWidth <*> pTexHeight <*> pList (pEnum compositorPixelFormatVals) <*> (True <$= "shared" <|> pSucceed False)
<|> pTarget
<|> pTargetOutput
pTexWidth = Left <$> pInt
<|> Right 1 <$= "target_width"
<|> Right <$= "target_width_scaled" <*> pFloat
pTexHeight = Left <$> pInt
<|> Right 1 <$= "target_height"
<|> Right <$= "target_height_scaled" <*> pFloat
mkTechnique l = CompositionTechnique
{ ctTextureDefinitions = [mkTextureDefinition n w h p s | T_texture n w h p s <- l]
, ctTargetPasses = [x | T_target x <- l]
, ctOutputTarget = head [x | T_targetoutput x <- l]
, ctSchemeName = "" -- TODO
}
where
mkTextureDefinition n w h p s = TextureDefinition
{ tdName = n
, tdWidth = listToMaybe $ map fromIntegral $ lefts [w]
, tdHeight = listToMaybe $ map fromIntegral $ lefts [h]
, tdWidthFactor = def 1 $ rights [w]
, tdHeightFactor = def 1 $ rights [h]
, tdFormatList = p
, tdFsaa = False
, tdHwGammaWrite = False
, tdShared = s
, tdTexture = Nothing
}
-- * Target
pTargetOutput = T_targetoutput . (mkTarget "output") <$= "target_output" <*= "{" <*> pList pTargetContent <*= "}"
pTarget = (T_target .) . mkTarget <$= "target" <*> pName <*= "{" <*> pList pTargetContent <*= "}"
pTargetContent = TR_input <$= "input" <*> pEnum inputVals
<|> TR_onlyinitial <$= "only_initial" <*> pOnOff
<|> TR_visibilitymask <$= "visibbility_mask" <*> pInt
<|> TR_lodbias <$= "lod_bias" <*> pFloat
<|> TR_materialscheme <$= "material_scheme" <*> pName
<|> TR_shadows <$= "shadows" <*> pOnOff
<|> pPass
mkTarget n l = CompositionTargetPass
{ ctpInputMode = def IM_NONE [x | TR_input x <- l]
, ctpOutputName = n
, ctpOutput = Nothing
, ctpPasses = [x | TR_pass x <- l]
, ctpOnlyInitial = def False [x | TR_onlyinitial x <- l]
, ctpVisibilityMask = def 4294967295 [fromIntegral x | TR_visibilitymask x <- l]
, ctpLodBias = def 1 [x | TR_lodbias x <- l]
, ctpMaterialScheme = def "" [x | TR_materialscheme x <- l]
, ctpShadowsEnabled = def True [x | TR_shadows x <- l]
}
-- * Pass
pPass = TR_pass . (mkPass PT_RENDERQUAD) <$= "pass" <*= "render_quad" <*= "{" <*> pList pPassRQContent <*= "}"
<|> TR_pass . (mkPass PT_CLEAR) <$= "pass" <*= "clear" <*= "{" <*> pList pPassCContent <*= "}"
<|> TR_pass . (mkPass PT_STENCIL) <$= "pass" <*= "stencil" <*= "{" <*> pList pPassSContent <*= "}"
<|> TR_pass . (mkPass PT_RENDERSCENE) <$= "pass" <*= "render_scene" <*= "{" <*> pList pPassRSContent <*= "}"
pIdentifier = P_identifier <$= "identifier" <*> pInt
pPassRQContent = pIdentifier
<|> P_material <$= "material" <*> pName
<|> P_input <$= "input" <*> pInt <*> pName <*> (pInt <|> pSucceed 0)
pPassRSContent = pIdentifier
<|> P_firstrenderqueue <$= "first_render_queue" <*> pInt
<|> P_lastrenderqueue <$= "last_render_queue" <*> pInt
pPassCContent = pIdentifier
<|> P_buffers <$= "buffers" <*> pList (pKey "colour" <|> pKey "depth" <|> pKey "stencil")
<|> P_colourvalue <$= "colour_value" <*> pRGBA
<|> P_depthvalue <$= "depth_value" <*> pFloat
<|> P_stencilvalue <$= "stencil_value" <*> pInt
pPassSContent = pIdentifier
<|> P_check <$= "check" <*> pOnOff
<|> P_compfunc <$= "comp_func" <*> pEnum cmpfuncVals
<|> P_refvalue <$= "ref_value" <*> pInt
<|> P_mask <$= "mask" <*> pInt
<|> P_failop <$= "fail_op" <*> pEnum stencilopVals
<|> P_depthfailop <$= "depth_fail_op" <*> pEnum stencilopVals
<|> P_passop <$= "pass_op" <*> pEnum stencilopVals
<|> P_twosided <$= "two_sided" <*> pOnOff
mkPass t l = CompositionPass
{ cpType = t
, cpIdentifier = def 0 [fromIntegral x | P_identifier x <- l]
, cpMaterialName = def "" [x | P_material x <- l]
, cpMaterial = Nothing
, cpFirstRenderQueue = def 5 [x | P_firstrenderqueue x <- l]
, cpLastRenderQueue = def 95 [x | P_lastrenderqueue x <- l]
, cpClearBuffers = def (True,True,False) [(elem "colour" x, elem "depth" x, elem "stencil" x) | P_buffers x <- l]
, cpClearColour = def (0,0,0,0) [x | P_colourvalue x <- l]
, cpClearDepth = def 0 [x | P_depthvalue x <- l]
, cpClearStencil = def 0 [fromIntegral x | P_stencilvalue x <- l]
, cpInputs = IntMap.fromList [(i,InputTex n mi) | P_input i n mi <- l]
, cpStencilCheck = def False [x | P_check x <- l]
, cpStencilFunc = def CMPF_LESS [x | P_compfunc x <- l]
, cpStencilRefValue = def 0 [fromIntegral x | P_refvalue x <- l]
, cpStencilMask = def 0xFFFFFFFF [fromIntegral x | P_mask x <- l]
, cpStencilFailOp = def SOP_KEEP [x | P_failop x <- l]
, cpStencilDepthFailOp = def SOP_KEEP [x | P_depthfailop x <- l]
, cpStencilPassOp = def SOP_KEEP [x | P_passop x <- l]
, cpStencilTwoSidedOperation = def False [x | P_twosided x <- l]
-- , cpQuadCornerModified :: Bool -- ^ true if quad should not cover whole screen
-- , cpQuadLeft :: FloatType -- ^ quad positions in normalised coordinates [-1;1]x[-1;1] (in case of PT_RENDERQUAD)
-- , cpQuadTop :: FloatType
-- , cpQuadRight :: FloatType
-- , cpQuadBottom :: FloatType
-- , cpQuadFarCorners :: Bool
-- , cpQuadFarCornersViewSpace :: Bool
}
{-
mkPassS l =
(def Nothing [Just x | P_identifier x <- l],
CompositionStencilPass
{ stCheck = def False [x | P_check x <- l]
, stCompFunc = def CMPF_LESS [x | P_compfunc x <- l]
, stRefValue = def 0 [x | P_refvalue x <- l]
, stMask = def 4294967295 [x | P_mask x <- l]
, stFailOp = def SOP_KEEP [x | P_failop x <- l]
, stDepthFailOp = def SOP_KEEP [x | P_depthfailop x <- l]
, stPassOp = def SOP_KEEP [x | P_passop x <- l]
, stTwoSided = def False [x | P_twosided x <- l]
})
mkPassRQ l =
(def Nothing [Just x | P_identifier x <- l],
CompositionRenderQuadPass
{ rqMaterial = def "" [x | P_material x <- l]
, rqInput = def (0,"",0) [(a,b,c) | P_input a b c <- l]
})
mkPassC l =
(def Nothing [Just x | P_identifier x <- l],
CompositionClearPass
{ clBuffers = def (True,True,False) [(elem "colour" x, elem "depth" x, elem "stencil" x) | P_buffers x <- l]
, clColourValue = def (0,0,0,0) [x | P_colourvalue x <- l]
, clDepthValue = def 0 [x | P_depthvalue x <- l]
, clStencilValue = def 0 [x | P_stencilvalue x <- l]
})
mkPassRS l =
(def Nothing [Just x | P_identifier x <- l],
CompositionRenderScenePass
{ rsFirstRenderQueue = def 5 [x | P_firstrenderqueue x <- l]
, rsLastRenderQueue = def 95 [x | P_lastrenderqueue x <- l]
})
-}