module Numeric.Noise.Ridged (
Ridged,
ridged,
noiseValue
) where
import Numeric.Noise
import Data.Bits ((.&.))
import Data.Vector.Unboxed (Vector, fromList, (!))
data Ridged = Ridged Seed Int Double Double Double (Vector Double)
ridged :: Seed -> Int -> Double -> Double -> Double -> Ridged
ridged seed octs scale freq lac = ridgedNoise
where specWeights = computeSpecWeights octs lac
ridgedNoise = Ridged seed octs scale freq lac specWeights
instance Noise Ridged where
noiseValue ridgedNoise xyz = clamp noise (1) 1
where Ridged _ octs scale freq _ _ = ridgedNoise
xyz' = pmap (* (scale * freq)) xyz
noise = ridgedNoiseValue ridgedNoise octs 1 xyz' * 1.25 1
ridgedNoiseValue :: Ridged -> Int -> Double -> Point -> Double
ridgedNoiseValue _ 0 _ _ = 0
ridgedNoiseValue ridgedNoise oct weight xyz = noise + noise'
where Ridged seed octs _ _ lac specWeights = ridgedNoise
oct' = oct 1
xyz' = pmap (* lac) xyz
seed' = (seed + (octs oct)) .&. 0x7fffffff
signal = (offset abs (coherentNoise seed' xyz)) * weight * weight
weight' = clamp (signal * gain) 0 1
noise = signal * (specWeights ! (octs oct))
noise' = ridgedNoiseValue ridgedNoise oct' weight' xyz'
gain = 2
offset = 1
computeSpecWeights :: Int -> Double -> Vector Double
computeSpecWeights octs lac = fromList (computeSpecWeights' octs lac 1)
computeSpecWeights' :: Int -> Double -> Double -> [Double]
computeSpecWeights' 0 _ _ = []
computeSpecWeights' oct lac freq = weight : weights
where freq' = freq * lac
oct' = oct 1
weight = freq ** (1)
weights = computeSpecWeights' oct' lac freq'