pure-noise 0.1.0.1 → 0.2.0.0

raw patch · 18 files changed

+490/−131 lines, 18 filesdep +primitivedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: primitive

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +15/−15
• bench/Bench.hs +0/−1
• bench/BenchLib.hs +0/−0
• pure-noise.cabal +18/−12
• src/Numeric/Noise.hs +120/−12
• src/Numeric/Noise/Cellular.hs +119/−68
• src/Numeric/Noise/Fractal.hs +111/−6
• src/Numeric/Noise/Internal.hs +57/−0
• src/Numeric/Noise/Internal/Math.hs +26/−11
• src/Numeric/Noise/OpenSimplex.hs +0/−0
• src/Numeric/Noise/Perlin.hs +0/−2
• src/Numeric/Noise/SuperSimplex.hs +0/−0
• src/Numeric/Noise/Value.hs +0/−0
• src/Numeric/Noise/ValueCubic.hs +0/−0
• test/Noise2Spec.hs +0/−1
• test/Noise3Spec.hs +0/−1
• test/PerlinSpec.hs +5/−2

@@ -8,6 +8,25 @@  ## Unreleased +## 0.2.0.0 - 2025-10-21++### Added++- Comprehensive haddock documentation for main `Numeric.Noise` module with usage examples++### Changed++- Migrated internal implementation from `vector` to `primitive` (PrimArray)+- Removed `vector` dependency from library (still used in benchmarks)+- Require GHC 9.2+ (base >= 4.16)+- Hide internal modules from public API (`Numeric.Noise.Internal`, `Numeric.Noise.Internal.Math`)+- Improved cellular noise performance by 20-30% through specialized computation paths for different result types++### Fixed++- Fixed intermediate list allocation in fractal functions on GHC 9.6++- Improved division performance for `Noise3` instances+ ## 0.1.0.1 - 2024-10-15  - Add bounds for vector

@@ -42,35 +42,35 @@  | name          | values / second | | ------------- | --------------- |-| value2        | 157_347_680     |-| perlin2       | 129_541_747     |-| openSimplex2  | 64_758_006      |-| superSimplex2 | 64_072_639      |-| valueCubic2   | 52_110_819      |-| cellular2     | 15_743_434      |+| value2        | 156_797_694     |+| perlin2       | 138_048_921     |+| superSimplex2 | 65_204_214      |+| openSimplex2  | 64_483_692      |+| valueCubic2   | 50_666_467      |+| cellular2     | 20_819_883      |  #### 3D  | name        | values / second | | ----------- | --------------- |-| value3      | 85_438_023      |-| perlin3     | 56_830_482      |-| valueCubic3 | 15_559_523      |+| value3      | 83_034_432      |+| perlin3     | 60_233_650      |+| valueCubic3 | 15_220_433      |  ## Examples -There's an interactive [demo app](demo/README.md) in the `demo` directory.+There's an interactive [demo app](https://github.com/jtnuttall/pure-noise/tree/main/demo) in the `demo` directory.  _OpenSimplex2_ -![OpenSimplex2](demo/images/opensimplex.png)-![OpenSimplex2 ridged](demo/images/opensimplex-ridged.png)+![OpenSimplex2](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/opensimplex.png)+![OpenSimplex2 ridged](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/opensimplex-ridged.png)  _Perlin_ -![Perlin fBm](demo/images/perlin-fbm.png)+![Perlin fBm](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/perlin-fbm.png)  _Cellular_ -![value](demo/images/cell-value.png)-![distance2add](demo/images/cell-d2.png)+![value](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/cell-value.png)+![distance2add](https://raw.githubusercontent.com/jtnuttall/pure-noise/main/demo/images/cell-d2.png)

@@ -2,7 +2,6 @@ import Data.Typeable import Data.Vector.Unboxed qualified as U import Numeric.Noise-import Numeric.Noise.Internal (const2, const3) import System.Random.MWC qualified as MWC  main :: IO ()

