module RSAGL.Modeling.Material
(module RSAGL.Modeling.Color,
MaterialLayer,MaterialSurface,Material,materialIsEmpty,
toLayers,materialLayerSurface,materialLayerRelevant,materialComplexity,materialLayerToOpenGLWrapper,
isOpaqueLayer,
diffuseLayer,RSAGL.Modeling.Material.specularLayer,transparentLayer,emissiveLayer,filteringLayer)
where
import Data.Maybe
import Data.Monoid
import Control.Applicative
import RSAGL.Modeling.Color
import RSAGL.Math.Curve
import RSAGL.Auxiliary.ApplicativeWrapper
import Control.Parallel.Strategies
import Graphics.Rendering.OpenGL.GL hiding (RGB,RGBA)
import RSAGL.Types
type MaterialSurface a = ApplicativeWrapper Surface a
data MaterialLayer =
DiffuseLayer (MaterialSurface RGB)
| TransparentLayer (MaterialSurface RGBA)
| EmissiveLayer (MaterialSurface RGB)
| SpecularLayer (MaterialSurface RGB) GLfloat
| CompoundLayer (MaterialSurface RGB) RGB RGB GLfloat
| FilterLayer (MaterialSurface RGB)
instance NFData MaterialLayer where
rnf (DiffuseLayer msrgb) = rnf msrgb
rnf (TransparentLayer msrgba) = rnf msrgba
rnf (EmissiveLayer msrgb) = rnf msrgb
rnf (SpecularLayer msrgb shininess) = shininess `seq` rnf msrgb
rnf (CompoundLayer msrgb spec emis shininess) = shininess `seq` rnf (msrgb,spec,emis)
rnf (FilterLayer msrgb) = rnf msrgb
data Material = Material [MaterialLayer]
toLayers :: Material -> [MaterialLayer]
toLayers (Material layers) = layers
combineLayers :: [MaterialLayer] -> [MaterialLayer]
combineLayers (x1:x2:xs) | Just x <- combine2Layers x1 x2 =
let combine_here = combineLayers $ x : xs
combine_rest = combineLayers $ x2 : xs
in case length combine_rest < length combine_here of
True -> combineLayers $ x1 : combine_rest
False -> combine_here
combineLayers (x:xs) = x : combineLayers xs
combineLayers xs = xs
combine2Layers :: MaterialLayer -> MaterialLayer -> Maybe MaterialLayer
combine2Layers (DiffuseLayer msrgb) (SpecularLayer specular_rgb shininess) | isPure specular_rgb =
Just $ CompoundLayer msrgb (fromJust $ fromPure $ specular_rgb) (RGB 0 0 0) shininess
combine2Layers (DiffuseLayer msrgb) (EmissiveLayer emissive_rgb) | isPure emissive_rgb =
Just $ CompoundLayer msrgb (RGB 0 0 0) (fromJust $ fromPure $ emissive_rgb) 0
combine2Layers (EmissiveLayer x) (EmissiveLayer y) = Just $ EmissiveLayer $ addRGB <$> x <*> y
combine2Layers (CompoundLayer msrgb specular_rgb emissive_rgb1 shininess) (EmissiveLayer emissive_rgb2) | isPure emissive_rgb2 =
Just $ CompoundLayer msrgb specular_rgb (addRGB emissive_rgb1 (fromJust $ fromPure $ emissive_rgb2)) shininess
combine2Layers (CompoundLayer msrgb (RGB 0 0 0) emissive_rgb 0) (SpecularLayer specular_rgb shininess) | isPure specular_rgb =
Just $ CompoundLayer msrgb (fromJust $ fromPure $ specular_rgb) emissive_rgb shininess
combine2Layers (FilterLayer x) (FilterLayer y) =
Just $ FilterLayer $ filterRGB <$> x <*> y
combine2Layers _ _ = Nothing
instance Monoid Material where
mempty = Material []
mappend (Material xs) (Material ys) = Material $ combineLayers $ (\zs -> if null (snd zs) then fst zs else snd zs) $
span (not . isOpaqueLayer) $ xs ++ ys
materialIsEmpty :: Material -> Bool
materialIsEmpty (Material xs) = null xs
materialLayerComplexity :: MaterialLayer -> Integer
materialLayerComplexity layer | fromPure (materialLayerRelevant layer) == Just False = 0
materialLayerComplexity (DiffuseLayer ms) | fromPure ms == Just (RGB 0 0 0) = 0
materialLayerComplexity (DiffuseLayer ms) | isPure ms = 1
materialLayerComplexity (DiffuseLayer {}) = 2
materialLayerComplexity (TransparentLayer ms) | isPure ms = 1
materialLayerComplexity (TransparentLayer {}) = 2
materialLayerComplexity (EmissiveLayer ms) | isPure ms = 0
materialLayerComplexity (EmissiveLayer {}) = 2
materialLayerComplexity (SpecularLayer ms _) | isPure ms = 3
materialLayerComplexity (SpecularLayer {}) = 4
materialLayerComplexity (CompoundLayer {}) = 3
materialLayerComplexity (FilterLayer ms) | isPure ms = 0
materialLayerComplexity (FilterLayer {}) = 2
materialComplexity :: Material -> Integer
materialComplexity (Material []) = 0
materialComplexity (Material layers) = maximum $ map materialLayerComplexity layers
isOpaqueLayer :: MaterialLayer -> Bool
isOpaqueLayer (DiffuseLayer _) = True
isOpaqueLayer (TransparentLayer ms) | fmap rgba_a (fromPure ms) == Just 1.0 = True
isOpaqueLayer (CompoundLayer _ _ _ _) = True
isOpaqueLayer _ = False
isEmissiveRelevant :: RGB -> Bool
isEmissiveRelevant (RGB r g b) | r <= 0 && g <= 0 && b <= 0 = False
isEmissiveRelevant _ = True
isFilterRelevant :: RGB -> Bool
isFilterRelevant (RGB r g b) | r >= 1 && g >= 1 && b >= 1 = False
isFilterRelevant _ = True
isTransparentRelevant :: RGBA -> Bool
isTransparentRelevant (RGBA 0 _) = False
isTransparentRelevant _ = True
materialLayerSurface :: MaterialLayer -> MaterialSurface RGBA
materialLayerSurface (DiffuseLayer msrgb) = fmap toRGBA msrgb
materialLayerSurface (TransparentLayer msrgba) = msrgba
materialLayerSurface (EmissiveLayer msrgb) = fmap toRGBA msrgb
materialLayerSurface (SpecularLayer msrgb _) = fmap toRGBA msrgb
materialLayerSurface (CompoundLayer msrgb _ _ _) = fmap toRGBA msrgb
materialLayerSurface (FilterLayer msrgb) = fmap toRGBA msrgb
materialLayerRelevant :: MaterialLayer -> MaterialSurface Bool
materialLayerRelevant (DiffuseLayer {}) = pure True
materialLayerRelevant (TransparentLayer msrgba) = fmap isTransparentRelevant msrgba
materialLayerRelevant (EmissiveLayer msrgb) = fmap isEmissiveRelevant msrgb
materialLayerRelevant (SpecularLayer msrgb _) = fmap isEmissiveRelevant msrgb
materialLayerRelevant (CompoundLayer {}) = pure True
materialLayerRelevant (FilterLayer msrgb) = fmap isFilterRelevant msrgb
materialLayerToOpenGLWrapper :: MaterialLayer -> IO () -> IO ()
materialLayerToOpenGLWrapper (DiffuseLayer ms) io =
do cm <- get colorMaterial
materialEmission FrontAndBack $= Color4 0 0 0 1
materialSpecular FrontAndBack $= Color4 0 0 0 1
colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse)
maybe (return ()) (color . rgbToOpenGL) $ fromPure ms
io
colorMaterial $= cm
materialLayerToOpenGLWrapper (TransparentLayer ms) io =
do cm <- get colorMaterial
materialEmission FrontAndBack $= Color4 0 0 0 1
materialSpecular FrontAndBack $= Color4 0 0 0 1
colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse)
maybe (return ()) (color . rgbaToOpenGL) $ fromPure ms
alphaBlendWrapper io
colorMaterial $= cm
materialLayerToOpenGLWrapper (EmissiveLayer ms) io =
do l <- get lighting
lighting $= Disabled
maybe (return ()) (color . rgbToOpenGL) $ fromPure ms
additiveBlendWrapper io
lighting $= l
materialLayerToOpenGLWrapper (SpecularLayer ms shininess) io =
do cm <- get colorMaterial
lmlv <- get lightModelLocalViewer
materialShininess FrontAndBack $= shininess
materialAmbientAndDiffuse FrontAndBack $= Color4 0 0 0 1
materialEmission FrontAndBack $= Color4 0 0 0 1
colorMaterial $= Just (FrontAndBack,Specular)
lightModelLocalViewer $= Enabled
maybe (return ()) (color . rgbToOpenGL) $ fromPure ms
additiveBlendWrapper io
colorMaterial $= cm
lightModelLocalViewer $= lmlv
materialLayerToOpenGLWrapper (CompoundLayer ms specular_rgb emissive_rgb shininess) io =
do cm <- get colorMaterial
lmlv <- get lightModelLocalViewer
materialSpecular FrontAndBack $= (\(RGB r g b) -> Color4 (f2f r) (f2f g) (f2f b) 1) specular_rgb
materialShininess FrontAndBack $= shininess
materialEmission FrontAndBack $= (\(RGB r g b) -> Color4 (f2f r) (f2f g) (f2f b) 1) emissive_rgb
colorMaterial $= Just (FrontAndBack,AmbientAndDiffuse)
lightModelLocalViewer $= Enabled
maybe (return ()) (color . rgbToOpenGL) $ fromPure ms
io
colorMaterial $= cm
lightModelLocalViewer $= lmlv
materialLayerToOpenGLWrapper (FilterLayer ms) io =
do l <- get lighting
lighting $= Disabled
maybe (return ()) (color . rgbToOpenGL) $ fromPure ms
filterBlendWrapper io
lighting $= l
alphaBlendWrapper :: IO () -> IO ()
alphaBlendWrapper io =
do bf <- get blendFunc
b <- get blend
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
blend $= Enabled
io
blendFunc $= bf
blend $= b
additiveBlendWrapper :: IO () -> IO ()
additiveBlendWrapper io =
do bf <- get blendFunc
b <- get blend
blendFunc $= (One,One)
blend $= Enabled
io
blendFunc $= bf
blend $= b
filterBlendWrapper :: IO () -> IO ()
filterBlendWrapper io =
do bf <- get blendFunc
b <- get blend
blendFunc $= (DstColor,Zero)
blend $= Enabled
io
blendFunc $= bf
blend $= b
diffuseLayer :: MaterialSurface RGB -> Material
diffuseLayer msrgb = Material [DiffuseLayer msrgb]
specularLayer :: MaterialSurface RGB -> GLfloat -> Material
specularLayer msrgb x = Material [SpecularLayer msrgb x]
transparentLayer :: MaterialSurface RGBA -> Material
transparentLayer msrgba = Material [TransparentLayer msrgba]
emissiveLayer :: MaterialSurface RGB -> Material
emissiveLayer msrgb = Material [EmissiveLayer msrgb]
filteringLayer :: MaterialSurface RGB -> Material
filteringLayer msrgb = Material [FilterLayer msrgb]