{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

-- |
-- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>
-- Stability : experimental
module Numeric.Noise.Fractal (
  -- * Configuration
  FractalConfig (..),
  defaultFractalConfig,
  PingPongStrength (..),
  defaultPingPongStrength,

  -- * 2D Noise
  fractal2,
  billow2,
  ridged2,
  pingPong2,

  -- * 3D Noise
  fractal3,
  billow3,
  ridged3,
  pingPong3,

  -- * Utility
  fractalNoiseMod,
  fractalAmpMod,
  billowNoiseMod,
  billowAmpMod,
  ridgedNoiseMod,
  ridgedAmpMod,
  pingPongNoiseMod,
  pingPongAmpMod,
) where

import GHC.Generics
import Numeric.Noise.Internal

-- | Configuration for fractal noise generation.
--
-- Fractal noise combines multiple octaves (layers) of noise at different
-- frequencies and amplitudes to create more complex, natural-looking patterns.
data FractalConfig a = FractalConfig
  { forall a. FractalConfig a -> Int
octaves :: Int
  -- ^ Number of noise layers to combine. More octaves create more detail
  -- but are more expensive to compute. Must be \( >= 1 \).
  , forall a. FractalConfig a -> a
lacunarity :: a
  -- ^ Frequency multiplier between octaves. Each octave's frequency is
  -- the previous octave's frequency multiplied by lacunarity.
  , forall a. FractalConfig a -> a
gain :: a
  -- ^ Amplitude multiplier between octaves. Each octave's amplitude is
  -- the previous octave's amplitude multiplied by gain.
  -- Values \( < 1 \) create smoother noise, values \( > 1 \) create rougher noise.
  , forall a. FractalConfig a -> a
weightedStrength :: a
  -- ^ Controls how much each octave's amplitude is influenced by the
  -- previous octave's value. At 0, octaves have independent amplitudes.
  -- At 1, lower-valued areas in previous octaves reduce the amplitude
  -- of subsequent octaves. Range: \( [0, 1] \).
  }
  deriving ((forall x. FractalConfig a -> Rep (FractalConfig a) x)
-> (forall x. Rep (FractalConfig a) x -> FractalConfig a)
-> Generic (FractalConfig a)
forall x. Rep (FractalConfig a) x -> FractalConfig a
forall x. FractalConfig a -> Rep (FractalConfig a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FractalConfig a) x -> FractalConfig a
forall a x. FractalConfig a -> Rep (FractalConfig a) x
$cfrom :: forall a x. FractalConfig a -> Rep (FractalConfig a) x
from :: forall x. FractalConfig a -> Rep (FractalConfig a) x
$cto :: forall a x. Rep (FractalConfig a) x -> FractalConfig a
to :: forall x. Rep (FractalConfig a) x -> FractalConfig a
Generic, ReadPrec [FractalConfig a]
ReadPrec (FractalConfig a)
Int -> ReadS (FractalConfig a)
ReadS [FractalConfig a]
(Int -> ReadS (FractalConfig a))
-> ReadS [FractalConfig a]
-> ReadPrec (FractalConfig a)
-> ReadPrec [FractalConfig a]
-> Read (FractalConfig a)
forall a. Read a => ReadPrec [FractalConfig a]
forall a. Read a => ReadPrec (FractalConfig a)
forall a. Read a => Int -> ReadS (FractalConfig a)
forall a. Read a => ReadS [FractalConfig a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (FractalConfig a)
readsPrec :: Int -> ReadS (FractalConfig a)
$creadList :: forall a. Read a => ReadS [FractalConfig a]
readList :: ReadS [FractalConfig a]
$creadPrec :: forall a. Read a => ReadPrec (FractalConfig a)
readPrec :: ReadPrec (FractalConfig a)
$creadListPrec :: forall a. Read a => ReadPrec [FractalConfig a]
readListPrec :: ReadPrec [FractalConfig a]
Read, Int -> FractalConfig a -> ShowS
[FractalConfig a] -> ShowS
FractalConfig a -> String
(Int -> FractalConfig a -> ShowS)
-> (FractalConfig a -> String)
-> ([FractalConfig a] -> ShowS)
-> Show (FractalConfig a)
forall a. Show a => Int -> FractalConfig a -> ShowS
forall a. Show a => [FractalConfig a] -> ShowS
forall a. Show a => FractalConfig a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FractalConfig a -> ShowS
showsPrec :: Int -> FractalConfig a -> ShowS
$cshow :: forall a. Show a => FractalConfig a -> String
show :: FractalConfig a -> String
$cshowList :: forall a. Show a => [FractalConfig a] -> ShowS
showList :: [FractalConfig a] -> ShowS
Show, FractalConfig a -> FractalConfig a -> Bool
(FractalConfig a -> FractalConfig a -> Bool)
-> (FractalConfig a -> FractalConfig a -> Bool)
-> Eq (FractalConfig a)
forall a. Eq a => FractalConfig a -> FractalConfig a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FractalConfig a -> FractalConfig a -> Bool
== :: FractalConfig a -> FractalConfig a -> Bool
$c/= :: forall a. Eq a => FractalConfig a -> FractalConfig a -> Bool
/= :: FractalConfig a -> FractalConfig a -> Bool
Eq)

-- | Default configuration for fractal noise generation.
defaultFractalConfig :: (RealFrac a) => FractalConfig a
defaultFractalConfig :: forall a. RealFrac a => FractalConfig a
defaultFractalConfig =
  FractalConfig
    { octaves :: Int
octaves = Int
7
    , lacunarity :: a
lacunarity = a
2
    , gain :: a
gain = a
0.5
    , weightedStrength :: a
weightedStrength = a
0
    }
{-# INLINEABLE defaultFractalConfig #-}

-- | Apply Fractal Brownian Motion (FBM) to a 2D noise function.
--
-- FBM combines multiple octaves of noise at increasing frequencies and
-- decreasing amplitudes to create natural-looking, multi-scale patterns.
-- This is the standard fractal noise implementation.
--
-- @
-- fbm :: Noise2 Float
-- fbm = fractal2 defaultFractalConfig perlin2
-- @
fractal2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a
fractal2 :: forall a. RealFrac a => FractalConfig a -> Noise2 a -> Noise2 a
fractal2 FractalConfig a
config = (Seed -> a -> a -> a) -> Noise2' a a
forall p v. (Seed -> p -> p -> v) -> Noise2' p v
mkNoise2 ((Seed -> a -> a -> a) -> Noise2' a a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Noise2' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
fractal2With a -> a
forall a. a -> a
fractalNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
fractalAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a) -> Seed -> a -> a -> a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Seed
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise2' a a -> Seed -> a -> a -> a
forall a. Noise2 a -> Seed -> a -> a -> a
noise2At
{-# INLINE [2] fractal2 #-}

-- | Apply billow fractal to a 2D noise function.
--
-- Billow creates a cloud-like or billowy appearance by taking the absolute
-- value of each octave. This produces sharp ridges in the negative regions
-- of the noise, creating a distinct puffy or cloudy look.
--
-- @
-- clouds :: Noise2 Float
-- clouds = billow2 defaultFractalConfig perlin2
-- @
billow2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a
billow2 :: forall a. RealFrac a => FractalConfig a -> Noise2 a -> Noise2 a
billow2 FractalConfig a
config = (Seed -> a -> a -> a) -> Noise2' a a
forall p v. (Seed -> p -> p -> v) -> Noise2' p v
mkNoise2 ((Seed -> a -> a -> a) -> Noise2' a a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Noise2' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
fractal2With a -> a
forall a. Num a => a -> a
billowNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
billowAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a) -> Seed -> a -> a -> a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Seed
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise2' a a -> Seed -> a -> a -> a
forall a. Noise2 a -> Seed -> a -> a -> a
noise2At
{-# INLINE [2] billow2 #-}

-- | Apply ridged fractal to a 2D noise function.
--
-- Ridged creates sharp ridges by inverting and taking the absolute value
-- of each octave. This is particularly useful for terrain generation,
-- creating mountain ridges and valleys.
--
-- @
-- mountains :: Noise2 Float
-- mountains = ridged2 defaultFractalConfig perlin2
-- @
ridged2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a
ridged2 :: forall a. RealFrac a => FractalConfig a -> Noise2 a -> Noise2 a
ridged2 FractalConfig a
config = (Seed -> a -> a -> a) -> Noise2' a a
forall p v. (Seed -> p -> p -> v) -> Noise2' p v
mkNoise2 ((Seed -> a -> a -> a) -> Noise2' a a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Noise2' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
fractal2With a -> a
forall a. Num a => a -> a
ridgedNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
ridgedAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a) -> Seed -> a -> a -> a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Seed
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise2' a a -> Seed -> a -> a -> a
forall a. Noise2 a -> Seed -> a -> a -> a
noise2At
{-# INLINE [2] ridged2 #-}

-- | Apply ping-pong fractal to a 2D noise function.
--
-- Ping-pong creates a wave-like pattern by folding the noise values back
-- and forth within a range, creating a distinctive undulating appearance.
-- The strength parameter controls the intensity of the ping-pong effect.
--
-- @
-- waves :: Noise2 Float
-- waves = pingPong2 defaultFractalConfig defaultPingPongStrength perlin2
-- @
pingPong2 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise2 a -> Noise2 a
pingPong2 :: forall a.
RealFrac a =>
FractalConfig a -> PingPongStrength a -> Noise2 a -> Noise2 a
pingPong2 FractalConfig a
config PingPongStrength a
strength =
  (Seed -> a -> a -> a) -> Noise2' a a
forall p v. (Seed -> p -> p -> v) -> Noise2' p v
mkNoise2 ((Seed -> a -> a -> a) -> Noise2' a a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Noise2' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
fractal2With (PingPongStrength a -> a -> a
forall a. RealFrac a => PingPongStrength a -> a -> a
pingPongNoiseMod PingPongStrength a
strength) (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
pingPongAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a) -> Seed -> a -> a -> a)
-> (Noise2' a a -> Seed -> a -> a -> a)
-> Noise2' a a
-> Seed
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise2' a a -> Seed -> a -> a -> a
forall a. Noise2 a -> Seed -> a -> a -> a
noise2At
{-# INLINE [2] pingPong2 #-}

fractal2With
  :: (RealFrac a)
  => (a -> a)
  -- ^ modify noise before summation
  -> (a -> a)
  -- ^ modify amplitude
  -> FractalConfig a
  -> (Seed -> a -> a -> a)
  -> Seed
  -> a
  -> a
  -> a
fractal2With :: forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a)
-> Seed
-> a
-> a
-> a
fractal2With a -> a
modNoise a -> a
modAmps FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} Seed -> a -> a -> a
noise2 Seed
seed a
x a
y
  | Int
octaves Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = a
0
  | Bool
otherwise =
      let !bounding :: a
bounding = FractalConfig a -> a
forall a. RealFrac a => FractalConfig a -> a
fractalBounding FractalConfig{a
Int
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..}
       in Int -> a -> Seed -> a -> a -> a
forall {t}. (Num t, Eq t) => t -> a -> Seed -> a -> a -> a
go Int
octaves a
0 Seed
seed a
1 a
bounding
 where
  go :: t -> a -> Seed -> a -> a -> a
go t
0 !a
acc !Seed
_ !a
_ !a
_ = a
acc
  go !t
o !a
acc !Seed
s !a
freq !a
amp =
    let !noise :: a
noise = a
amp a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
modNoise (Seed -> a -> a -> a
noise2 Seed
s (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
y))
        !amp' :: a
amp' = a
amp a -> a -> a
forall a. Num a => a -> a -> a
* a
gain a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
modAmps (a -> a -> a
forall a. Ord a => a -> a -> a
min (a
noise a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
2)
     in t -> a -> Seed -> a -> a -> a
go (t
o t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
noise) (Seed
s Seed -> Seed -> Seed
forall a. Num a => a -> a -> a
+ Seed
1) (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
lacunarity) a
amp'
{-# INLINE [1] fractal2With #-}

-- | Apply Fractal Brownian Motion (FBM) to a 3D noise function.
--
-- 3D version of 'fractal2'. See 'fractal2' for details.
fractal3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a
fractal3 :: forall a. RealFrac a => FractalConfig a -> Noise3 a -> Noise3 a
fractal3 FractalConfig a
config = (Seed -> a -> a -> a -> a) -> Noise3' a a
forall p v. (Seed -> p -> p -> p -> v) -> Noise3' p v
mkNoise3 ((Seed -> a -> a -> a -> a) -> Noise3' a a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Noise3' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
fractal3With a -> a
forall a. a -> a
fractalNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
fractalAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a -> a) -> Seed -> a -> a -> a -> a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Seed
-> a
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise3' a a -> Seed -> a -> a -> a -> a
forall a. Noise3 a -> Seed -> a -> a -> a -> a
noise3At
{-# INLINE [2] fractal3 #-}

-- | Apply billow fractal to a 3D noise function.
--
-- 3D version of 'billow2'. See 'billow2' for details.
billow3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a
billow3 :: forall a. RealFrac a => FractalConfig a -> Noise3 a -> Noise3 a
billow3 FractalConfig a
config = (Seed -> a -> a -> a -> a) -> Noise3' a a
forall p v. (Seed -> p -> p -> p -> v) -> Noise3' p v
mkNoise3 ((Seed -> a -> a -> a -> a) -> Noise3' a a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Noise3' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
fractal3With a -> a
forall a. Num a => a -> a
billowNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
billowAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a -> a) -> Seed -> a -> a -> a -> a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Seed
-> a
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise3' a a -> Seed -> a -> a -> a -> a
forall a. Noise3 a -> Seed -> a -> a -> a -> a
noise3At
{-# INLINE [2] billow3 #-}

-- | Apply ridged fractal to a 3D noise function.
--
-- 3D version of 'ridged2'. See 'ridged2' for details.
ridged3 :: (RealFrac a) => FractalConfig a -> Noise3 a -> Noise3 a
ridged3 :: forall a. RealFrac a => FractalConfig a -> Noise3 a -> Noise3 a
ridged3 FractalConfig a
config = (Seed -> a -> a -> a -> a) -> Noise3' a a
forall p v. (Seed -> p -> p -> p -> v) -> Noise3' p v
mkNoise3 ((Seed -> a -> a -> a -> a) -> Noise3' a a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Noise3' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
fractal3With a -> a
forall a. Num a => a -> a
ridgedNoiseMod (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
ridgedAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a -> a) -> Seed -> a -> a -> a -> a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Seed
-> a
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise3' a a -> Seed -> a -> a -> a -> a
forall a. Noise3 a -> Seed -> a -> a -> a -> a
noise3At
{-# INLINE [2] ridged3 #-}

-- | Apply ping-pong fractal to a 3D noise function.
--
-- 3D version of 'pingPong2'. See 'pingPong2' for details.
pingPong3 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise3 a -> Noise3 a
pingPong3 :: forall a.
RealFrac a =>
FractalConfig a -> PingPongStrength a -> Noise3 a -> Noise3 a
pingPong3 FractalConfig a
config PingPongStrength a
strength =
  (Seed -> a -> a -> a -> a) -> Noise3' a a
forall p v. (Seed -> p -> p -> p -> v) -> Noise3' p v
mkNoise3 ((Seed -> a -> a -> a -> a) -> Noise3' a a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Noise3' a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
fractal3With (PingPongStrength a -> a -> a
forall a. RealFrac a => PingPongStrength a -> a -> a
pingPongNoiseMod PingPongStrength a
strength) (FractalConfig a -> a -> a
forall a. Num a => FractalConfig a -> a -> a
pingPongAmpMod FractalConfig a
config) FractalConfig a
config ((Seed -> a -> a -> a -> a) -> Seed -> a -> a -> a -> a)
-> (Noise3' a a -> Seed -> a -> a -> a -> a)
-> Noise3' a a
-> Seed
-> a
-> a
-> a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Noise3' a a -> Seed -> a -> a -> a -> a
forall a. Noise3 a -> Seed -> a -> a -> a -> a
noise3At
{-# INLINE [2] pingPong3 #-}

fractal3With
  :: (RealFrac a)
  => (a -> a)
  -- ^ modify noise before summation
  -> (a -> a)
  -- ^ modify amplitude
  -> FractalConfig a
  -> (Seed -> a -> a -> a -> a)
  -> Seed
  -> a
  -> a
  -> a
  -> a
fractal3With :: forall a.
RealFrac a =>
(a -> a)
-> (a -> a)
-> FractalConfig a
-> (Seed -> a -> a -> a -> a)
-> Seed
-> a
-> a
-> a
-> a
fractal3With a -> a
modNoise a -> a
modAmps FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} Seed -> a -> a -> a -> a
noise3 Seed
seed a
x a
y a
z
  | Int
octaves Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = a
0
  | Bool
otherwise =
      let !bounding :: a
bounding = FractalConfig a -> a
forall a. RealFrac a => FractalConfig a -> a
fractalBounding FractalConfig{a
Int
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..}
       in Int -> a -> Seed -> a -> a -> a
forall {t}. (Num t, Eq t) => t -> a -> Seed -> a -> a -> a
go Int
octaves a
0 Seed
seed a
1 a
bounding
 where
  go :: t -> a -> Seed -> a -> a -> a
go t
0 !a
acc !Seed
_ !a
_ !a
_ = a
acc
  go !t
o !a
acc !Seed
s !a
freq !a
amp =
    let !noise :: a
noise = a
amp a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
modNoise (Seed -> a -> a -> a -> a
noise3 Seed
s (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
y) (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
z))
        !amp' :: a
amp' = a
amp a -> a -> a
forall a. Num a => a -> a -> a
* a
gain a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
modAmps (a -> a -> a
forall a. Ord a => a -> a -> a
min (a
noise a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
2)
     in t -> a -> Seed -> a -> a -> a
go (t
o t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (a
acc a -> a -> a
forall a. Num a => a -> a -> a
+ a
noise) (Seed
s Seed -> Seed -> Seed
forall a. Num a => a -> a -> a
+ Seed
1) (a
freq a -> a -> a
forall a. Num a => a -> a -> a
* a
lacunarity) a
amp'
{-# INLINE [1] fractal3With #-}

fractalBounding :: (RealFrac a) => FractalConfig a -> a
fractalBounding :: forall a. RealFrac a => FractalConfig a -> a
fractalBounding FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} = a -> a
forall a. Fractional a => a -> a
recip ([a] -> a
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a]
amps a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
 where
  amps :: [a]
amps = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
octaves ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Num a => a -> a -> a
* a
gain) a
gain
{-# INLINE [2] fractalBounding #-}

-- | Identity noise modifier for standard FBM.
--
-- This is used internally by 'fractal2' and 'fractal3'.
-- Exposed for users creating custom fractal implementations.
fractalNoiseMod :: a -> a
fractalNoiseMod :: forall a. a -> a
fractalNoiseMod = a -> a
forall a. a -> a
id
{-# INLINE fractalNoiseMod #-}

-- | Amplitude modifier for standard FBM.
--
-- Uses the 'weightedStrength' parameter to influence amplitude based on
-- the previous octave's value. Exposed for custom fractal implementations.
fractalAmpMod :: (Num a) => FractalConfig a -> a -> a
fractalAmpMod :: forall a. Num a => FractalConfig a -> a -> a
fractalAmpMod FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} a
n = a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp a
1 a
n a
weightedStrength
{-# INLINE fractalAmpMod #-}

-- | Noise modifier for billow fractal.
--
-- Transforms noise value to @abs(n) * 2 - 1@, creating the billow effect.
-- Exposed for custom fractal implementations.
billowNoiseMod :: (Num a) => a -> a
billowNoiseMod :: forall a. Num a => a -> a
billowNoiseMod a
n = a -> a
forall a. Num a => a -> a
abs a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Num a => a -> a -> a
- a
1
{-# INLINE billowNoiseMod #-}

-- | Amplitude modifier for billow fractal.
--
-- Uses the 'weightedStrength' parameter. Exposed for custom fractal implementations.
billowAmpMod :: (Num a) => FractalConfig a -> a -> a
billowAmpMod :: forall a. Num a => FractalConfig a -> a -> a
billowAmpMod FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} a
n = a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp a
1 a
n a
weightedStrength
{-# INLINE billowAmpMod #-}

-- | Noise modifier for ridged fractal.
--
-- Transforms noise value to @abs(n) * (-2) + 1@, creating the ridge effect.
-- Exposed for custom fractal implementations.
ridgedNoiseMod :: (Num a) => a -> a
ridgedNoiseMod :: forall a. Num a => a -> a
ridgedNoiseMod a
n = a -> a
forall a. Num a => a -> a
abs a
n a -> a -> a
forall a. Num a => a -> a -> a
* (-a
2) a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
{-# INLINE ridgedNoiseMod #-}

-- | Amplitude modifier for ridged fractal.
--
-- Uses the 'weightedStrength' parameter with inverted noise value.
-- Exposed for custom fractal implementations.
ridgedAmpMod :: (Num a) => FractalConfig a -> a -> a
ridgedAmpMod :: forall a. Num a => FractalConfig a -> a -> a
ridgedAmpMod FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} a
n = a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp a
1 (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
n) a
weightedStrength
{-# INLINE ridgedAmpMod #-}

-- | Strength parameter for ping-pong fractal noise.
--
-- Controls the intensity of the ping-pong folding effect.
-- Higher values create more frequent oscillations.
newtype PingPongStrength a = PingPongStrength a
  deriving ((forall x. PingPongStrength a -> Rep (PingPongStrength a) x)
-> (forall x. Rep (PingPongStrength a) x -> PingPongStrength a)
-> Generic (PingPongStrength a)
forall x. Rep (PingPongStrength a) x -> PingPongStrength a
forall x. PingPongStrength a -> Rep (PingPongStrength a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PingPongStrength a) x -> PingPongStrength a
forall a x. PingPongStrength a -> Rep (PingPongStrength a) x
$cfrom :: forall a x. PingPongStrength a -> Rep (PingPongStrength a) x
from :: forall x. PingPongStrength a -> Rep (PingPongStrength a) x
$cto :: forall a x. Rep (PingPongStrength a) x -> PingPongStrength a
to :: forall x. Rep (PingPongStrength a) x -> PingPongStrength a
Generic)

-- | Default ping-pong strength value.
defaultPingPongStrength :: (RealFrac a) => PingPongStrength a
defaultPingPongStrength :: forall a. RealFrac a => PingPongStrength a
defaultPingPongStrength = a -> PingPongStrength a
forall a. a -> PingPongStrength a
PingPongStrength a
2
{-# INLINE defaultPingPongStrength #-}

-- | Noise modifier for ping-pong fractal.
--
-- Folds noise values back and forth within a range, creating a wave-like
-- pattern. The strength parameter controls the folding intensity.
-- Exposed for custom fractal implementations.
pingPongNoiseMod :: (RealFrac a) => PingPongStrength a -> a -> a
pingPongNoiseMod :: forall a. RealFrac a => PingPongStrength a -> a -> a
pingPongNoiseMod (PingPongStrength a
s) a
n =
  let n' :: a
n' = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
s
      t :: a
t = a
n' a -> a -> a
forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int (a -> Int
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
n' a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
   in a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a -> a
forall a. Num a => a -> a
abs (a
t a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
{-# INLINE pingPongNoiseMod #-}

-- | Amplitude modifier for ping-pong fractal.
--
-- Uses the 'weightedStrength' parameter. Exposed for custom fractal implementations.
pingPongAmpMod :: (Num a) => FractalConfig a -> a -> a
pingPongAmpMod :: forall a. Num a => FractalConfig a -> a -> a
pingPongAmpMod FractalConfig{a
Int
octaves :: forall a. FractalConfig a -> Int
lacunarity :: forall a. FractalConfig a -> a
gain :: forall a. FractalConfig a -> a
weightedStrength :: forall a. FractalConfig a -> a
octaves :: Int
lacunarity :: a
gain :: a
weightedStrength :: a
..} a
n = a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp a
1 a
n a
weightedStrength
{-# INLINE pingPongAmpMod #-}