{-# 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 [] [unlimited | numMipMaps] [alpha] [] [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 [lightType] -- Format 2: iteration [ [lightType]] -- Format 3: iteration [ [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 [] [unlimited | numMipMaps] [alpha] [] [gamma] <|> mkTU_Texture <$= "texture" <*> pName <*> pList pTextureContent -- Format1 (short): anim_texture -- <|> mkTU_animtexture <$= "anim_texture" <*> pName <*> pInt <*> pFloat -- Format2 (long): anim_texture ... -- <|> TU_animtexture <$= "anim_texture" <*> pList pName <*> pFloat <|> (\a b -> TU_animtexture b a) <$= "anim_texture" <*> pFloat <*> pList pName -- Format2 (long): cubic_texture separateUV <|> TU_cubictexture <$= "cubic_texture" <*> pName <*> pName <*> pName <*> pName <*> pName <*> pName <*= "separateUV" <*> pSucceed False -- Format1 (short): cubic_texture <|> 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 [] <|> TU_texaddressmode <$= "tex_address_mode" <*> pEnum texaddressVals <*> pEnum texaddressVals <*> (pEnum texaddressVals <|> pSucceed TAM_WRAP) -- Simple Format: tex_address_mode <|> (\a -> TU_texaddressmode a a a) <$= "tex_address_mode" <*> pEnum texaddressVals <|> TU_texbordercolour <$= "tex_border_colour" <*> pRGBOrRGBA 1 -- Format: filtering <|> (\a b c -> TU_filtering (a,b,c)) <$= "filtering" <*> pEnum filteringVals <*> pEnum filteringVals <*> pEnum filteringVals -- Format: filtering <|> 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 [] [] [] <|> 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 <|> 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 <|> 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 <|> 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 mkTU_animtexture basename numframes duration = TU_animtexture [f basename $ show i | i <- [0..(numframes-1)]] duration {- -- texture [] [unlimited | numMipMaps] [alpha] [] [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 --format: param_indexed_auto --format: param_named --format: param_named_auto --The value of 'type' can be float4, matrix4x4, float, int4, int --("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 } -}