module Graphics.LambdaCube.Loader.CompositorScript (parseCompositor) where
import UU.Parsing
import UU.Scanner
import Data.Either
import Data.Maybe
import qualified Data.IntMap as IntMap
import Graphics.LambdaCube.Common
import Graphics.LambdaCube.Compositor
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.Loader.Generated.CompositorScriptScanner
import Graphics.LambdaCube.Loader.ParserUtil
import Graphics.LambdaCube.PixelFormat
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.Types
parseCompositor :: (LinkedGpuProgram lp, Texture t) => String -> String -> IO (Maybe [Compositor t lp])
parseCompositor file txt = case parseTokens pCompositorScript (tokenize file txt) of
Left errs -> do
mapM_ (\m -> putStrLn $ "parseCompositor " ++ m) 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
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
pCompositorScript :: (Texture t, LinkedGpuProgram lp) => AnaParser [Token] Pair Token (Maybe Token) [Compositor t lp]
pCompositorScript = mkCompositorScript <$> pList pCompositorScriptContent
mkCompositorScript :: (LinkedGpuProgram lp, Texture t) => [CS_Attr t lp] -> [Compositor t lp]
mkCompositorScript l = [x | CS_compositor x <- l]
pCompositorScriptContent :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (CS_Attr t lp)
pCompositorScriptContent = pCompositor
pCompositor :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (CS_Attr t lp)
pCompositor = (CS_compositor .) . mkCompositor <$= "compositor" <*> pName <*= "{" <*> pList pCompositorContent <*= "}"
pCompositorContent :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (C_Attr t lp)
pCompositorContent = pTechnique
mkCompositor :: (Texture t, LinkedGpuProgram lp) => String -> [C_Attr t lp] -> Compositor t lp
mkCompositor name l = Compositor
{ cmpName = name
, cmpTechniques = [x | C_technique x <- l]
, cmpSupportedTechniques = Nothing
}
pTechnique :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (C_Attr t lp)
pTechnique = C_technique . mkTechnique <$= "technique" <*= "{" <*> pList pTechniqueContent <*= "}"
pTechniqueContent :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (T_Attr t lp)
pTechniqueContent = T_texture <$= "texture" <*> pName <*> pTexWidth <*> pTexHeight <*> pList (pEnum compositorPixelFormatVals) <*> (True <$= "shared" <|> pSucceed False)
<|> pTarget
<|> pTargetOutput
pTexWidth :: AnaParser [Token] Pair Token (Maybe Token) (Either Int FloatType)
pTexWidth = Left <$> pInt
<|> Right 1 <$= "target_width"
<|> Right <$= "target_width_scaled" <*> pFloat
pTexHeight :: AnaParser [Token] Pair Token (Maybe Token) (Either Int FloatType)
pTexHeight = Left <$> pInt
<|> Right 1 <$= "target_height"
<|> Right <$= "target_height_scaled" <*> pFloat
mkTechnique :: (Texture t, LinkedGpuProgram lp) => [T_Attr t lp] -> CompositionTechnique t lp
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 = ""
}
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
}
pTargetOutput :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (T_Attr t lp)
pTargetOutput = T_targetoutput . (mkTarget "output") <$= "target_output" <*= "{" <*> pList pTargetContent <*= "}"
pTarget :: (LinkedGpuProgram lp, Texture t) => AnaParser [Token] Pair Token (Maybe Token) (T_Attr t lp)
pTarget = (T_target .) . mkTarget <$= "target" <*> pName <*= "{" <*> pList pTargetContent <*= "}"
pTargetContent :: (Texture t, LinkedGpuProgram lp) => AnaParser [Token] Pair Token (Maybe Token) (TR_Attr t lp)
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 :: (Texture t, LinkedGpuProgram lp) => String -> [TR_Attr t lp] -> CompositionTargetPass t lp
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]
}
pPass :: (Texture t, LinkedGpuProgram lp) => AnaParser [Token] Pair Token (Maybe Token) (TR_Attr t lp)
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 :: AnaParser [Token] Pair Token (Maybe Token) P_Attr
pIdentifier = P_identifier <$= "identifier" <*> pInt
pPassRQContent :: AnaParser [Token] Pair Token (Maybe Token) P_Attr
pPassRQContent = pIdentifier
<|> P_material <$= "material" <*> pName
<|> P_input <$= "input" <*> pInt <*> pName <*> (pInt <|> pSucceed 0)
pPassRSContent :: AnaParser [Token] Pair Token (Maybe Token) P_Attr
pPassRSContent = pIdentifier
<|> P_firstrenderqueue <$= "first_render_queue" <*> pInt
<|> P_lastrenderqueue <$= "last_render_queue" <*> pInt
pPassCContent :: AnaParser [Token] Pair Token (Maybe Token) P_Attr
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 :: AnaParser [Token] Pair Token (Maybe Token) P_Attr
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 :: (LinkedGpuProgram lp, Texture t) => PassType -> [P_Attr] -> CompositionPass t lp
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]
}