@@ -1,13 +1,17 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack  name:           pure-noise-version:        0.1.0.1-synopsis:       Performant, modern noise generation for Haskell with minimal dependencies. Based on FastNoiseLite.-description:    Please see the README on GitHub at <https://github.com/jtnuttall/pure-noise#readme>+version:        0.2.0.0+synopsis:       High-performance composable noise generation (Perlin, Simplex, Cellular)+description:    A high-performance noise generation library ported from FastNoiseLite.+                Provides N-dimensional noise functions (Perlin, OpenSimplex, SuperSimplex,+                Value, Cellular) that can be composed using Num or Fractional methods with+                minimal performance overhead. Noise values are generally clamped to [-1, 1].+                Benefits significantly from LLVM backend compilation (~50-80% performance improvement). category:       Math, Numeric, Noise homepage:       https://github.com/jtnuttall/pure-noise#readme bug-reports:    https://github.com/jtnuttall/pure-noise/issues@@ -19,6 +23,7 @@ build-type:     Simple extra-source-files:     README.md+extra-doc-files:     CHANGELOG.md  source-repository head@@ -30,14 +35,14 @@       Numeric.Noise       Numeric.Noise.Cellular       Numeric.Noise.Fractal-      Numeric.Noise.Internal-      Numeric.Noise.Internal.Math       Numeric.Noise.OpenSimplex       Numeric.Noise.Perlin       Numeric.Noise.SuperSimplex       Numeric.Noise.Value       Numeric.Noise.ValueCubic   other-modules:+      Numeric.Noise.Internal+      Numeric.Noise.Internal.Math       Paths_pure_noise   autogen-modules:       Paths_pure_noise@@ -45,8 +50,8 @@       src   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:-      base >=4.7 && <5-    , vector <=0.14+      base >=4.16 && <5+    , primitive >=0.8 && <0.10   default-language: GHC2021  test-suite pure-noise-test@@ -63,13 +68,13 @@       test   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-missing-export-lists -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >=4.7 && <5+      base >=4.16 && <5+    , primitive >=0.8 && <0.10     , pure-noise     , tasty     , tasty-discover     , tasty-hunit     , tasty-quickcheck-    , vector <=0.14   default-language: GHC2021  benchmark pure-noise-bench@@ -82,11 +87,12 @@       Paths_pure_noise   hs-source-dirs:       bench-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N +RTS -A32m --nonmoving-gc -T -RTS -O2 -optc-O3 -fproc-alignment=64 -fsimpl-tick-factor=1000+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N +RTS -A32m --nonmoving-gc -T -RTS -O2 -optc-O3 -fsimpl-tick-factor=1000   build-depends:-      base >=4.7 && <5+      base >=4.16 && <5     , deepseq     , mwc-random+    , primitive >=0.8 && <0.10     , pure-noise     , tasty     , tasty-bench

