-- 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 :: Int -> Int -> Double -> Double -> Double -> Ridged
ridged Int
seed Int
octs Double
scale Double
freq Double
lac = Ridged
ridgedNoise
    where specWeights :: Vector Double
specWeights = Int -> Double -> Vector Double
computeSpecWeights Int
octs Double
lac
          ridgedNoise :: Ridged
ridgedNoise = Int -> Int -> Double -> Double -> Double -> Vector Double -> Ridged
Ridged Int
seed Int
octs Double
scale Double
freq Double
lac Vector Double
specWeights

instance Noise Ridged where
    noiseValue :: Ridged -> Point -> Double
noiseValue Ridged
ridgedNoise Point
xyz = forall a. Ord a => a -> a -> a -> a
clamp Double
noise (-Double
1) Double
1
        where Ridged Int
_ Int
octs Double
scale Double
freq Double
_ Vector Double
_ = Ridged
ridgedNoise
              xyz' :: Point
xyz'  = (Double -> Double) -> Point -> Point
pmap (forall a. Num a => a -> a -> a
* (Double
scale forall a. Num a => a -> a -> a
* Double
freq)) Point
xyz
              noise :: Double
noise = Ridged -> Int -> Double -> Point -> Double
ridgedNoiseValue Ridged
ridgedNoise Int
octs Double
1 Point
xyz' forall a. Num a => a -> a -> a
* Double
1.25 forall a. Num a => a -> a -> a
- Double
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 :: Ridged -> Int -> Double -> Point -> Double
ridgedNoiseValue Ridged
_           Int
0   Double
_      Point
_   = Double
0
ridgedNoiseValue Ridged
ridgedNoise Int
oct Double
weight Point
xyz = Double
noise forall a. Num a => a -> a -> a
+ Double
noise'
    where Ridged Int
seed Int
octs Double
_ Double
_ Double
lac Vector Double
specWeights = Ridged
ridgedNoise
          oct' :: Int
oct'    = Int
oct forall a. Num a => a -> a -> a
- Int
1
          xyz' :: Point
xyz'    = (Double -> Double) -> Point -> Point
pmap (forall a. Num a => a -> a -> a
* Double
lac) Point
xyz
          seed' :: Int
seed'   = (Int
seed forall a. Num a => a -> a -> a
+ (Int
octs forall a. Num a => a -> a -> a
- Int
oct)) forall a. Bits a => a -> a -> a
.&. Int
0x7fffffff
          signal :: Double
signal  = (Double
offset forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs (Int -> Point -> Double
coherentNoise Int
seed' Point
xyz)) forall a. Num a => a -> a -> a
* Double
weight forall a. Num a => a -> a -> a
* Double
weight
          weight' :: Double
weight' = forall a. Ord a => a -> a -> a -> a
clamp (Double
signal forall a. Num a => a -> a -> a
* Double
gain) Double
0 Double
1
          noise :: Double
noise   = Double
signal forall a. Num a => a -> a -> a
* (Vector Double
specWeights forall a. Unbox a => Vector a -> Int -> a
! (Int
octs forall a. Num a => a -> a -> a
- Int
oct))
          noise' :: Double
noise'  = Ridged -> Int -> Double -> Point -> Double
ridgedNoiseValue Ridged
ridgedNoise Int
oct' Double
weight' Point
xyz'
          gain :: Double
gain    = Double
2
          offset :: Double
offset  = Double
1

-- | Computes the spectral weight for each oct given the number of octs and the lac.

computeSpecWeights :: Int -> Double -> Vector Double
computeSpecWeights :: Int -> Double -> Vector Double
computeSpecWeights Int
octs Double
lac = forall a. Unbox a => [a] -> Vector a
fromList (Int -> Double -> Double -> [Double]
computeSpecWeights' Int
octs Double
lac Double
1)

-- | Helper for 'computeSpecWeights'.

computeSpecWeights' :: Int -> Double -> Double -> [Double]
computeSpecWeights' :: Int -> Double -> Double -> [Double]
computeSpecWeights' Int
0   Double
_   Double
_    = []
computeSpecWeights' Int
oct Double
lac Double
freq = Double
weight forall a. a -> [a] -> [a]
: [Double]
weights
    where freq' :: Double
freq'   = Double
freq forall a. Num a => a -> a -> a
* Double
lac
          oct' :: Int
oct'    = Int
oct forall a. Num a => a -> a -> a
- Int
1
          weight :: Double
weight  = Double
freq forall a. Floating a => a -> a -> a
** (-Double
1)
          weights :: [Double]
weights = Int -> Double -> Double -> [Double]
computeSpecWeights' Int
oct' Double
lac Double
freq'