lambdacube-engine-0.1.1: Graphics/LambdaCube/Loader/MaterialScript.hs
{-# LANGUAGE NoMonomorphismRestriction #-}
module Graphics.LambdaCube.Loader.MaterialScript (loadMaterial,parseMaterial) where
-- import the the library functions from uulib
import UU.Parsing
import UU.Scanner
import Data.Maybe
import Data.Either
import System.FilePath.Posix
import System.Log.Logger
import Graphics.LambdaCube.Loader.Generated.MaterialScriptScanner
import Graphics.LambdaCube.Types
import Graphics.LambdaCube.Common
import Graphics.LambdaCube.BlendMode
import Graphics.LambdaCube.Light
import Graphics.LambdaCube.PixelFormat
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.Material
import Graphics.LambdaCube.Technique
import Graphics.LambdaCube.Pass
import Graphics.LambdaCube.TextureUnitState
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.GpuProgramUsage
import Graphics.LambdaCube.GpuProgramParams
import Graphics.LambdaCube.Loader.ParserUtil
----------------------
-- Boilerplate code --
----------------------
{-
loadMaterial path file = do
txt <- readFile file
parseMaterial file txt
parseMaterial file txt = parseFile pMaterialScript tokenize file txt
-}
loadMaterial path file = do
txt <- readFile file
parseMaterial file txt
parseMaterial file txt
= let res = parseTokens pMaterialScript (tokenize file txt)
in case res of
Left errs -> do
mapM_ (errorM "MaterialScript") 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
-- * AST definitions
-- |Material Script
data (Texture t, GpuProgram p, LinkedGpuProgram lp) => MS_Attr t p lp
= MS_material (Material t lp)
| MS_vertexprogram (GpuProgramDescriptor p)
| MS_fragmentprogram (GpuProgramDescriptor p)
-- |Material
data (Texture t, LinkedGpuProgram lp) => M_Attr t lp
= M_technique (Technique t lp)
| M_receiveshadows Bool
| M_transparencycastsshadows Bool
| M_loddistances [FloatType]
| M_settexturealias String String
-- |Technique
data (Texture t, LinkedGpuProgram lp) => T_Attr t lp
= T_pass (Pass t lp)
| T_scheme String
| T_lodindex Int
| T_shadowcastermaterial String
| T_shadowreceivermaterial String
| T_gpuvendorrule IncludeOrExclude String
| T_gpudevicerule IncludeOrExclude String Bool
-- |Pass
type Colour = Either ColourValue ()
data Texture t => P_Attr t
= P_textureunit (TextureUnitState t)
| P_vertexprogramref String [PR_Attr]
| P_fragmentprogramref String [PR_Attr]
| P_shadowcastervertexprogramref -- NOT SUPPORTED
| P_shadowreceiververtexprogramref -- NOT SUPPORTED
| P_shadowreceiverfragmentprogramref -- NOT SUPPORTED
| P_ambient Colour
| P_diffuse Colour
| P_specular Colour FloatType
| P_emissive Colour
| P_sceneblend (SceneBlendFactor,SceneBlendFactor)
| P_sceneblendop SceneBlendOperation
| P_separatesceneblend ((SceneBlendFactor,SceneBlendFactor),(SceneBlendFactor,SceneBlendFactor))
| P_separatesceneblendop SceneBlendOperation SceneBlendOperation
| P_depthcheck Bool
| P_depthwrite Bool
| P_depthfunc CompareFunction
| P_depthbias FloatType FloatType
| P_iterationdepthbias FloatType
| P_alpharejection CompareFunction Int
| P_alphatocoverage Bool
| P_lightscissor Bool
| P_lightclipplanes Bool
| P_illuminationstage IlluminationStage
| P_normalisenormals Bool
| P_transparentsorting Bool Bool
| P_cullhardware CullingMode
| P_cullsoftware ManualCullingMode
| P_lighting Bool
| P_shading ShadeOptions
| P_polygonmode PolygonMode
| P_polygonmodeoverrideable Bool
| P_fogoverride Bool FogMode FloatType3 FloatType FloatType FloatType
| P_colourwrite Bool
| P_startlight Int
| P_maxlights Int
| P_iteration Int (Maybe Int) (Maybe LightTypes) -- ^ iteration count, n_light, light type
| P_pointsize FloatType
| P_pointsprites Bool
| P_pointsizeattenuation Bool FloatType3
| P_pointsizemin FloatType
| P_pointsizemax FloatType
-- |TextureUnit
data TU_Attr
= TU_texturealias String
-- texture <texturename> [<type>] [unlimited | numMipMaps] [alpha] [<PixelFormat>] [gamma]
| TU_texture String TextureType TextureMipmap Bool PixelFormat Bool
| TU_animtexture [String] FloatType
| TU_cubictexture String String String String String String Bool
| TU_bindingtype BindingType
| TU_contenttype ContentType
| TU_texcoordset Int
| TU_texaddressmode TextureAddressingMode TextureAddressingMode TextureAddressingMode
| TU_texbordercolour ColourValue
| TU_filtering (FilterOptions,FilterOptions,FilterOptions)
| TU_maxanisotropy Int
| TU_mipmapbias FloatType
| TU_colourop LayerBlendOperation
| TU_colouropex LayerBlendOperationEx LayerBlendSource LayerBlendSource FloatType ColourValue ColourValue
| TU_colouropmultipassfallback (SceneBlendFactor,SceneBlendFactor)
| TU_alphaopex LayerBlendOperationEx LayerBlendSource LayerBlendSource FloatType FloatType FloatType
| TU_envmap (Maybe EnvMapType)
| TU_scroll FloatType FloatType
| TU_scrollanim FloatType FloatType
| TU_rotate FloatType
| TU_rotateanim FloatType
| TU_scale FloatType FloatType
| TU_wavexform TextureTransformType WaveformType FloatType FloatType FloatType FloatType
| TU_transform FloatType4 FloatType4 FloatType4 FloatType4
-- |Texture
data TX_Attr
= TX_type TextureType
| TX_mipmap TextureMipmap
| TX_alpha
| TX_pixelformat PixelFormat
| TX_gamma
-- |Shader
data SH_Attr
= SH_source String
| SH_attach [String]
| SH_includesskeletalanimation Bool
| SH_includesmorphanimation Bool
| SH_includesposeanimation Int
| SH_usesvertextexturefetch Bool
| SH_usesadjacencyinformation Bool
| SH_entrypoint String
| SH_profiles [String]
| SH_target String
| SH_delegate String
| SH_defaultparams [PR_Attr]
data PR_Attr
= PR_paramnamed String String [FloatType]
| PR_paramnamedauto String AutoConstantType [FloatType]
| PR_paramindexed Int String [FloatType]
| PR_paramindexedauto Int AutoConstantType [FloatType]
-- * Material script top level parser combinators
pMaterialScript = mkMaterialScript <$> pList pMaterialScriptContent
mkMaterialScript l = (mats,vertprogs,fragprogs)
where
mats = [x | MS_material x <- l]
vertprogs = [x | MS_vertexprogram x <- l]
fragprogs = [x | MS_fragmentprogram x <- l]
pMaterialScriptContent = (MS_material .) . mkMaterial <$= "material" <*> pName <*= "{" <*> pList pMaterialContent <*= "}"
<|> ((MS_vertexprogram .) .) . (mkGpuProgramDesc GPT_VERTEX_PROGRAM) <$= "vertex_program" <*> pName <*> pName <*= "{" <*> pList pProgramContent <*= "}"
<|> ((MS_fragmentprogram .) .) . (mkGpuProgramDesc GPT_FRAGMENT_PROGRAM) <$= "fragment_program" <*> pName <*> pName <*= "{" <*> pList pProgramContent <*= "}"
-- * Material
pMaterialContent = (M_technique .) . mkTechnique <$= "technique" <*> (pName <|> pSucceed "") <*= "{" <*> pList pTechniqueContent <*= "}"
<|> M_loddistances <$= "lod_distances" <*> pList pFloat
<|> M_receiveshadows <$= "receive_shadows" <*> pOnOff
<|> M_transparencycastsshadows <$= "transparency_casts_shadows" <*> pOnOff
<|> M_settexturealias <$= "set_texture_alias" <*> pName <*> pName
mkMaterial name l = Material
{ mtName = name
-- , mtLodDistances = def [] [x | M_loddistances x <- l]
, mtReceiveShadows = def True [x | M_receiveshadows x <- l]
, mtTransparencyCastsShadows = def False [x | M_transparencycastsshadows x <- l]
--, mtTextureAlias = [(a,b) | M_settexturealias a b <- l]
, mtTechniques = [x | M_technique x <- l]
---------------
, mtSupportedTechniques = Nothing
, mtUserLodValues = []
, mtLodValues = []
, mtUnsupportedReasons = ""
}
-- * Technique
pTechniqueContent = (T_pass .) . mkPass <$= "pass" <*> (pName <|> pSucceed "") <*= "{" <*> pList pPassContent <*= "}"
<|> T_scheme <$= "scheme" <*> pName
<|> T_lodindex <$= "lod_index" <*> pInt
<|> T_shadowcastermaterial <$= "shadow_caster_material" <*> pName
<|> T_shadowreceivermaterial <$= "shadow_receiver_material" <*> pName
<|> T_gpuvendorrule <$= "gpu_vendor_rule" <*> pEnum ruleopVals <*> pName
<|> T_gpudevicerule <$= "gpu_device_rule" <*> pEnum ruleopVals <*> pName <*> (True <$= "case_sensitive" <|> pSucceed False)
mkTechnique n l = Technique
-- TODO
{ tchName = n
-- TODO
, tchSchemeIndex = 0 --def "Default" [x | T_scheme x <- l]
, tchLodIndex = def 0 [x | T_lodindex x <- l]
-- , tchShadowCasterMaterial = def "" [x | T_shadowcastermaterial x <- l]
-- , tchShadowReceiverMaterial = def "" [x | T_shadowreceivermaterial x <- l]
-- , tchGPUVendorRules = [GPUVendorRule (a,b) | T_gpuvendorrule a b <- l]
-- , tchGPUDeviceNameRules = [(a,b,c) | T_gpudevicerule a b c <- l]
, tchPasses = [x | T_pass x <- l]
-------------------
, tchGPUVendorRules = []
, tchGPUDeviceNameRules = []
}
-- * Pass
pPassContent = (P_textureunit .) . mkTextureUnitState <$= "texture_unit" <*> (pName <|> pSucceed "") <*= "{" <*> pList pTextureUnitContent <*= "}"
<|> P_vertexprogramref <$= "vertex_program_ref" <*> pName <*= "{" <*> pList pParamContent <*= "}"
<|> P_fragmentprogramref <$= "fragment_program_ref" <*> pName <*= "{" <*> pList pParamContent <*= "}"
<|> P_shadowcastervertexprogramref <$= "shadow_caster_vertex_program_ref" <* pName <*= "{" <* pList pParamContent <*= "}"
<|> P_shadowreceiververtexprogramref <$= "shadow_receiver_vertex_program_ref" <* pName <*= "{" <* pList pParamContent <*= "}"
<|> P_shadowreceiverfragmentprogramref <$= "shadow_receiver_fragment_program_ref" <* pName <*= "{" <* pList pParamContent <*= "}"
<|> P_ambient <$= "ambient" <*> pColour 1
<|> P_diffuse <$= "diffuse" <*> pColour 1
<|> P_specular <$= "specular" <*> pColour 0 <*> pFloat
<|> P_emissive <$= "emissive" <*> pColour 0
<|> P_sceneblendop <$= "scene_blend_op" <*> pEnum blendopVals
-- <|> P_sceneblend (convertSBTtoSBF SBT_MODULATE) <$= "scene_blend" <*= "modulate"
<|> P_sceneblend . convertSBTtoSBF <$= "scene_blend" <*> pEnum sceneblendVals
<|> curry P_sceneblend <$= "scene_blend" <*> pEnum blendVals <*> pEnum blendVals
<|> P_separatesceneblendop <$= "separate_scene_blend_op" <*> pEnum blendopVals <*> pEnum blendopVals
<|> curry P_separatesceneblend <$= "separate_scene_blend" <*> (convertSBTtoSBF <$> pEnum sceneblendVals) <*> (convertSBTtoSBF <$> pEnum sceneblendVals)
<|> (\a b c d -> P_separatesceneblend ((a,b),(c,d))) <$= "separate_scene_blend" <*> pEnum blendVals <*> pEnum blendVals <*> pEnum blendVals <*> pEnum blendVals
<|> P_depthcheck <$= "depth_check" <*> pOnOff
<|> P_depthwrite <$= "depth_write" <*> pOnOff
<|> P_depthfunc <$= "depth_func" <*> pEnum cmpfuncVals
<|> P_depthbias <$= "depth_bias" <*> pFloat <*> (pFloat <|> pSucceed 0)
<|> P_iterationdepthbias <$= "iteration_depth_bias" <*> pFloat
<|> P_alpharejection <$= "alpha_rejection" <*> pEnum cmpfuncVals <*> pInt
<|> P_alphatocoverage <$= "alpha_to_coverage" <*> pOnOff
<|> P_lightscissor <$= "light_scissor" <*> pOnOff
<|> P_lightclipplanes <$= "light_clip_planes" <*> pOnOff
<|> P_illuminationstage <$= "illumination_stage" <*> pEnum illumstageVals
<|> P_normalisenormals <$= "normalise_normals" <*> pOnOff
<|> P_transparentsorting <$= "transparent_sorting" <*= "force" <*> pSucceed True <*> pSucceed True
<|> P_transparentsorting <$= "transparent_sorting" <*> pOnOff <*> pSucceed False
<|> P_cullhardware <$= "cull_hardware" <*> pEnum cullhwVals
<|> P_cullsoftware <$= "cull_software" <*> pEnum cullswVals
<|> P_lighting <$= "lighting" <*> pOnOff
<|> P_shading <$= "shading" <*> pEnum shadingVals
<|> P_polygonmode <$= "polygon_mode" <*> pEnum polymodeVals
<|> P_polygonmodeoverrideable <$= "polygon_mode_overrideable" <*> pOnOff
<|> P_fogoverride False <$= "fog_override" <*= "false" <*> pSucceed FOG_NONE <*> pSucceed (0,0,0) <*> pSucceed 0 <*> pSucceed 0 <*> pSucceed 0
<|> P_fogoverride True <$= "fog_override" <*= "true" <*> pSucceed FOG_NONE <*> pSucceed (0,0,0) <*> pSucceed 0 <*> pSucceed 0 <*> pSucceed 0
<|> P_fogoverride True <$= "fog_override" <*= "true" <*> (FOG_NONE <$= "none") <*> pSucceed (0,0,0) <*> pSucceed 0 <*> pSucceed 0 <*> pSucceed 0
<|> P_fogoverride True <$= "fog_override" <*= "true" <*> pEnum fogmodeVals <*> pFloat3 <*> pFloat <*> pFloat <*> pFloat
<|> P_colourwrite <$= "colour_write" <*> pOnOff
<|> P_startlight <$= "start_light" <*> pInt
<|> P_maxlights <$= "max_lights" <*> pInt
-- Format 1: iteration <once | once_per_light> [lightType]
-- Format 2: iteration <number> [<per_light> [lightType]]
-- Format 3: iteration <number> [<per_n_lights> <num_lights> [lightType]]
-- lights of a single type (either 'point', 'directional' or 'spot').
<|> P_iteration 1 Nothing <$= "iteration" <*= "once" <*> (Just <$> pEnum lighttypeVals <|> pSucceed Nothing)
<|> P_iteration 1 (Just 1) <$= "iteration" <*= "once_per_light" <*> (Just <$> pEnum lighttypeVals <|> pSucceed Nothing)
<|> (\n -> P_iteration n (Just 1)) <$= "iteration" <*> pInt <*= "per_light" <*> (Just <$> pEnum lighttypeVals <|> pSucceed Nothing)
<|> P_iteration <$= "iteration" <*> pInt <*= "per_n_light" <*> (Just <$> pInt) <*> (Just <$> pEnum lighttypeVals <|> pSucceed Nothing)
<|> P_iteration <$= "iteration" <*> pInt <*> pSucceed Nothing <*> pSucceed Nothing
<|> P_pointsize <$= "point_size" <*> pFloat
<|> P_pointsprites <$= "point_sprites" <*> pOnOff
<|> P_pointsizeattenuation <$= "point_size_attenuation" <*> pOnOff <*> (pFloat3 <|> pSucceed (1,0,0))
<|> P_pointsizemin <$= "point_size_min" <*> pFloat
<|> P_pointsizemax <$= "point_size_max" <*> pFloat
mkPass n l = Pass
{ psName = n
, psAmbient = def (1,1,1,1) $ lefts $ [x | P_ambient x <- l]
, psDiffuse = def (1,1,1,1) $ lefts $ [x | P_diffuse x <- l]
, psSpecular = def (0,0,0,0) $ lefts $ [x | P_specular x _ <- l]
, psEmissive = def (0,0,0,0) $ lefts $ [x | P_emissive x <- l]
, psShininess = def 0 [x | P_specular _ x <- l]
, psTracking = def (TrackVertexColourType False False False False)
[ TrackVertexColourType
(null $ lefts $ [x | P_ambient x <- l])
(null $ lefts $ [x | P_diffuse x <- l])
(null $ lefts $ [x | P_specular x _ <- l])
(null $ lefts $ [x | P_emissive x <- l])
]
, psSourceBlendFactor = def SBF_ONE $ [x | P_separatesceneblend ((x,_),_) <- l] ++ [x | P_sceneblend (x,_) <- l]
, psDestBlendFactor = def SBF_ZERO $ [x | P_separatesceneblend ((_,x),_) <- l] ++ [x | P_sceneblend (_,x) <- l]
, psSourceBlendFactorAlpha = def SBF_ONE [x | P_separatesceneblend (_,(x,_)) <- l]
, psDestBlendFactorAlpha = def SBF_ZERO [x | P_separatesceneblend (_,(_,x)) <- l]
, psSeparateBlend = (not . null) [() | P_separatesceneblend _ <- l]
, psBlendOperation = def SBO_ADD $ [x | P_separatesceneblendop x _ <- l] ++ [x | P_sceneblendop x <- l]
, psAlphaBlendOperation = def SBO_ADD [x | P_separatesceneblendop _ x <- l]
, psSeparateBlendOperation = (not . null) [() | P_separatesceneblendop _ _ <- l]
, psDepthCheck = def True [x | P_depthcheck x <- l]
, psDepthWrite = def True [x | P_depthwrite x <- l]
, psDepthFunc = def CMPF_LESS_EQUAL [x | P_depthfunc x <- l]
, psDepthBiasConstant = def 0 [x | P_depthbias x _ <- l]
, psDepthBiasSlopeScale = def 0 [x | P_depthbias _ x <- l]
, psDepthBiasPerIteration = def 0 [x | P_iterationdepthbias x <- l]
, psColourWrite = def True [x | P_colourwrite x <- l]
, psAlphaRejectFunc = def CMPF_ALWAYS_PASS [x | P_alpharejection x _ <- l]
, psAlphaRejectVal = def 0 [x | P_alpharejection _ x <- l]
, psAlphaToCoverageEnabled = def False [x | P_alphatocoverage x <- l]
, psTransparentSorting = def True [x | P_transparentsorting x _ <- l]
, psTransparentSortingForced = def False [x | P_transparentsorting _ x <- l]
, psCullMode = def CULL_CLOCKWISE [x | P_cullhardware x <- l]
, psManualCullMode = def MANUAL_CULL_BACK [x | P_cullsoftware x <- l]
, psLightingEnabled = def True [x | P_lighting x <- l]
, psMaxSimultaneousLights = def 0 [x | P_maxlights x <- l]
, psStartLight = def 0 [x | P_startlight x <- l]
, psLightsPerIteration = def Nothing [x | P_iteration _ x _ <- l]
, psOnlyLightType = def Nothing [x | P_iteration _ _ x <- l]
, psShadeOptions = def SO_GOURAUD [x | P_shading x <- l]
, psPolygonMode = def PM_SOLID [x | P_polygonmode x <- l]
, psNormaliseNormals = def False [x | P_normalisenormals x <- l]
, psPolygonModeOverrideable = def True [x | P_polygonmodeoverrideable x <- l]
, psFogOverride = def False [x | P_fogoverride x _ _ _ _ _ <- l]
, psFogMode = def FOG_NONE [x | P_fogoverride _ x _ _ _ _ <- l]
, psFogColour = def (0,0,0,0) [(r,g,b,1) | P_fogoverride _ _ (r,g,b) _ _ _ <- l]
, psFogStart = def 0 [x | P_fogoverride _ _ _ _ x _ <- l]
, psFogEnd = def 0 [x | P_fogoverride _ _ _ _ _ x <- l]
, psFogDensity = def 0 [x | P_fogoverride _ _ _ x _ _ <- l]
, psTextureUnitStates = [x | P_textureunit x <- l]
, psVertexProgramUsage = def Nothing [Just $ GpuProgramUsage x | P_vertexprogramref x _ <- l] -- TODO
, psFragmentProgramUsage = def Nothing [Just $ GpuProgramUsage x | P_fragmentprogramref x _ <- l] -- TODO
, psGeometryProgramUsage = Nothing -- TODO
, psLinkedGpuProgram = Nothing
, psPassIterationCount = def 1 [x | P_iteration x _ _ <- l]
, psPointSize = def 0 [x | P_pointsize x <- l]
, psPointMinSize = def 0 [x | P_pointsizemin x <- l]
, psPointMaxSize = def 0 [x | P_pointsizemax x <- l]
, psPointSpritesEnabled = def False [x | P_pointsprites x <- l]
, psPointAttenuationEnabled = def False [x | P_pointsizeattenuation x _ <- l]
, psPointAttenuationCoeffs = def (0,0,0) [x | P_pointsizeattenuation _ x <- l]
, psLightScissoring = def False [x | P_lightscissor x <- l]
, psLightClipPlanes = def False [x | P_lightclipplanes x <- l]
, psIlluminationStage = def IS_UNKNOWN [x | P_illuminationstage x <- l]
}
-- * Texture
pTextureContent = TX_type <$> pEnum textypeVals
<|> TX_mipmap <$> (pKey "unlimited" *> pSucceed MIP_UNLIMITED <|> MIP_NUMBER <$> pInt)
<|> TX_alpha <$= "alpha"
<|> TX_pixelformat <$> pEnum pixelformatVals
<|> TX_gamma <$= "gamma"
-- * TextureUnit
pTextureUnitContent = TU_texturealias <$= "texture_alias" <*> pName
-- Format: texture <texturename> [<type>] [unlimited | numMipMaps] [alpha] [<PixelFormat>] [gamma]
<|> mkTU_Texture <$= "texture" <*> pName <*> pList pTextureContent
-- Format1 (short): anim_texture <base_name> <num_frames> <duration>
-- <|> mkTU_animtexture <$= "anim_texture" <*> pName <*> pInt <*> pFloat
-- Format2 (long): anim_texture <frame1> <frame2> ... <duration>
-- <|> TU_animtexture <$= "anim_texture" <*> pList pName <*> pFloat
<|> (\a b -> TU_animtexture b a) <$= "anim_texture" <*> pFloat <*> pList pName
-- Format2 (long): cubic_texture <front> <back> <left> <right> <up> <down> separateUV
<|> TU_cubictexture <$= "cubic_texture" <*> pName <*> pName <*> pName <*> pName <*> pName <*> pName <*= "separateUV" <*> pSucceed False
-- Format1 (short): cubic_texture <base_name> <combinedUVW|separateUV>
<|> mkTU_cubictexture <$= "cubic_texture" <*> pName <*> (True <$= "combinedUVW" <|> False <$= "separateUV" )
<|> TU_bindingtype <$= "binding_type" <*> pEnum btyVals
<|> TU_contenttype <$= "content_type" <*> pEnum ctyVals
<|> TU_texcoordset <$= "tex_coord_set" <*> pInt
-- Extended Format: tex_address_mode <u_mode> <v_mode> [<w_mode>]
<|> TU_texaddressmode <$= "tex_address_mode" <*> pEnum texaddressVals <*> pEnum texaddressVals <*> (pEnum texaddressVals <|> pSucceed TAM_WRAP)
-- Simple Format: tex_address_mode <uvw_mode>
<|> (\a -> TU_texaddressmode a a a) <$= "tex_address_mode" <*> pEnum texaddressVals
<|> TU_texbordercolour <$= "tex_border_colour" <*> pRGBOrRGBA 1
-- Format: filtering <minification> <magnification> <mip>
<|> (\a b c -> TU_filtering (a,b,c)) <$= "filtering" <*> pEnum filteringVals <*> pEnum filteringVals <*> pEnum filteringVals
-- Format: filtering <none|bilinear|trilinear|anisotropic>
<|> TU_filtering <$= "filtering" <*> pEnum texfilteringVals
<|> TU_maxanisotropy <$= "max_anisotropy" <*> pInt
<|> TU_mipmapbias <$= "mipmap_bias" <*> pFloat
<|> TU_colourop <$= "colour_op" <*> pEnum copVals
-- Format: colour_op_ex <operation> <source1> <source2> [<manual_factor>] [<manual_colour1>] [<manual_colour2>]
<|> TU_colouropex <$= "colour_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pFloat4 <*> pFloat4
<|> TU_colouropex <$= "colour_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pFloat4 <*> pSucceed (1,1,1,1)
<|> TU_colouropex <$= "colour_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pSucceed (1,1,1,1) <*> pSucceed (1,1,1,1)
<|> TU_colouropex <$= "colour_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pSucceed 0 <*> pSucceed (1,1,1,1) <*> pSucceed (1,1,1,1)
-- Format: colour_op_multipass_fallback <src_factor> <dest_factor>
<|> TU_colouropmultipassfallback . convertSBTtoSBF <$= "colour_op_multipass_fallback" <*> pEnum sceneblendVals
<|> curry TU_colouropmultipassfallback <$= "colour_op_multipass_fallback" <*> pEnum blendVals <*> pEnum blendVals
<|> TU_alphaopex <$= "alpha_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pFloat <*> pFloat
<|> TU_alphaopex <$= "alpha_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pFloat <*> pSucceed 1
<|> TU_alphaopex <$= "alpha_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pFloat <*> pSucceed 1 <*> pSucceed 1
<|> TU_alphaopex <$= "alpha_op_ex" <*> pEnum layerblendopexVals <*> pEnum layerblendsrcVals <*> pEnum layerblendsrcVals <*> pSucceed 0 <*> pSucceed 1 <*> pSucceed 1
-- Format: env_map <off|spherical|planar|cubic_reflection|cubic_normal>
<|> TU_envmap <$= "env_map" <*> pEnum envmapVals
<|> TU_scroll <$= "scroll" <*> pFloat <*> pFloat
<|> TU_scrollanim <$= "scroll_anim" <*> pFloat <*> pFloat
<|> TU_rotate <$= "rotate" <*> pFloat
<|> TU_rotateanim <$= "rotate_anim" <*> pFloat
<|> TU_scale <$= "scale" <*> pFloat <*> pFloat
-- Format: wave_xform <xform_type> <wave_type> <base> <frequency> <phase> <amplitude>
<|> TU_wavexform <$= "wave_xform" <*> pEnum xformtypeVals <*> pEnum wavetypeVals <*> pFloat <*> pFloat <*> pFloat <*> pFloat
<|> TU_transform <$= "transform" <*> pFloat4 <*> pFloat4 <*> pFloat4 <*> pFloat4
where
mkTU_Texture n l = TU_texture n t m a p g
where
t = def TEX_TYPE_2D [x | TX_type x <- l]
m = def MIP_UNLIMITED [x | TX_mipmap x <- l]
a = def False [True | TX_alpha <- l]
p = def PF_UNKNOWN [x | TX_pixelformat x <- l]
g = def False [True | TX_gamma <- l]
f a e = (dropExtensions a) ++ e ++ (takeExtensions a)
mkTU_cubictexture n True = TU_cubictexture n n n n n n True
mkTU_cubictexture n False = TU_cubictexture (f n "_fr") (f n "_bk") (f n "_up") (f n "_dn") (f n "_lf") (f n "_rt") False
-- Format1 (short): anim_texture <base_name> <num_frames> <duration>
mkTU_animtexture basename numframes duration = TU_animtexture [f basename $ show i | i <- [0..(numframes-1)]] duration
{-
-- texture <texturename> [<type>] [unlimited | numMipMaps] [alpha] [<PixelFormat>] [gamma]
| TU_texture String TextureType TextureMipmap Bool PixelFormat Bool
-}
mkTextureUnitState n l = TextureUnitState
{ tusAnimDuration = def Nothing [Just x | TU_animtexture _ x <- l]
, tusCubic = def False $ [TEX_TYPE_CUBE_MAP==x | TU_texture _ x _ _ _ _ <- l] ++ [True | TU_cubictexture _ _ _ _ _ _ _ <- l]
, tusTextureType = def TEX_TYPE_2D $ [x | TU_texture _ x _ _ _ _ <- l] ++ [TEX_TYPE_CUBE_MAP | TU_cubictexture _ _ _ _ _ _ _ <- l]
, tusDesiredFormat = def PF_UNKNOWN [x | TU_texture _ _ _ _ x _ <- l]
, tusTextureSrcMipmaps = def MIP_DEFAULT [x | TU_texture _ _ x _ _ _ <- l]
, tusTextureCoordSetIndex = def 0 [x | TU_texcoordset x <- l]
, tusAddressMode = def (UVWAddressingMode TAM_WRAP TAM_WRAP TAM_WRAP)
[UVWAddressingMode a b c | TU_texaddressmode a b c <- l]
, tusBorderColour = def (0,0,0,1) [x | TU_texbordercolour x <- l]
, tusColourBlendMode = def cblendmode [LayerBlendModeEx LBT_COLOUR op src1 src2 c1 c2 1 1 f | TU_colouropex op src1 src2 f c1 c2 <- (l ++ colouropex)]
, tusColourBlendFallbackSrc = def SBF_DEST_COLOUR [x | TU_colouropmultipassfallback (x,_) <- (l ++ fallbackop)]
, tusColourBlendFallbackDest = def SBF_ZERO [x | TU_colouropmultipassfallback (_,x) <- (l ++ fallbackop)]
, tusAlphaBlendMode = def ablendmode [LayerBlendModeEx LBT_ALPHA op src1 src2 white white a1 a2 f | TU_alphaopex op src1 src2 f a1 a2 <- l]
, tusIsAlpha = def False [x | TU_texture _ _ _ x _ _ <- l]
, tusHwGamma = def False [x | TU_texture _ _ _ _ _ x <- l]
, tusUMod = def 0 [x | TU_scroll x _ <- l]
, tusVMod = def 0 [x | TU_scroll _ x <- l]
, tusUScale = def 1 [x | TU_scale x _ <- l]
, tusVScale = def 1 [x | TU_scale _ x <- l]
, tusRotate = def 0 [x | TU_rotate x <- l]
, tusMinFilter = def FO_LINEAR [x | TU_filtering (x,_,_) <- l]
, tusMagFilter = def FO_LINEAR [x | TU_filtering (_,x,_) <- l]
, tusMipFilter = def FO_POINT [x | TU_filtering (_,_,x) <- l]
, tusMaxAniso = def 1 [x | TU_maxanisotropy x <- l]
, tusMipmapBias = def 0 [x | TU_mipmapbias x <- l]
, tusBindingType = def BT_FRAGMENT [x | TU_bindingtype x <- l]
, tusContentType = def CONTENT_NAMED [x | TU_contenttype x <- l]
, tusFrameNames = animFrames ++ cubeFrames ++ [n | TU_texture n _ _ _ _ _ <- l]
, tusFrames = Nothing
, tusName = n
, tusTextureAlias = def "" [x | TU_texturealias x <- l]
, tusEffects = [e | Just e <- map mkEffect l]
}
where
white = (1,1,1,1)
colourop = def LBO_MODULATE [x | TU_colourop x <- l]
animFrames = concat [x | TU_animtexture x _ <- l]
cubeFrames = concat [[a,b,c,d,e,f] | TU_cubictexture a b c d e f _ <- l]
fallbackop = case colourop of
{ LBO_REPLACE -> [TU_colouropmultipassfallback (SBF_ONE, SBF_ZERO)]
; LBO_ADD -> [TU_colouropmultipassfallback (SBF_ONE, SBF_ONE)]
; LBO_MODULATE -> [TU_colouropmultipassfallback (SBF_DEST_COLOUR, SBF_ZERO)]
; LBO_ALPHA_BLEND -> [TU_colouropmultipassfallback (SBF_SOURCE_ALPHA, SBF_ONE_MINUS_SOURCE_ALPHA)]
}
colouropex = case colourop of
{ LBO_REPLACE -> [TU_colouropex LBX_SOURCE1 LBS_TEXTURE LBS_CURRENT 0 white white]
; LBO_ADD -> [TU_colouropex LBX_ADD LBS_TEXTURE LBS_CURRENT 0 white white]
; LBO_MODULATE -> [TU_colouropex LBX_MODULATE LBS_TEXTURE LBS_CURRENT 0 white white]
; LBO_ALPHA_BLEND -> [TU_colouropex LBX_BLEND_TEXTURE_ALPHA LBS_TEXTURE LBS_CURRENT 0 white white]
}
cblendmode = LayerBlendModeEx
{ lbBlendType = LBT_COLOUR
, lbOperation = LBX_MODULATE
, lbSource1 = LBS_TEXTURE
, lbSource2 = LBS_CURRENT
, lbColourArg1 = white
, lbColourArg2 = white
, lbAlphaArg1 = 1
, lbAlphaArg2 = 1
, lbFactor = 0
}
ablendmode = LayerBlendModeEx
{ lbBlendType = LBT_ALPHA
, lbOperation = LBX_MODULATE
, lbSource1 = LBS_TEXTURE
, lbSource2 = LBS_CURRENT
, lbColourArg1 = white
, lbColourArg2 = white
, lbAlphaArg1 = 1
, lbAlphaArg2 = 1
, lbFactor = 0
}
mkEffect e = case e of
{ TU_envmap _ -> Just $ TextureEffect
{ teType = ET_ENVIRONMENT_MAP
, teSubType = 0
, teArg1 = 0
, teArg2 = 0
, teWaveType = WFT_SINE
, teBase = 0
, teFrequency = 0
, tePhase = 0
, teAmplitude = 0
}
-- ; TU_scrollanim
-- ; TU_rotateanim
-- ; TU_wavexform
-- ; TU_transform
; _ -> Nothing
}
{-
void TextureUnitState::setEnvironmentMap(bool enable, EnvMapType envMapType)
{
if (enable)
{
TextureEffect eff;
eff.type = ET_ENVIRONMENT_MAP;
eff.subtype = envMapType;
addEffect(eff);
}
else
{
removeEffect(ET_ENVIRONMENT_MAP);
}
}
case ScriptCompiler::ID_OFF:
mUnit->setEnvironmentMap(false);
break;
case ID_SPHERICAL:
mUnit->setEnvironmentMap(true, TextureUnitState::ENV_CURVED);
break;
case ID_PLANAR:
mUnit->setEnvironmentMap(true, TextureUnitState::ENV_PLANAR);
break;
case ID_CUBIC_REFLECTION:
mUnit->setEnvironmentMap(true, TextureUnitState::ENV_REFLECTION);
break;
case ID_CUBIC_NORMAL:
mUnit->setEnvironmentMap(true, TextureUnitState::ENV_NORMAL);
break;
| TU_envmap (Maybe EnvMapType)
| TU_scrollanim FloatType FloatType
| TU_rotateanim FloatType
| TU_wavexform TextureTransformType WaveformType FloatType FloatType FloatType FloatType
| TU_transform FloatType4 FloatType4 FloatType4 FloatType4
= TextureEffect
{ teType :: TextureEffectType
, teSubType :: Int
, teArg1 :: FloatType
, teArg2 :: FloatType
, teWaveType :: WaveformType
, teBase :: FloatType
, teFrequency :: FloatType
, tePhase :: FloatType
, teAmplitude :: FloatType
}
-}
-- * Shaders
pProgramContent = SH_source <$= "source" <*> pName
<|> SH_attach <$= "attach" <*> pList pName
<|> SH_includesskeletalanimation <$= "includes_skeletal_animation" <*> pBool
<|> SH_includesmorphanimation <$= "includes_morph_animation" <*> pBool
<|> SH_includesposeanimation <$= "includes_pose_animation" <*> pInt
<|> SH_usesvertextexturefetch <$= "uses_vertex_texture_fetch" <*> pBool
<|> SH_usesadjacencyinformation <$= "uses_adjacency_information" <*> pBool
<|> SH_entrypoint <$= "entry_point" <*> pName
<|> SH_profiles <$= "profiles" <*> pList pName
<|> SH_target <$= "target" <*> pName
<|> SH_delegate <$= "delegate" <*> pName
-- <|> pPreprocessorDefines
<|> SH_defaultparams <$= "default_params" <*= "{" <*> pList pParamContent <*= "}"
--pPreprocessorDefines = (\_ d -> []) <$> pKey "preprocessor_defines" <*> pName -- TODO: parse defines correctly not with pName
--format: param_indexed <index> <type> <value>
--format: param_indexed_auto <index> <value_code> <extra_params>
--format: param_named <name> <type> <value>
--format: param_named_auto <name> <value_code> <extra_params>
--The value of 'type' can be float4, matrix4x4, float<n>, int4, int<n>
--("matrix4x4", 16, pFloat)
--("float" , 1 , pFloat)
--("int" , 1 , pInt)
--[("float" ++ show i,i,pFloat) | i <- [1..32]]
--[("int" ++ show i,i,pInt) | i <- [1..32]]
autoparamVals = [(n,v) | (v,n,_,_,_) <- autoConstantDictionary]
pParamContent = PR_paramnamed <$= "param_named" <*> pName <*> pVarid <*> pList pFloat
<|> PR_paramnamedauto <$= "param_named_auto" <*> pName <*> pEnum autoparamVals <*> pList pFloat
<|> PR_paramindexed <$= "param_indexed" <*> pInt <*> pVarid <*> pList pFloat
<|> PR_paramindexedauto <$= "param_indexed_auto" <*> pInt <*> pEnum autoparamVals <*> pList pFloat
mkGpuProgramDesc t name s l = GpuProgramDescriptor
{ gpdName = name
, gpdType = t
, gpdFilename = def "" [x | SH_source x <- l]
, gpdSyntaxCode = s
, gpdAttach = def [] [x | SH_attach x <- l]
, gpdSkeletalAnimation = def False [x | SH_includesskeletalanimation x <- l]
, gpdMorphAnimation = def False [x | SH_includesmorphanimation x <- l]
, gpdPoseAnimation = def 0 [x | SH_includesposeanimation x <- l]
, gpdVertexTextureFetch = def False [x | SH_usesvertextexturefetch x <- l]
, gpdNeedsAdjacencyInfo = def False [x | SH_usesadjacencyinformation x <- l]
-- , gpdDefaultParams :: GpuProgramParameters -- ^ The default parameters for use with this object
-- , gpdCompileError = False
, gpdGpuProgram = Nothing
}
{-
fragment_program is same:
vertex_program myExteranalGLSLFunction1 glsl
{
source myExternalGLSLfunction1.txt
default_params
{
param_named_auto lightPosition light_position_object_space 0
param_named_auto eyePosition camera_position_object_space
param_named_auto worldViewProj worldviewproj_matrix
param_named shininess float 10
}
preprocessor_defines CLEVERTECHNIQUE,NUMTHINGS=2
attach myExteranalGLSLFunction1 myExteranalGLSLFunction2
}
-}