@@ -3,15 +3,60 @@ -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability : experimental+--+-- Performant noise generation with composable noise functions.+--+-- Noise functions are wrapped in 'Noise2' and 'Noise3' newtypes that abstract over+-- the seed and coordinate parameters. These can be composed using 'Num' or 'Fractional'+-- methods with minimal performance overhead.+--+-- Noise values are generally clamped to @[-1, 1]@, though some functions may+-- occasionally produce values slightly outside this range.+--+-- == Basic Usage+--+-- Generate 2D Perlin noise:+--+-- @+-- import Numeric.Noise qualified as Noise+--+-- myNoise :: Noise.Seed -> Float -> Float -> Float+-- myNoise = Noise.noise2At Noise.perlin2+-- @+--+-- Compose multiple noise functions:+--+-- @+-- combined :: (RealFrac a) => Noise.Noise2 a+-- combined = (Noise.perlin2 + Noise.superSimplex2) / 2+--+-- myNoise2 :: Noise.Seed -> Float -> Float -> Float+-- myNoise2 = Noise.noise2At combined+-- @+--+-- Apply fractal Brownian motion:+--+-- @+-- fbm :: (RealFrac a) => Noise.Noise2 a+-- fbm = Noise.fractal2 Noise.defaultFractalConfig Noise.perlin2+-- @ module Numeric.Noise (-  -- * Noise functions+  -- * Core Types -  -- ** Noise functions+  --++  -- | 'Noise2' and 'Noise3' are newtypes wrapping noise functions. They can be+  -- unwrapped with 'noise2At' and 'noise3At' respectively.+  --+  -- 'Seed' is a 'Word64' value used for deterministic noise generation.   module NoiseTypes,++  -- * Noise evaluation   noise2At,   noise3At,    -- ** 2D Noise+  const2,   cellular2,   openSimplex2,   superSimplex2,@@ -20,6 +65,7 @@   valueCubic2,    -- ** 3D Noise+  const3,   perlin3,   value3,   valueCubic3,@@ -29,21 +75,51 @@   -- ** Math utility functions   module NoiseUtility, -  -- ** Fractal Brownian Motion-  module Fractal,+  -- ** Fractal noise composition +  --++  -- | Fractal noise combines multiple octaves at different frequencies and+  -- amplitudes to create natural-looking, multi-scale patterns.+  --+  -- For custom fractal implementations using modifier functions, see+  -- "Numeric.Noise.Fractal".++  -- *** Configuration+  FractalConfig (..),+  defaultFractalConfig,+  PingPongStrength (..),+  defaultPingPongStrength,++  -- *** Fractal Brownian Motion (FBM)+  fractal2,+  fractal3,++  -- *** Fractal variants+  billow2,+  billow3,+  ridged2,+  ridged3,+  pingPong2,+  pingPong3,+   -- ** Cellular noise configuration-  module Cellular,-) where -import Numeric.Noise.Cellular as Cellular (+  --++  -- | Cellular (Worley) noise creates patterns based on distances to+  -- randomly distributed cell points.++  -- *** Configuration   CellularConfig (..),+  defaultCellularConfig,   CellularDistanceFn (..),   CellularResult (..),-  defaultCellularConfig,- )+) where++import Numeric.Noise.Cellular (CellularConfig, CellularDistanceFn (..), CellularResult (..), defaultCellularConfig) import Numeric.Noise.Cellular qualified as Cellular-import Numeric.Noise.Fractal as Fractal+import Numeric.Noise.Fractal import Numeric.Noise.Internal import Numeric.Noise.Internal as NoiseTypes (   Noise2,@@ -67,46 +143,78 @@ import Numeric.Noise.Value qualified as Value import Numeric.Noise.ValueCubic qualified as ValueCubic -noise2At :: Noise2 a -> Seed -> a -> a -> a+-- | Evaluate a 2D noise function at the given coordinates with the given seed.+noise2At+  :: Noise2 a+  -> Seed+  -- ^ deterministic seed+  -> a+  -- ^ x coordinate+  -> a+  -- ^ y coordinate+  -> a noise2At = unNoise2 {-# INLINE noise2At #-} +-- | 2D Cellular (Worley) noise. Configure with 'CellularConfig' to control+-- distance functions and return values. cellular2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a cellular2 = Cellular.noise2 {-# INLINE cellular2 #-} +-- | 2D OpenSimplex noise. Smooth gradient noise similar to Perlin but without+-- directional artifacts. openSimplex2 :: (RealFrac a) => Noise2 a openSimplex2 = OpenSimplex.noise2 {-# INLINE openSimplex2 #-} +-- | 2D SuperSimplex noise. Improved OpenSimplex variant with better visual+-- characteristics. superSimplex2 :: (RealFrac a) => Noise2 a superSimplex2 = SuperSimplex.noise2 {-# INLINE superSimplex2 #-} +-- | 2D Perlin noise. Classic gradient noise algorithm. perlin2 :: (RealFrac a) => Noise2 a perlin2 = Perlin.noise2 {-# INLINE perlin2 #-} -noise3At :: Noise3 a -> Seed -> a -> a -> a -> a+-- | Evaluate a 3D noise function at the given coordinates with the given seed.+noise3At+  :: Noise3 a+  -> Seed+  -- ^ deterministic seed+  -> a+  -- ^ x coordinate+  -> a+  -- ^ y coordinate+  -> a+  -- ^ z coordinate+  -> a noise3At = unNoise3 {-# INLINE noise3At #-} +-- | 3D Perlin noise. Classic gradient noise algorithm. perlin3 :: (RealFrac a) => Noise3 a perlin3 = Perlin.noise3 {-# INLINE perlin3 #-} +-- | 2D Value noise. Simple noise based on interpolated random values at grid points. value2 :: (RealFrac a) => Noise2 a value2 = Value.noise2 {-# INLINE value2 #-} +-- | 3D Value noise. Simple noise based on interpolated random values at grid points. value3 :: (RealFrac a) => Noise3 a value3 = Value.noise3 {-# INLINE value3 #-} +-- | 2D Value noise with cubic interpolation for smoother results. valueCubic2 :: (RealFrac a) => Noise2 a valueCubic2 = ValueCubic.noise2 {-# INLINE valueCubic2 #-} +-- | 3D Value noise with cubic interpolation for smoother results. valueCubic3 :: (RealFrac a) => Noise3 a valueCubic3 = ValueCubic.noise3 {-# INLINE valueCubic3 #-}

@@ -14,23 +14,32 @@    -- * 2D Noise   noise2,-  noise2BaseWith, ) where  import Data.Bits-import Data.Foldable-import Data.Vector.Unboxed qualified as U+import Data.Foldable -- redundant since GHC 9.10.1, here for compat+import Data.Primitive.PrimArray import GHC.Generics (Generic) import Numeric.Noise.Internal import Numeric.Noise.Internal.Math +-- | Configuration for cellular (Worley) noise generation.+--+-- Cellular noise is based on distances to randomly distributed cell points,+-- creating a distinctive cellular or organic pattern. data CellularConfig a = CellularConfig   { cellularDistanceFn :: !CellularDistanceFn+  -- ^ Distance metric to use when computing distance to cell points.   , cellularJitter :: !a+  -- ^ Amount of randomness in cell point positions.+  -- 0 creates a regular grid, 1 creates fully random positions.+  -- Values outside [0, 1] are valid but may produce unusual results.   , cellularResult :: !CellularResult+  -- ^ What value to return from the noise function.   }   deriving (Generic, Show) +-- | Default configuration for cellular noise generation. defaultCellularConfig :: (RealFrac a) => CellularConfig a defaultCellularConfig =   CellularConfig@@ -39,21 +48,51 @@     , cellularResult = CellValue     } +-- | Distance function for cellular noise calculations.+--+-- Different distance metrics produce different visual characteristics+-- in the cellular pattern. data CellularDistanceFn-  = DistEuclidean-  | DistEuclideanSq-  | DistManhattan-  | DistHybrid+  = -- | Standard Euclidean distance (sqrt(dx² + dy²)).+    -- Creates circular cells with smooth edges.+    DistEuclidean+  | -- | Squared Euclidean distance (dx² + dy²), no square root.+    -- Faster than 'DistEuclidean' with similar appearance.+    DistEuclideanSq+  | -- | Manhattan/taxicab distance (|dx| + |dy|).+    -- Creates diamond-shaped cells with sharp edges.+    DistManhattan+  | -- | Hybrid of Euclidean and Manhattan distances.+    -- Combines characteristics of both metrics.+    DistHybrid   deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded) +-- | What value to return from cellular noise evaluation.+--+-- These options allow for different visual effects by returning different+-- properties of the cell structure. data CellularResult-  = CellValue-  | Distance-  | Distance2-  | Distance2Add-  | Distance2Sub-  | Distance2Mul-  | Distance2Div+  = -- | Return the hash value of the nearest cell point.+    -- Creates discrete regions with constant values.+    CellValue+  | -- | Return the distance to the nearest cell point.+    -- Creates a classic Worley noise pattern with cell boundaries.+    Distance+  | -- | Return the distance to the second-nearest cell point.+    -- Creates larger, more organic-looking cells.+    Distance2+  | -- | Return the sum of distances to the two nearest cell points.+    -- Creates smooth, rounded cells.+    Distance2Add+  | -- | Return the difference between distances to the two nearest cell points.+    -- Emphasizes cell boundaries and creates sharp edges.+    Distance2Sub+  | -- | Return the product of distances to the two nearest cell points.+    -- Creates cells with varying contrast.+    Distance2Mul+  | -- | Return the ratio of nearest to second-nearest distance.+    -- Creates normalized cell patterns.+    Distance2Div   deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded)  distance :: (RealFrac a) => CellularDistanceFn -> a -> a -> a@@ -71,68 +110,80 @@ {-# INLINE normDist #-}  noise2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a-noise2 CellularConfig{..} =+noise2 CellularConfig{..} = Noise2 $ \ !seed !x !y ->   let !jitter = cellularJitter * 0.43701595-      !dist = distance cellularDistanceFn-      !norm = normDist cellularDistanceFn+      !rx = round x+      !ry = round y++      dist = distance cellularDistanceFn+      norm = normDist cellularDistanceFn       coeff = 1 / (fromIntegral (maxBound @Hash) + 1)-   in Noise2 $ \seed x y ->-        let (!hash, !d0u, !d1u) = noise2BaseWith jitter dist seed x y-            !d0 = norm d0u-            !d1 = norm d1u-         in case cellularResult of-              CellValue -> fromIntegral hash * coeff-              Distance -> d0 - 1-              Distance2 -> d1 - 1-              Distance2Add -> (d1 + d0) * 0.5 - 1-              Distance2Sub -> d1 - d0 - 1-              Distance2Mul -> d1 * d0 * 0.5 - 1-              Distance2Div -> d0 / d1 - 1-{-# INLINE noise2 #-} --- | Calculate 2D cellular noise values at a given point using the given distance function-noise2BaseWith-  :: (RealFrac a)-  => a-  -- ^ cellular jitter-  -> (a -> a -> a)-  -- ^ distance function-  -> Seed-  -> a-  -- ^ x-  -> a-  -- ^ y-  -> (Hash, a, a)-noise2BaseWith !jitter !dist !seed !x !y =-  foldl' @[]-    minmax-    (0, infinity, infinity)-    [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]]- where-  !rx = round x-  !ry = round y+      {-# INLINE pointDist #-}+      pointDist !xi !yi =+        let !px = fromIntegral xi - x+            !py = fromIntegral yi - y+            !h = hash2 seed (primeX * xi) (primeY * yi)+            !i = h .&. 0x1FE+            !rvx = randVecs2d `indexPrimArray` fromIntegral i+            !rvy = randVecs2d `indexPrimArray` (fromIntegral i .|. 1)+            !d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter)+         in (h, d) -  minmax (!c, !d0, !d1) (!h, !d)-    | d < d0 = (h, d, d1')-    | otherwise = (c, d0, d1')-   where-    !d1' = max (min d1 d) d0+      {-# INLINE points #-}+      points = [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]] -  pointDist !xi !yi =-    let !px = fromIntegral xi - x-        !py = fromIntegral yi - y-        !h = hash2 seed (primeX * xi) (primeY * yi)-        !i = h .&. 510-        !rvx = randVecs2d `U.unsafeIndex` fromIntegral i-        !rvy = randVecs2d `U.unsafeIndex` (fromIntegral i .|. 1)-        !d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter)-     in (h, d)-{-# INLINE noise2BaseWith #-}+      {-# INLINE selectMinHash #-}+      selectMinHash =+        let minHash (!hMin, !dMin) (!h, !d)+              | d < dMin = (h, d)+              | otherwise = (hMin, dMin)+         in foldl' minHash (0, infinity) points --- >>> U.length randVecs2d == 512+      {-# INLINE selectMinDist #-}+      selectMinDist =+        let minDist !dMin (_, !d)+              | d < dMin = d+              | otherwise = dMin+         in foldl' minDist infinity points++      {-# INLINE selectSmallestTwo #-}+      selectSmallestTwo =+        let smallestTwo (!c, !d0, !d1) (!h, !d)+              | d < d0 = (h, d, d0)+              | d < d1 = (c, d0, d)+              | otherwise = (c, d0, d1)+         in foldl' smallestTwo (0, infinity, infinity) points+   in case cellularResult of+        CellValue ->+          let (!hash, !_) = selectMinHash+           in fromIntegral hash * coeff+        Distance ->+          let !d0 = selectMinDist+           in norm d0 - 1+        Distance2 ->+          let (!_, !_, !d1) = selectSmallestTwo+           in norm d1 - 1+        Distance2Add ->+          let (!_, !d0, !d1) = selectSmallestTwo+           in (norm d1 + norm d0) * 0.5 - 1+        Distance2Sub ->+          let (!_, !d0, !d1) = selectSmallestTwo+           in norm d1 - norm d0 - 1+        Distance2Mul ->+          let (!_, !d0, !d1) = selectSmallestTwo+           in norm d1 * norm d0 * 0.5 - 1+        Distance2Div ->+          let (!_, !d0, !d1) = selectSmallestTwo+           in norm d0 / norm d1 - 1+ where++{-# INLINE noise2 #-}++-- >>> sizeofPrimArray randVecs2d == 512 -- True {- ORMOLU_DISABLE -}-randVecs2d :: U.Vector Float+randVecs2d :: PrimArray Float randVecs2d =   [-0.2700222198,-0.9628540911,0.3863092627,-0.9223693152,0.04444859006,-0.999011673,-0.5992523158,-0.8005602176   ,-0.7819280288,0.6233687174,0.9464672271,0.3227999196,-0.6514146797,-0.7587218957,0.9378472289,0.347048376

@@ -37,14 +37,30 @@ 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   { octaves :: Int+  -- ^ Number of noise layers to combine. More octaves create more detail+  -- but are more expensive to compute. Must be >= 1.   , lacunarity :: a+  -- ^ Frequency multiplier between octaves. Each octave's frequency is+  -- the previous octave's frequency multiplied by lacunarity.   , 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.   , 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 (Generic, Read, Show, Eq) +-- | Default configuration for fractal noise generation. defaultFractalConfig :: (RealFrac a) => FractalConfig a defaultFractalConfig =   FractalConfig@@ -54,18 +70,58 @@     , weightedStrength = 0     } +-- | 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 config = Noise2 . fractal2With fractalNoiseMod (fractalAmpMod config) config . unNoise2 {-# INLINE 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 config = Noise2 . fractal2With billowNoiseMod (billowAmpMod config) config . unNoise2 {-# INLINE 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 config = Noise2 . fractal2With ridgedNoiseMod (ridgedAmpMod config) config . unNoise2 {-# INLINE 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 config strength =   Noise2 . fractal2With (pingPongNoiseMod strength) (pingPongAmpMod config) config . unNoise2@@ -96,18 +152,30 @@      in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp' {-# INLINE 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 config = Noise3 . fractal3With fractalNoiseMod (fractalAmpMod config) config . unNoise3 {-# INLINE 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 config = Noise3 . fractal3With billowNoiseMod (billowAmpMod config) config . unNoise3 {-# INLINE 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 config = Noise3 . fractal3With ridgedNoiseMod (ridgedAmpMod config) config . unNoise3 {-# INLINE 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 config strength =   Noise3 . fractal3With (pingPongNoiseMod strength) (pingPongAmpMod config) config . unNoise3@@ -128,10 +196,10 @@   -> a fractal3With modNoise modAmps FractalConfig{..} noise3 seed x y z   | octaves < 1 = error "octaves must be a positive integer"-  | otherwise =-      let bounding = fractalBounding FractalConfig{..}-       in go octaves 0 seed 1 bounding+  | otherwise = go octaves 0 seed 1 bounding  where+  bounding = fractalBounding FractalConfig{..}+   go 0 acc _ _ _ = acc   go o acc s freq amp =     let noise = amp * modNoise (noise3 s (freq * x) (freq * y) (freq * z))@@ -140,41 +208,75 @@ {-# INLINE fractal3With #-}  fractalBounding :: (RealFrac a) => FractalConfig a -> a-fractalBounding FractalConfig{..} =-  let amps = take octaves $ iterate (* gain) gain-   in 1 / (sum amps + 1)+fractalBounding FractalConfig{..} = recip (sum amps + 1)+ where+  ~amps = take octaves $ iterate (* gain) gain {-# INLINE 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 = 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 FractalConfig{..} n = lerp 1 n 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 n = abs n * 2 - 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 FractalConfig{..} n = lerp 1 n 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 n = abs n * (-2) + 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 FractalConfig{..} n = lerp 1 (1 - n) 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 (Generic) +-- | Default ping-pong strength value. defaultPingPongStrength :: (RealFrac a) => PingPongStrength a defaultPingPongStrength = PingPongStrength 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 (PingPongStrength s) n =   let n' = (n + 1) * s@@ -182,6 +284,9 @@    in if t < 1 then t else 2 - t {-# 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 FractalConfig{..} n = lerp 1 n weightedStrength {-# INLINE pingPongAmpMod #-}

@@ -25,9 +25,32 @@   quinticInterp,  ) +-- | A 2D noise function parameterized by a seed and two coordinates.+--+-- 'Noise2' wraps a function @Seed -> a -> a -> a@ that takes a seed value+-- and x, y coordinates to produce a noise value.+--+-- This type supports 'Num', 'Fractional', and 'Floating' instances, allowing+-- noise functions to be combined algebraically:+--+-- @+-- combined :: Noise2 Float+-- combined = (perlin2 + superSimplex2) / 2+-- @+--+-- To evaluate a 'Noise2', use 'noise2At' from "Numeric.Noise". newtype Noise2 a = Noise2   {unNoise2 :: Seed -> a -> a -> a} +-- | Increment the seed for a 2D noise function.+--+-- This is useful for generating independent noise layers:+--+-- @+-- layer1 = perlin2+-- layer2 = next2 perlin2+-- layer3 = next2 (next2 perlin2)+-- @ next2 :: Noise2 a -> Noise2 a next2 (Noise2 f) = Noise2 (\s x y -> f (s + 1) x y) {-# INLINE next2 #-}@@ -36,6 +59,12 @@ map2 f (Noise2 g) = Noise2 (\s x y -> f (g s x y)) {-# INLINE map2 #-} +-- | Clamp the output of a 2D noise function to the range @[lower, upper]@.+--+-- @+-- clamped :: Noise2 Float+-- clamped = clamp2 0 1 perlin2  -- clamp to [0, 1]+-- @ clamp2 :: (Ord a) => a -> a -> Noise2 a -> Noise2 a clamp2 l u (Noise2 f) = Noise2 $ \s x y -> clamp l u (f s x y) {-# INLINE clamp2 #-}@@ -44,6 +73,10 @@ const2 a = Noise2 (\_ _ _ -> a) {-# INLINE const2 #-} +-- | Arithmetic operations on 'Noise2' are performed point-wise.+--+-- For example, @n1 + n2@ creates a new noise function that adds the+-- results of @n1@ and @n2@ at each coordinate. instance (Num a) => Num (Noise2 a) where   Noise2 f + Noise2 g = Noise2 $ \s x y -> f s x y + g s x y   {-# INLINE (+) #-}@@ -94,9 +127,21 @@   atanh (Noise2 f) = Noise2 $ \s x y -> atanh (f s x y)   {-# INLINE atanh #-} +-- | A 3D noise function parameterized by a seed and three coordinates.+--+-- 'Noise3' wraps a function @Seed -> a -> a -> a -> a@ that takes a seed value+-- and x, y, z coordinates to produce a noise value.+--+-- Like 'Noise2', this type supports 'Num', 'Fractional', and 'Floating' instances+-- for algebraic composition.+--+-- To evaluate a 'Noise3', use 'noise3At' from "Numeric.Noise". newtype Noise3 a = Noise3   {unNoise3 :: Seed -> a -> a -> a -> a} +-- | Increment the seed for a 3D noise function.+--+-- Analogous to 'next2', this is useful for generating independent 3D noise layers. next3 :: Noise3 a -> Noise3 a next3 (Noise3 f) = Noise3 (\s x y z -> f (s + 1) x y z) {-# INLINE next3 #-}@@ -109,10 +154,20 @@ const3 a = Noise3 (\_ _ _ _ -> a) {-# INLINE const3 #-} +-- | Clamp the output of a 3D noise function to the range @[lower, upper]@.+--+-- @+-- clamped :: Noise3 Float+-- clamped = clamp3 (-0.5) 0.5 perlin3  -- clamp to [-0.5, 0.5]+-- @ clamp3 :: (Ord a) => a -> a -> Noise3 a -> Noise3 a clamp3 l u (Noise3 f) = Noise3 $ \s x y z -> clamp l u (f s x y z) {-# INLINE clamp3 #-} +-- | Arithmetic operations on 'Noise3' are performed point-wise.+--+-- For example, @n1 * n2@ creates a new noise function that multiplies the+-- results of @n1@ and @n2@ at each coordinate. instance (Num a) => Num (Noise3 a) where   Noise3 f + Noise3 g = Noise3 $ \s x y z -> f s x y z + g s x y z   {-# INLINE (+) #-}@@ -132,6 +187,8 @@   {-# INLINE fromRational #-}   recip (Noise3 f) = Noise3 $ \s x y z -> recip (f s x y z)   {-# INLINE recip #-}+  Noise3 f / Noise3 g = Noise3 $ \s x y z -> f s x y z / g s x y z+  {-# INLINE (/) #-}  instance (Floating a) => Floating (Noise3 a) where   pi = const3 pi

@@ -29,13 +29,22 @@  import Data.Bits import Data.Int-import Data.Vector.Unboxed qualified as U+import Data.Primitive.PrimArray import Data.Word +-- | Seed value for deterministic noise generation.+--+-- Using the same 'Seed' value will produce the same noise pattern,+-- allowing for reproducible results. Different seed values produce+-- different, independent noise patterns. type Seed = Word64++-- | Internal hash value type used in noise calculations. type Hash = Int32 --- | monotonic lerp+-- | Linear interpolation between two values.+--+-- Monotonic lerp lerp   :: (Num a)   => a@@ -65,6 +74,10 @@ quinticInterp t = t * t * t * (t * (t * 6 - 15) + 10) {-# INLINE quinticInterp #-} +-- | Clamp a value to a specified range.+--+-- Returns the value if it's within bounds, otherwise returns+-- the nearest boundary. clamp   :: (Ord a)   => a@@ -130,8 +143,8 @@ gradCoord2 seed xPrimed yPrimed xd yd =   let !hash = hash2 seed xPrimed yPrimed       !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFE-      !xg = grad2d `U.unsafeIndex` fromIntegral ix-      !yg = grad2d `U.unsafeIndex` fromIntegral (ix .|. 1)+      !xg = grad2d `indexPrimArray` fromIntegral ix+      !yg = grad2d `indexPrimArray` fromIntegral (ix .|. 1)    in xd * realToFrac xg + yd * realToFrac yg {-# INLINE gradCoord2 #-} @@ -139,9 +152,9 @@ gradCoord3 seed xPrimed yPrimed zPrimed xd yd zd =   let !hash = hash3 seed xPrimed yPrimed zPrimed       !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFC-      !xg = grad3d `U.unsafeIndex` fromIntegral ix-      !yg = grad3d `U.unsafeIndex` fromIntegral (ix .|. 1)-      !zg = grad3d `U.unsafeIndex` fromIntegral (ix .|. 2)+      !xg = grad3d `indexPrimArray` fromIntegral ix+      !yg = grad3d `indexPrimArray` fromIntegral (ix .|. 1)+      !zg = grad3d `indexPrimArray` fromIntegral (ix .|. 2)    in xd * fromIntegral xg + yd * fromIntegral yg + zd * fromIntegral zg {-# INLINE gradCoord3 #-} @@ -150,9 +163,9 @@ {-# INLINE maxHash #-}  {- ORMOLU_DISABLE -}--- >>> U.length grad2d == 256+-- >>> sizeofPrimArray grad2d == 256 -- True-grad2d :: U.Vector Float+grad2d :: PrimArray Float grad2d =   [ 0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,     0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,@@ -187,10 +200,11 @@     0.38268343236509 ,  0.923879532511287,  0.923879532511287,  0.38268343236509 ,  0.923879532511287, -0.38268343236509 ,  0.38268343236509 , -0.923879532511287,    -0.38268343236509 , -0.923879532511287, -0.923879532511287, -0.38268343236509 , -0.923879532511287,  0.38268343236509 , -0.38268343236509 ,  0.923879532511287   ]+{-# INLINABLE grad2d #-} --- >>> U.length grad3d == 256+-- >>> sizeofPrimArray grad3d == 256 -- True-grad3d :: U.Vector Int+grad3d :: PrimArray Int grad3d =   [ 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0   , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0@@ -209,3 +223,4 @@   , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0   , 1, 1, 0, 0, 0, -1, 1, 0, -1, 1, 0, 0, 0, -1, -1, 0   ]+{-# INLINABLE grad3d #-}

@@ -1,5 +1,3 @@-{-# LANGUAGE Strict #-}- -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com> -- Stability : experimental

@@ -1,7 +1,6 @@ module Noise2Spec where  import Numeric.Noise-import Numeric.Noise.Internal  seed :: Seed seed = 55

@@ -1,7 +1,6 @@ module Noise3Spec where  import Numeric.Noise-import Numeric.Noise.Internal  seed :: Seed seed = 2381

@@ -1,5 +1,6 @@ module PerlinSpec where +import GHC.Exts (noinline) import Numeric.Noise  seed :: Seed@@ -12,8 +13,10 @@  prop_noise2_addition_associative :: Rational -> Rational -> Bool prop_noise2_addition_associative x y =-  noise2At ((perlin2 + perlin2) + perlin2) seed x y == noise2At (perlin2 + (perlin2 + perlin2)) seed x y+  noise2At ((noinline perlin2 + noinline superSimplex2) + noinline openSimplex2) seed x y+    == noise2At (perlin2 + (noinline superSimplex2 + noinline openSimplex2)) seed x y  prop_noise2_addition_commutative :: Rational -> Rational -> Bool prop_noise2_addition_commutative x y =-  noise2At (perlin2 + perlin2) seed x y == noise2At (perlin2 + perlin2) seed x y+  noise2At (noinline perlin2 + noinline superSimplex2) seed x y+    == noise2At (noinline superSimplex2 + noinline perlin2) seed x y