Ridged.hs

-- Copyright (c) 2011, Colin Hill

-- | Implementation of ridged multi-fractal noise.
--
-- Example of use:
--
-- @
--main = putStrLn (\"Noise value at (1, 2, 3): \" ++ show x)
--    where seed        = 1
--          octaves     = 5
--          scale       = 0.005
--          frequency   = 1
--          lacunarity  = 2
--          ridgedNoise = ridged seed octaves scale frequency lacunarity
--          x           = noiseValue ridgedNoise (1, 2, 3)
-- @
module Numeric.Noise.Ridged (
    Ridged,
    ridged,
    noiseValue
) where

import Numeric.Noise

import Data.Bits ((.&.))
import Data.Vector.Unboxed (Vector, fromList, (!))

-- | A ridged multi-fractal noise function.
data Ridged = Ridged Seed Int Double Double Double (Vector Double)

-- | Constructs a ridged multi-fractal noise function given a seed, number of octaves, scale, 
-- frequency, and lacunarity.
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

-- | Computes the noise value for a ridged multi-fractal noise function given the octave number, 
-- the weight, and the point.
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

-- | Computes the spectral weight for each oct given the number of octs and the lac.
computeSpecWeights :: Int -> Double -> Vector Double
computeSpecWeights octs lac = fromList (computeSpecWeights' octs lac 1)

-- | Helper for 'computeSpecWeights'.
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'