module Math.Noise.NoiseModule where
import Control.Applicative
import Data.Maybe
import Data.Typeable
class NoiseClass n where
getNoiseValue :: n -> [NoiseModule] -> (Double, Double, Double) -> Maybe Double
getValue :: n -> (Double, Double, Double) -> Maybe Double
getValue n i = getNoiseValue n [] i
gen :: n -> NoiseModule
gen n = NoiseModule (sanitize n) []
sanitize :: n -> n
sanitize = id
data NoiseModule = forall n. (NoiseClass n) => NoiseModule { noiseFunc :: n
, sources :: [NoiseModule]
}
instance NoiseClass NoiseModule where
getNoiseValue (NoiseModule n srcs ) src2 (x, y, z) = getNoiseValue n (src2 ++ srcs) (x, y, z)
gen = id
data ZeroNoise = ZeroNoise
instance NoiseClass ZeroNoise where
getNoiseValue _ _ _ = Just 0.0
data OneNoise = OneNoise
instance NoiseClass OneNoise where
getNoiseValue _ _ _ = Just 1.0
instance NoiseClass (Maybe a) where
getNoiseValue _ _ _ = Nothing
zero :: NoiseModule
zero = NoiseModule { noiseFunc = ZeroNoise , sources = [] }
one :: NoiseModule
one = NoiseModule { noiseFunc = OneNoise, sources = [] }
isSourceOf :: (NoiseClass a, NoiseClass b) => a -> b -> NoiseModule
isSourceOf s1 n = NoiseModule { noiseFunc = n, sources = [gen s1] }
andModule :: (NoiseClass a, NoiseClass b) => a -> b -> NoiseModule
andModule s1 s2 = NoiseModule Nothing [gen s1, gen s2]
areSourcesOf :: (NoiseClass a) => NoiseModule -> a -> NoiseModule
areSourcesOf mod n = setSrcs . gen $ n
where
setSrcs (NoiseModule f _) = NoiseModule f (fetchSrcs mod [])
fetchSrcs :: NoiseModule -> [NoiseModule] -> [NoiseModule]
fetchSrcs (NoiseModule nfunc [s1, s2] ) accum = fetchSrcs s1 (gen s2 : accum)
fetchSrcs (NoiseModule nfunc []) accum = (gen nfunc) : accum