packages feed

pure-noise 0.2.2.0 → 0.3.0.0

raw patch · 19 files changed

+700/−582 lines, 19 filesdep +doctest-parallelPVP ok

version bump matches the API change (PVP)

Dependencies added: doctest-parallel

API changes (from Hackage documentation)

- Numeric.Noise: superSimplex2 :: RealFrac a => Noise2 a
- Numeric.Noise: superSimplex3 :: RealFrac a => Noise3 a
- Numeric.Noise.Fractal: billowAmpMod :: Num a => FractalConfig a -> a -> a
- Numeric.Noise.Fractal: billowNoiseMod :: Num a => a -> a
- Numeric.Noise.Fractal: fractalAmpMod :: Num a => FractalConfig a -> a -> a
- Numeric.Noise.Fractal: fractalNoiseMod :: a -> a
- Numeric.Noise.Fractal: pingPongAmpMod :: Num a => FractalConfig a -> a -> a
- Numeric.Noise.Fractal: pingPongNoiseMod :: RealFrac a => PingPongStrength a -> a -> a
- Numeric.Noise.Fractal: ridgedAmpMod :: Num a => FractalConfig a -> a -> a
- Numeric.Noise.Fractal: ridgedNoiseMod :: Num a => a -> a
- Numeric.Noise.SuperSimplex: noise2 :: RealFrac a => Noise2 a
- Numeric.Noise.SuperSimplex: noise2Base :: RealFrac a => Seed -> a -> a -> a
- Numeric.Noise.SuperSimplex: noise3 :: RealFrac a => Noise3 a
- Numeric.Noise.SuperSimplex: noise3Base :: RealFrac a => Seed -> a -> a -> a -> a
+ Numeric.Noise: smootherSimplex2 :: RealFrac a => Noise2 a
+ Numeric.Noise: smootherSimplex3 :: RealFrac a => Noise3 a
+ Numeric.Noise.Fractal: billowStep :: RealFrac a => a -> FractalStep a
+ Numeric.Noise.Fractal: fbmStep :: RealFrac a => a -> FractalStep a
+ Numeric.Noise.Fractal: fractal2With :: RealFrac a => FractalStep a -> FractalConfig a -> (Seed -> a -> a -> a) -> Seed -> a -> a -> a
+ Numeric.Noise.Fractal: fractal3With :: RealFrac a => FractalStep a -> FractalConfig a -> (Seed -> a -> a -> a -> a) -> Seed -> a -> a -> a -> a
+ Numeric.Noise.Fractal: pingPongStep :: RealFrac a => PingPongStrength a -> a -> FractalStep a
+ Numeric.Noise.Fractal: ridgedStep :: RealFrac a => a -> FractalStep a
+ Numeric.Noise.Fractal: type FractalStep a = a -> (# a, a #)
+ Numeric.Noise.SmootherSimplex: noise2 :: RealFrac a => Noise2 a
+ Numeric.Noise.SmootherSimplex: noise2Base :: RealFrac a => Seed -> a -> a -> a
+ Numeric.Noise.SmootherSimplex: noise3 :: RealFrac a => Noise3 a
+ Numeric.Noise.SmootherSimplex: noise3Base :: RealFrac a => Seed -> a -> a -> a -> a

Files

CHANGELOG.md view
@@ -8,6 +8,37 @@  ## Unreleased +## 0.3.0.0 2026-10-09++Major version bump. Multiple breaking changes in this release. Worth a sec to+read over the changes here.++### Added++- `doctest-parallel` now tests examples.++### Changed++- BREAKING - fractals are now configured using a step function that+  returns an unboxed tuple. This replaces the (potentially boxed) higher-order+  modifier function, and changes the vocabulary and performance characteristics+  of fractals somewhat.+  - **This fundamentally alters the appearance and value range of fractals.**+- BREAKING - renamed `superSimplex` to `smootherSimplex`. Algorithm is+  identical, but naming is clearer.+- BREAKING - value and cubic value noise, in both 2D and 3D variants, now+  implement the exact same coordinate function as FNL: It squares the hash and+  distributes the squared hash along the whole calculation.+  - **This fundamentally changes all values that these functions produce.**+- BREAKING - fractals with `octaves == 1` now return the noise unchanged. ALL+  fractals now produce one less iteration than before. This should prove less+  surprising to users coming from other noise libraries like FNL.+- `OpenSimplex2S` is the smoother variant of `OpenSimplex2` noise. Originally+  decided to omit the `2`/`2S` from OpenSimplex since it created collisions with+  the noise function naming scheme that seemed most ergonomic; I think this+  should neatly resolve remaining semantic ambiguity.+- Improved documentation for flags, fixed some rendering quirks.+ ## 0.2.2.0 2026-07-19  This is the final release of the 0.2.2.0 line.
README.md view
@@ -20,6 +20,20 @@ implementations (`noiseBaseN` functions and anything in `Numeric.Noise.Internal`) are subject to change and may change between minor versions. +## Important note on GHC 9.14++GHC 9.14 includes a substantial rewrite of the specializer. With this came some+regressions. Many of the ones I'm aware of are centered around newtype classes+(i.e., classes with one function), but aren't totally isolated to them.++As a result, using GHC 9.14 may **significantly alter your performance profile**.+This may be a regression. **I have not yet had the time to test GHC 9.14+against this library's performance claims**, although CI tests that the library+compiles at all against 9.14.++If you run into issues on 9.14, opening an issue on this project's repository+would help a great deal: <https://github.com/jtnuttall/pure-noise/issues>+ ## Acknowledgments  - This project grew from a port of the excellent@@ -35,23 +49,23 @@  ## FastNoiseLite compatibility -pure-noise shares its lineage with FNL, but it isn't intended as a 1:1 port —-kernels are restructured for GHC, and some families intentionally diverge.-Where outputs stand today:+pure-noise began as a port of FastNoiseLite and shares its algorithmic+lineage, but it isn't a 1:1 port. Version `0.3` targets FNL equivalence within a+few ULP. -| family                                   | output vs FNL                                 |-| ---------------------------------------- | --------------------------------------------- |-| `perlin2/3`, `cellular2/3`               | bit-exact                                     |-| `openSimplex2/3`, `superSimplex2/3`      | within a few ULP                              |-| `value2/3`, `valueCubic2/3`              | diverges (hash finalization)                  |-| `fractal2/3`, `ridged2/3`, `pingPong2/3` | diverges (octave normalization and weighting) |-| `billow2/3`                              | no FNL counterpart                            |+### Notable differences to FNL +#### Fractals++- `pingPong` uses an algebraically equivalent equation for FNL's triangle wave,+  but differs by a few ULP.+- `billow` has no FNL equivalent.+ > [!IMPORTANT] >-> The `value`, `valueCubic`, and fractal families will align with FNL in 0.3,-> which changes their output for a given seed. Pin `pure-noise < 0.3` if you-> depend on seed-stable output from them.+> 0.3 changes the seed-to-output mapping of the `value`, `valueCubic`, and+> fractal families relative to 0.2.x. Pin `pure-noise < 0.3` if you depend on+> stable output from those functions.  ## Usage @@ -59,9 +73,14 @@ aliases for 2D and 3D noise. Noise functions can be composed transparently using standard operators with minimal performance cost. -Noise values are generally clamped to `[-1, 1]`, although some noise functions-may occasionally produce values slightly outside this range.+Most noise functions produce values in `[-1, 1]`, give or take small+floating-point excursions. +The primary exception is cellular noise with the `DistManhattan` or `DistHybrid`+distance functions. These values are unnormalized and can exceed 1 (up to ~2 in+practice). This is how FastNoiseLite works, and will not change until the next+major.+ ### Basic Example  ```haskell@@ -71,7 +90,7 @@ myNoise2 :: (RealFrac a) => Noise.Seed -> a -> a -> a myNoise2 =   let fractalConfig = Noise.defaultFractalConfig-      combined = (Noise.perlin2 + Noise.superSimplex2) / 2+      combined = (Noise.perlin2 + Noise.smootherSimplex2) / 2   in Noise.noise2At $ Noise.fractal2 fractalConfig combined ``` @@ -88,7 +107,7 @@ complexNoise :: Noise.Noise2 Float complexNoise = do   baseNoise <- Noise.perlin2-  detailNoise <- Noise.next2 Noise.superSimplex2+  detailNoise <- Noise.next2 Noise.smootherSimplex2   -- Blend based on base noise: smooth areas get less detail   pure $ baseNoise * 0.7 + detailNoise * (0.3 * (1 + baseNoise) / 2) ```@@ -231,25 +250,25 @@  ##### 2D -| name          | Float (values/sec) | Double (values/sec) |-| ------------- | ------------------ | ------------------- |-| value2        | 64_407_126         | 68_260_653          |-| perlin2       | 61_301_663         | 65_143_707          |-| openSimplex2  | 25_982_291         | 27_045_472          |-| valueCubic2   | 22_743_642         | 23_403_842          |-| superSimplex2 | 17_167_069         | 17_762_669          |-| cellular2     | 16_025_950         | 16_007_044          |+| name             | Float (values/sec) | Double (values/sec) |+| ---------------- | ------------------ | ------------------- |+| value2           | 64_407_126         | 68_260_653          |+| perlin2          | 61_301_663         | 65_143_707          |+| openSimplex2     | 25_982_291         | 27_045_472          |+| valueCubic2      | 22_743_642         | 23_403_842          |+| smootherSimplex2 | 17_167_069         | 17_762_669          |+| cellular2        | 16_025_950         | 16_007_044          |  ##### 3D -| name          | Float (values/sec) | Double (values/sec) |-| ------------- | ------------------ | ------------------- |-| value3        | 34_673_623         | 35_929_146          |-| perlin3       | 29_325_590         | 30_432_482          |-| openSimplex3  | 10_975_857         | 10_922_644          |-| superSimplex3 | 9_232_128          | 9_166_843           |-| valueCubic3   | 7_453_365          | 7_278_612           |-| cellular3     | 5_238_497          | 5_061_911           |+| name             | Float (values/sec) | Double (values/sec) |+| ---------------- | ------------------ | ------------------- |+| value3           | 34_673_623         | 35_929_146          |+| perlin3          | 29_325_590         | 30_432_482          |+| openSimplex3     | 10_975_857         | 10_922_644          |+| smootherSimplex3 | 9_232_128          | 9_166_843           |+| valueCubic3      | 7_453_365          | 7_278_612           |+| cellular3        | 5_238_497          | 5_061_911           |  ## Examples 
bench/Bench.hs view
@@ -28,7 +28,7 @@         ( baseline3 sz             <> benchPerlin3 octaves sz             <> benchOpenSimplex3 octaves sz-            <> benchSuperSimplex3 octaves sz+            <> benchSmootherSimplex3 octaves sz             <> benchValue3 octaves sz             <> benchValueCubic3 octaves sz             <> benchCellular3 sz@@ -138,17 +138,17 @@ benchOpenSimplexSmooth2 :: Int -> Int -> [Benchmark] benchOpenSimplexSmooth2 octaves sz =   [ bgroup-      "superSimplex2"-      [ benchMany2 @Float "" sz superSimplex2-      , benchMany2 @Double "" sz superSimplex2-      , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} superSimplex2)-      , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2)-      , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength superSimplex2)+      "smootherSimplex2"+      [ benchMany2 @Float "" sz smootherSimplex2+      , benchMany2 @Double "" sz smootherSimplex2+      , benchMany2 @Float "fractal" sz (fractal2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Double "fractal" sz (fractal2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Float "ridged" sz (ridged2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Double "ridged" sz (ridged2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Float "billow" sz (billow2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Double "billow" sz (billow2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMany2 @Float "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength smootherSimplex2)+      , benchMany2 @Double "pingPong" sz (pingPong2 defaultFractalConfig{octaves} defaultPingPongStrength smootherSimplex2)       ]   ] @@ -312,14 +312,14 @@       ]   ] -benchSuperSimplex3 :: Int -> Int -> [Benchmark]-benchSuperSimplex3 octaves sz =+benchSmootherSimplex3 :: Int -> Int -> [Benchmark]+benchSmootherSimplex3 octaves sz =   [ bgroup-      "superSimplex3"-      [ benchMany3 @Float "" sz superSimplex3-      , benchMany3 @Double "" sz superSimplex3-      , benchMany3 @Float "fractal" sz (fractal3 defaultFractalConfig{octaves} superSimplex3)-      , benchMany3 @Double "fractal" sz (fractal3 defaultFractalConfig{octaves} superSimplex3)+      "smootherSimplex3"+      [ benchMany3 @Float "" sz smootherSimplex3+      , benchMany3 @Double "" sz smootherSimplex3+      , benchMany3 @Float "fractal" sz (fractal3 defaultFractalConfig{octaves} smootherSimplex3)+      , benchMany3 @Double "fractal" sz (fractal3 defaultFractalConfig{octaves} smootherSimplex3)       ]   ] @@ -422,8 +422,8 @@       , benchMassiv2 @Double "perlin2" w h perlin2       , benchMassiv2 @Float "openSimplex2" w h openSimplex2       , benchMassiv2 @Double "openSimplex2" w h openSimplex2-      , benchMassiv2 @Float "superSimplex2" w h superSimplex2-      , benchMassiv2 @Double "superSimplex2" w h superSimplex2+      , benchMassiv2 @Float "smootherSimplex2" w h smootherSimplex2+      , benchMassiv2 @Double "smootherSimplex2" w h smootherSimplex2       , benchMassiv2 @Float "value2" w h value2       , benchMassiv2 @Double "value2" w h value2       , benchMassiv2 @Float "valueCubic2" w h valueCubic2@@ -451,7 +451,7 @@       , benchMassiv2 @Double "value2 fractal" w h (fractal2 defaultFractalConfig{octaves} value2)       , benchMassiv2 @Float "openSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} openSimplex2)       , benchMassiv2 @Double "openSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} openSimplex2)-      , benchMassiv2 @Float "superSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} superSimplex2)-      , benchMassiv2 @Double "superSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} superSimplex2)+      , benchMassiv2 @Float "smootherSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} smootherSimplex2)+      , benchMassiv2 @Double "smootherSimplex2 fractal" w h (fractal2 defaultFractalConfig{octaves} smootherSimplex2)       ]   ]
bench/fnl-compare/FnlBench.hs view
@@ -41,7 +41,7 @@         , algo2 grid rand kOne kSmall "valueCubic" fnlValueCubic valueCubic2         , algo2 grid rand kOne kSmall "perlin" fnlPerlin perlin2         , algo2 grid rand kOne kSmall "openSimplex2" fnlOpenSimplex2 openSimplex2-        , algo2 grid rand kOne kSmall "superSimplex2" fnlOpenSimplex2S superSimplex2+        , algo2 grid rand kOne kSmall "smootherSimplex2" fnlOpenSimplex2S smootherSimplex2         , algo2 grid rand kOne kSmall "cellular" fnlCellular (cellular2 benchCellularConfig)         ]   , env mkEnv3 $ \ ~(grid, rand, kOne, kSmall) ->@@ -51,7 +51,7 @@         , algo3 grid rand kOne kSmall "valueCubic" fnlValueCubic valueCubic3         , algo3 grid rand kOne kSmall "perlin" fnlPerlin perlin3         , algo3 grid rand kOne kSmall "openSimplex2" fnlOpenSimplex2 openSimplex3-        , algo3 grid rand kOne kSmall "superSimplex2" fnlOpenSimplex2S superSimplex3+        , algo3 grid rand kOne kSmall "smootherSimplex2" fnlOpenSimplex2S smootherSimplex3         , algo3 grid rand kOne kSmall "cellular" fnlCellular (cellular3 benchCellularConfig)         ]   ]
+ doctest/Doctest.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import System.Environment (getArgs)+import Test.DocTest (mainFromCabal)++main :: IO ()+main = mainFromCabal "pure-noise" =<< getArgs
pure-noise.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           pure-noise-version:        0.2.2.0+version:        0.3.0.0 synopsis:       Performant, modern noise generation (Perlin, OpenSimplex2, Cellular) description:    Fast, modern noise generation In pure Haskell with an algebraic interface.                 Provides Perlin, OpenSimplex2, OpenSimplex2S, Value, and Cellular noise variants.@@ -21,7 +21,8 @@ tested-with:     GHC == 9.6.7   , GHC == 9.8.4-  , GHC == 9.12.2+  , GHC == 9.10.3+  , GHC == 9.12.4 extra-source-files:     README.md     LICENSE@@ -35,13 +36,9 @@   location: https://github.com/jtnuttall/pure-noise  flag llvm-bench-  description: Build the benchmark suites via GHC's LLVM backend with a pinned toolchain-               (-fllvm, -pgmlo opt, -pgmlc llc, -pgmlas clang) plus -mavx -mfma and fast-               FP contraction in llc (-optlc-fp-contract=fast). Requires opt/llc/clang-               on PATH (LLVM <= 19 for GHC 9.12) and GHC >= 9.10 (for -pgmlas). Off by-               default so `cabal build --enable-benchmarks` works on machines and CI-               runners without LLVM. Published benchmark numbers are collected with this-               flag on; see bench/README.md.+  description: Build the benchmark suites via GHC's LLVM backend with heavy optimizations.+               .+               Published benchmark numbers are collected with this flag on; see bench/README.md.   manual: True   default: False @@ -56,14 +53,10 @@   default: False  flag optimize-  description: Turns on -O2 for pure-noise. Since the library is pretty small, this shouldn't be-               too much trouble, but you can disable this flag if it's slowing your builds too-               much.+  description: Turns on expensive optimizations for pure-noise.                .-               Rationale:-               - -O1 leaves ~3x on the table for tight noise loops in downstream code.-               - -O2 seems to produce higher-quality unfoldings, which in turn causes pure-noise's-               kernels to inline and optimize more reliably at call sites.+               Since the library is pretty small, this shouldn't be too much trouble, but you can+               disable this flag if it's slowing your builds too much.   manual: True   default: True @@ -74,7 +67,7 @@       Numeric.Noise.Fractal       Numeric.Noise.OpenSimplex       Numeric.Noise.Perlin-      Numeric.Noise.SuperSimplex+      Numeric.Noise.SmootherSimplex       Numeric.Noise.Value       Numeric.Noise.ValueCubic   other-modules:@@ -99,6 +92,23 @@     ghc-options: -mavx     cpp-options: -DHAS_AVX +test-suite pure-noise-doctest+  type: exitcode-stdio-1.0+  main-is: Doctest.hs+  other-modules:+      Paths_pure_noise+  autogen-modules:+      Paths_pure_noise+  hs-source-dirs:+      doctest+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded+  build-depends:+      base >=4.16 && <5+    , doctest-parallel ==0.4.*+    , primitive >=0.8 && <0.10+    , pure-noise+  default-language: GHC2021+ test-suite pure-noise-test   type: exitcode-stdio-1.0   main-is: Driver.hs@@ -110,7 +120,7 @@       Noise3Spec       OpenSimplexSpec       PerlinSpec-      SuperSimplexSpec+      SmootherSimplexSpec       TotalitySpec       ValueCubicSpec       ValueSpec@@ -175,7 +185,7 @@       Paths_pure_noise   hs-source-dirs:       bench/fnl-compare-  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=-A64m -T" -O2 -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=-A64m -T" -O2 -fsimpl-tick-factor=1000 -fspecialize-aggressively -fexpose-all-unfoldings -flate-specialise -flate-dmd-anal   cxx-options: -O3 -std=c++14 -ffp-contract=fast -fstrict-overflow   include-dirs:       bench/fnl-compare/cbits
src/Numeric/Noise.hs view
@@ -19,57 +19,40 @@ -- -- Generate 2D Perlin noise: ----- @--- import Numeric.Noise qualified as Noise+-- >>> noise2At perlin2 seed 23.5 (-3.2)+-- -0.5102728615076121 ----- 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--- @+-- >>> combined = (perlin2 + smootherSimplex2) / 2+-- >>> noise2At combined seed (-5.7) (7.9)+-- 0.36250273586425386 -- -- Apply fractal Brownian motion: ----- @--- fbm :: (RealFrac a) => Noise.Noise2 a--- fbm = Noise.fractal2 Noise.defaultFractalConfig Noise.perlin2--- @+-- >>> fractal = fractal2 defaultFractalConfig perlin2+-- >>> noise2At fractal seed 55 (-2.23)+-- 0.15904649772327042 -- -- == Advanced Features -- -- Generate 1D noise by slicing higher-dimensional noise: ----- @--- noise1d :: Noise.Noise1 Float--- noise1d = Noise.sliceY2 0.5 Noise.perlin2------ evaluate :: Float -> Float--- evaluate = Noise.noise1At noise1d 0--- @+-- >>> sliced1d = sliceY2 0.5 perlin2+-- >>> noise1At sliced1d seed 1.3+-- 1.6628682379335485e-2 -- -- Transform coordinates with 'warp': ----- @--- scaledAndLayered :: Noise.Noise2 Float--- scaledAndLayered =---  Noise.warp (\\(x, y) -> (x * 2, y * 2)) Noise.perlin2---    + fmap (* 0.5) Noise.perlin2--- @+-- >>> warped = warp (\(x, y) -> (x * 2, y * 2)) perlin2 + fmap (* 0.5) perlin2+-- >>> noise2At warped seed 73.7 77.127+-- -0.24590168263203727 -- -- Layer independent noise with 'reseed' or 'next2': ----- @--- layered :: Noise.Noise2 Float--- layered = (Noise.perlin2 + Noise.next2 Noise.perlin2) \/ 2--- @+-- >>> layered = (perlin2 + next2 perlin2) / 2+-- >>> noise2At layered seed 71 (-73.37)+-- 1.8548715411324024e-2 -- -- == Coordinate domain --@@ -118,8 +101,8 @@   openSimplex3,    -- ** OpenSimplex2S-  superSimplex2,-  superSimplex3,+  smootherSimplex2,+  smootherSimplex3,    -- ** Cellular   cellular2,@@ -166,7 +149,7 @@   -- | Fractal noise combines multiple octaves at different frequencies and   -- amplitudes to create natural-looking, multi-scale patterns.   ---  -- For custom fractal implementations using per-octave modifier functions,+  -- For custom fractal implementations using per-octave step functions,   -- see "Numeric.Noise.Fractal".    -- ** Fractal Brownian Motion (FBM)@@ -215,10 +198,13 @@ import Numeric.Noise.Internal import Numeric.Noise.OpenSimplex qualified as OpenSimplex import Numeric.Noise.Perlin qualified as Perlin-import Numeric.Noise.SuperSimplex qualified as SuperSimplex+import Numeric.Noise.SmootherSimplex qualified as SmootherSimplex import Numeric.Noise.Value qualified as Value import Numeric.Noise.ValueCubic qualified as ValueCubic +-- $setup+-- >>> seed = 1234 :: Seed+ -- | 2D Cellular (Worley) noise. Configure with 'CellularConfig' to control -- distance functions and return values. --@@ -245,17 +231,17 @@ openSimplex3 = OpenSimplex.noise3 {-# INLINE openSimplex3 #-} --- | 2D SuperSimplex noise. Improved OpenSimplex variant with better visual+-- | 2D SmootherSimplex noise. Improved OpenSimplex variant with better visual -- characteristics.-superSimplex2 :: (RealFrac a) => Noise2 a-superSimplex2 = SuperSimplex.noise2-{-# INLINE superSimplex2 #-}+smootherSimplex2 :: (RealFrac a) => Noise2 a+smootherSimplex2 = SmootherSimplex.noise2+{-# INLINE smootherSimplex2 #-} --- | 3D SuperSimplex noise (FastNoiseLite's OpenSimplex2S, two offset rotated+-- | 3D SmootherSimplex noise (FastNoiseLite's OpenSimplex2S, two offset rotated -- cube grids), including its default coordinate rotation.-superSimplex3 :: (RealFrac a) => Noise3 a-superSimplex3 = SuperSimplex.noise3-{-# INLINE superSimplex3 #-}+smootherSimplex3 :: (RealFrac a) => Noise3 a+smootherSimplex3 = SmootherSimplex.noise3+{-# INLINE smootherSimplex3 #-}  -- | 2D Perlin noise. Classic gradient noise algorithm. perlin2 :: (RealFrac a) => Noise2 a
src/Numeric/Noise/Fractal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE UnboxedTuples #-}  -- | -- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>@@ -23,15 +24,24 @@   ridged3,   pingPong3, -  -- * Utility-  fractalNoiseMod,-  fractalAmpMod,-  billowNoiseMod,-  billowAmpMod,-  ridgedNoiseMod,-  ridgedAmpMod,-  pingPongNoiseMod,-  pingPongAmpMod,+  -- * Custom fractals++  --++  -- |+  -- The building blocks 'fractal2', 'billow2', 'ridged2', and 'pingPong2'+  -- are assembled from a shared per-octave loop ('fractal2With' /+  -- 'fractal3With') and a per-variant 'FractalStep'.+  --+  -- You can provide your own step to build custom fractal variants with the+  -- __same specialization behavior as the built-ins__.+  FractalStep,+  fractal2With,+  fractal3With,+  fbmStep,+  billowStep,+  ridgedStep,+  pingPongStep, ) where  import GHC.Generics@@ -44,8 +54,7 @@ data FractalConfig a = FractalConfig   { octaves :: Int   -- ^ Number of noise layers to combine. More octaves create more detail-  -- but are more expensive to compute. Fewer than 1 octave produces-  -- constant 0.+  -- 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.@@ -55,12 +64,9 @@   -- 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 (the default), octaves have independent-  -- amplitudes. Range: \( [0, 1] \).-  ---  -- The weighting currently tracks the amplitude-scaled octave value, which-  -- diverges from FastNoiseLite — values near 1 can misbehave (e.g. inverted-  -- ridged octaves). It will align with FNL in 0.3.+  -- 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) @@ -86,7 +92,7 @@ -- fbm = fractal2 defaultFractalConfig perlin2 -- @ fractal2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a-fractal2 config = mkNoise2 . fractal2With fractalNoiseMod (fractalAmpMod config) config . noise2At+fractal2 config = mkNoise2 . fractal2With (fbmStep (weightedStrength config)) config . noise2At {-# INLINE [2] fractal2 #-}  -- | Apply billow fractal to a 2D noise function.@@ -100,7 +106,7 @@ -- clouds = billow2 defaultFractalConfig perlin2 -- @ billow2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a-billow2 config = mkNoise2 . fractal2With billowNoiseMod (billowAmpMod config) config . noise2At+billow2 config = mkNoise2 . fractal2With (billowStep (weightedStrength config)) config . noise2At {-# INLINE [2] billow2 #-}  -- | Apply ridged fractal to a 2D noise function.@@ -114,7 +120,7 @@ -- mountains = ridged2 defaultFractalConfig perlin2 -- @ ridged2 :: (RealFrac a) => FractalConfig a -> Noise2 a -> Noise2 a-ridged2 config = mkNoise2 . fractal2With ridgedNoiseMod (ridgedAmpMod config) config . noise2At+ridged2 config = mkNoise2 . fractal2With (ridgedStep (weightedStrength config)) config . noise2At {-# INLINE [2] ridged2 #-}  -- | Apply ping-pong fractal to a 2D noise function.@@ -123,61 +129,85 @@ -- and forth within a range, creating a distinctive undulating appearance. -- The strength parameter controls the intensity of the ping-pong effect. ----- Output spans @[0, 1]@; it will align with FNL's @[-1, 1]@ in 0.3.--- -- @ -- waves :: Noise2 Float -- waves = pingPong2 defaultFractalConfig defaultPingPongStrength perlin2 -- @ pingPong2 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise2 a -> Noise2 a pingPong2 config strength =-  mkNoise2 . fractal2With (pingPongNoiseMod strength) (pingPongAmpMod config) config . noise2At+  mkNoise2 . fractal2With (pingPongStep strength (weightedStrength config)) config . noise2At {-# INLINE [2] pingPong2 #-} +-- | Per-octave fractal step: from the raw octave noise, produce+-- @(# term added to the sum (pre-amplitude), amplitude weight factor #)@.+--+-- The weight factor is multiplied into the amplitude after each octave+-- (before the 'gain' multiply), so it already incorporates+-- 'weightedStrength' — see 'fbmStep' for the canonical shape.+--+-- Consuming this type needs no extensions; /writing/ a custom step requires+-- @{-\# LANGUAGE UnboxedTuples \#-}@:+--+-- @+-- -- fBm with unweighted octaves (weight factor 1)+-- flatStep :: FractalStep Float+-- flatStep raw = (# raw, 1 #)+--+-- custom :: Noise2 Float+-- custom = mkNoise2 (fractal2With flatStep defaultFractalConfig (noise2At perlin2))+-- @+type FractalStep a = a -> (# a, a #)+ fractal2With   :: (RealFrac a)-  => (a -> a)-  -- ^ modify noise before summation-  -> (a -> a)-  -- ^ modify amplitude+  => FractalStep a   -> FractalConfig a   -> (Seed -> a -> a -> a)   -> Seed   -> a   -> a   -> a-fractal2With modNoise modAmps FractalConfig{..} noise2 seed x y+fractal2With step FractalConfig{..} noise2 seed x0 y0   | octaves < 1 = 0   | otherwise =       let !bounding = fractalBounding FractalConfig{..}-       in go octaves 0 seed 1 bounding+       in go octaves 0 seed x0 y0 bounding  where-  go 0 !acc !_ !_ !_ = acc-  go !o !acc !s !freq !amp =-    let !noise = amp * modNoise (noise2 s (freq * x) (freq * y))-        !amp' = amp * gain * modAmps (min (noise + 1) 2)-     in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp'+  -- Mirrors FNL's GenFractal* loops, including rounding order:+  -- sum += v * amp; amp *= w; amp *= gain; x *= lacunarity. Carrying the+  -- scaled coordinates (rather than an accumulated freq) matches FNL's+  -- loop and is one multiply cheaper per axis. Caveat: for bases with a+  -- coordinate transform (OpenSimplex2/2S), FNL scales the *transformed*+  -- coordinates while we re-transform the scaled raw ones — identical+  -- rounding only at power-of-two lacunarity, ulps apart otherwise.+  go 0 !acc !_ !_ !_ !_ = acc+  go !o !acc !s !x !y !amp =+    case step (noise2 s x y) of+      (# v, w #) ->+        let !acc' = acc + v * amp+            !amp' = amp * w * gain+         in go (o - 1) acc' (s + 1) (x * lacunarity) (y * lacunarity) 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 config = mkNoise3 . fractal3With fractalNoiseMod (fractalAmpMod config) config . noise3At+fractal3 config = mkNoise3 . fractal3With (fbmStep (weightedStrength config)) config . 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 config = mkNoise3 . fractal3With billowNoiseMod (billowAmpMod config) config . noise3At+billow3 config = mkNoise3 . fractal3With (billowStep (weightedStrength config)) config . 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 config = mkNoise3 . fractal3With ridgedNoiseMod (ridgedAmpMod config) config . noise3At+ridged3 config = mkNoise3 . fractal3With (ridgedStep (weightedStrength config)) config . noise3At {-# INLINE [2] ridged3 #-}  -- | Apply ping-pong fractal to a 3D noise function.@@ -185,15 +215,12 @@ -- 3D version of 'pingPong2'. See 'pingPong2' for details. pingPong3 :: (RealFrac a) => FractalConfig a -> PingPongStrength a -> Noise3 a -> Noise3 a pingPong3 config strength =-  mkNoise3 . fractal3With (pingPongNoiseMod strength) (pingPongAmpMod config) config . noise3At+  mkNoise3 . fractal3With (pingPongStep strength (weightedStrength config)) config . noise3At {-# INLINE [2] pingPong3 #-}  fractal3With   :: (RealFrac a)-  => (a -> a)-  -- ^ modify noise before summation-  -> (a -> a)-  -- ^ modify amplitude+  => FractalStep a   -> FractalConfig a   -> (Seed -> a -> a -> a -> a)   -> Seed@@ -201,71 +228,69 @@   -> a   -> a   -> a-fractal3With modNoise modAmps FractalConfig{..} noise3 seed x y z+fractal3With step FractalConfig{..} noise3 seed x0 y0 z0   | octaves < 1 = 0   | otherwise =       let !bounding = fractalBounding FractalConfig{..}-       in go octaves 0 seed 1 bounding+       in go octaves 0 seed x0 y0 z0 bounding  where-  go 0 !acc !_ !_ !_ = acc-  go !o !acc !s !freq !amp =-    let !noise = amp * modNoise (noise3 s (freq * x) (freq * y) (freq * z))-        !amp' = amp * gain * modAmps (min (noise + 1) 2)-     in go (o - 1) (acc + noise) (s + 1) (freq * lacunarity) amp'+  go 0 !acc !_ !_ !_ !_ !_ = acc+  go !o !acc !s !x !y !z !amp =+    case step (noise3 s x y z) of+      (# v, w #) ->+        let !acc' = acc + v * amp+            !amp' = amp * w * gain+         in go (o - 1) acc' (s + 1) (x * lacunarity) (y * lacunarity) (z * lacunarity) amp' {-# INLINE [1] fractal3With #-}  fractalBounding :: (RealFrac a) => FractalConfig a -> a-fractalBounding FractalConfig{..} = recip (sum amps + 1)+fractalBounding FractalConfig{..} = recip (go 1 g 1)  where-  amps = take octaves $ iterate (* gain) gain+  -- FNL's CalculateFractalBounding, exactly: gain is abs'd, the sum has+  -- octaves terms (1 + g + ... + g^(octaves-1)), and it accumulates+  -- left-associated: ((1 + g) + g^2) + ... Preserve the shape; sum/take+  -- round differently. octaves = 1 gives 1: a single-octave fractal is+  -- its base noise.+  g = abs gain+  go !i !amp !ampFractal+    | i >= octaves = ampFractal+    | otherwise = go (i + 1) (amp * g) (ampFractal + amp) {-# INLINE [2] fractalBounding #-} --- | Identity noise modifier for standard FBM.+-- | Step for fractal Brownian motion ----- 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.+-- Linear interpolation that maps the octave value from \( [-1, 1] \) into+-- \( [0, 1] \). ----- 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 #-}+-- Equivalent to FNL's @GenFractalFBm@, with the exception that it is clamped+-- for both 2D and 3D functions, and so will not exceed \( +1 \).+fbmStep :: (RealFrac a) => a -> FractalStep a+fbmStep wS raw = (# raw, lerp 1 (min (raw + 1) 2 * 0.5) wS #)+{-# INLINE fbmStep #-} --- | Noise modifier for billow fractal.+-- | Step for billow fractals ----- 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.+-- Creates puffy looking noise. Feels something like clouds. ----- 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.+-- See: https://ambient.data-imaginist.com/reference/billow.html ----- 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 #-}+-- No direct FastNoiseLite equivalent.+billowStep :: (RealFrac a) => a -> FractalStep a+billowStep wS raw =+  let !b = abs raw * 2 - 1+   in (# b, lerp 1 (min (b + 1) 2 * 0.5) wS #)+{-# INLINE billowStep #-} --- | Amplitude modifier for ridged fractal.+-- | Step for ridged fractals ----- 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 #-}+-- Creates angular/sharp noise. Feels something like a mountain range.+--+-- Equivalent to FNL's @GenFractalRidged@.+ridgedStep :: (RealFrac a) => a -> FractalStep a+ridgedStep wS raw =+  let !n = abs raw+   in (# n * (-2) + 1, lerp 1 (1 - n) wS #)+{-# INLINE ridgedStep #-}  -- | Strength parameter for ping-pong fractal noise. --@@ -279,21 +304,19 @@ defaultPingPongStrength = PingPongStrength 2 {-# INLINE defaultPingPongStrength #-} --- | Noise modifier for ping-pong fractal.+-- | Step 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-      t = n' - fromIntegral @Int (truncate (n' * 0.5) * 2)-   in 1 - abs (t - 1)-{-# INLINE pingPongNoiseMod #-}---- | Amplitude modifier for ping-pong fractal.+-- Creates wavy, intense noise. ----- 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 #-}+-- Equivalent to FNL's @GenFractalPingPong@+pingPongStep :: (RealFrac a) => PingPongStrength a -> a -> FractalStep a+pingPongStep (PingPongStrength strength) wS raw =+  let !n = pingPong ((raw + 1) * strength)+   in (# (n - 0.5) * 2, lerp 1 n wS #)+{-# INLINE pingPongStep #-}++pingPong :: (RealFrac a) => a -> a+pingPong t0 =+  let !t = t0 - fromIntegral @Int (truncate (t0 * 0.5) * 2)+   in 1 - abs (t - 1)+{-# INLINE pingPong #-}
src/Numeric/Noise/Internal.hs view
@@ -47,17 +47,11 @@ -- |  'Noise' represents a function from a 'Seed' and coordinates @p@ to a noise -- value @v@. ----- For convenience, dimension-specific type aliases are provided: 'Noise1',--- 'Noise2', and 'Noise3', plus primed variants that separate the coordinate--- and value types.+-- For convenience, dimension-specific type aliases are provided. -- -- Use 'warp' to transform coordinates and 'remap' (or 'fmap') to transform values. ----- To evaluate noise functions, use 'noise1At', 'noise2At', or 'noise3At'.------ NB: 'Noise' is a lawful 'Profunctor' where 'lmap' = warp and 'rmap' = remap.--- There are some useful implications to this, but pure-noise is committed to--- a minimal dependency footprint and so will not provide this instance itself.+-- To evaluate noise functions, use 'noise1At', 'noise2At', or 'noise3At' -- -- === __Algebraic composition__ --@@ -65,7 +59,7 @@ -- -- @ -- combined :: Noise (Float, Float) Float--- combined = (perlin2 + superSimplex2) / 2+-- combined = (perlin2 + smootherSimplex2) / 2 -- @ -- -- === __Coordinate Transformation__@@ -77,14 +71,13 @@ -- scaled :: Noise2 Float -- scaled = warp (\\(x, y) -> (x * 2, y * 2)) perlin2 -- @-newtype Noise p v = Noise {unNoise :: Seed -> p -> v}---- NOTE: Noise p v is isomorphic to Reader (Seed, p), so it has trivial--- instances of Monad and Category, Arrow, ArrowChoice, ArrowApply, etc. ----- I've decided not to include Category et al. as instances for now--- because I can't come up with a use-case that is not sufficiently--- covered by the monad instance.+-- === Noise optics and category composition+--+-- A trivial 'Profunctor' instance where 'lmap' = 'warp' and 'rmap' = 'remap'+-- can be defined for `Noise`, which produces some kind of nice capabilities for+-- abstract composition and optics.+newtype Noise p v = Noise {unNoise :: Seed -> p -> v}  -- | Noise admits 'Functor' on the value it produces instance Functor (Noise p) where@@ -101,14 +94,14 @@ -- -- @ -- do n1 <- perlin2---    n2 <- superSimplex2+--    n2 <- smootherSimplex2 --    return (n1 + n2) -- @ -- -- is equivalent to: -- -- @--- perlin2 + superSimplex2+-- perlin2 + smootherSimplex2 -- @ -- -- This is useful for domain warping.@@ -234,7 +227,7 @@ -- This allows you to scale, rotate, or otherwise modify coordinates before -- they're passed to the noise function: ----- NB: This is 'Data.Functor.Contravariant.contramap'+-- NB: This is 'contramap' -- -- === __Examples__ --@@ -281,11 +274,11 @@ -- @ -- -- Multiply two noise functions -- multiplied :: Noise2 Float--- multiplied = blend (*) perlin2 superSimplex2+-- multiplied = blend (*) perlin2 smootherSimplex2 -- -- -- Custom blending based on values -- custom :: Noise2 Float--- custom = blend (\\a b -> if a > 0 then a else b) perlin2 superSimplex2+-- custom = blend (\\a b -> if a > 0 then a else b) perlin2 smootherSimplex2 -- @ blend :: (a -> b -> c) -> Noise p a -> Noise p b -> Noise p c blend = liftA2@@ -367,7 +360,7 @@ sliceZ3 z = warp (\(x, y) -> (x, y, z)) {-# INLINE sliceZ3 #-} --- | Increment the seed for a 2D noise function. See 'reseed'.+-- | Increment the seed for a 2D noise function. See 'reseed' next2 :: Noise2 a -> Noise2 a next2 = reseed (+ 1) {-# INLINE next2 #-}@@ -382,12 +375,14 @@ const2 = pure {-# INLINE const2 #-} --- | Increment the seed for a 3D noise function. See 'reseed'.+-- | Increment the seed for a 3D noise function. See 'reseed' next3 :: Noise3 a -> Noise3 a next3 = reseed (+ 1) {-# INLINE next3 #-} --- | A noise function that produces the same value everywhere. Alias of 'pure'.+-- | A noise function that produces the same value everywhere. Alias of 'pure'+--+-- Used to provide the 'Num' instance. const3 :: a -> Noise3 a const3 = pure {-# INLINE const3 #-}
src/Numeric/Noise/Internal/Math.hs view
@@ -216,14 +216,16 @@ valCoord2 :: (RealFrac a) => Seed -> Hash -> Hash -> a valCoord2 seed xPrimed yPrimed =   let !hash = hash2 seed xPrimed yPrimed-      !val = (hash * hash) `xor` (hash `shiftL` 19)+      !h2 = hash * hash+      !val = h2 `xor` (h2 `shiftL` 19)    in fromIntegral val * recip (maxHash + 1) {-# INLINE valCoord2 #-}  valCoord3 :: (RealFrac a) => Seed -> Hash -> Hash -> Hash -> a valCoord3 seed xPrimed yPrimed zPrimed =   let !hash = hash3 seed xPrimed yPrimed zPrimed-      !val = (hash * hash) `xor` (hash `shiftL` 19)+      !h2 = hash * hash+      !val = h2 `xor` (h2 `shiftL` 19)    in fromIntegral val * recip (maxHash + 1) {-# INLINE valCoord3 #-} 
+ src/Numeric/Noise/SmootherSimplex.hs view
@@ -0,0 +1,290 @@+{-# LANGUAGE Strict #-}++-- |+-- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>+-- Stability: experimental+--+-- This module implements a variation of OpenSimplex2S noise derived from+-- FastNoiseLite, exported from "Numeric.Noise" as 'Numeric.Noise.smootherSimplex2'+-- and 'Numeric.Noise.smootherSimplex3'.+module Numeric.Noise.SmootherSimplex (+  -- * 2D Noise+  noise2,+  noise2Base,++  -- * 3D Noise+  noise3,+  noise3Base,+) where++import Data.Bits+import Data.Bool (bool)+import Numeric.Noise.Internal+import Numeric.Noise.Internal.Math++noise2 :: (RealFrac a) => Noise2 a+noise2 = mkNoise2 noise2Base+{-# INLINE noise2 #-}++noise2Base :: (RealFrac a) => Seed -> a -> a -> a+noise2Base seed xo yo =+  let f2 = 0.5 * (sqrt3 - 1)+      to = (xo + yo) * f2+      x = xo + to+      y = yo + to++      fx = floor x+      fy = floor y+      xi = x - fromIntegral @Hash fx+      yi = y - fromIntegral @Hash fy++      i = fx * primeX+      j = fy * primeY+      i1 = i + primeX+      j1 = j + primeY++      t = (xi + yi) * g2+      x0 = xi - t+      y0 = yi - t++      a0 = (2 / 3) - x0 * x0 - y0 * y0+      v0 = (a0 * a0) * (a0 * a0) * gradCoord2 seed i j x0 y0++      v1 =+        let g2t = 1 - 2 * g2+            a1 =+              (2 * g2t * (1 / g2 - 2)) * t+                + ((-2 * g2t * g2t) + a0)+            x1 = x0 - g2t+            y1 = y0 - g2t+         in (a1 * a1) * (a1 * a1) * gradCoord2 seed i1 j1 x1 y1++      xmyi = xi - yi++      ~vgx+        | xi + xmyi > 1 =+            let ~x2 = x0 + (3 * g2 - 2)+                ~y2 = y0 + (3 * g2 - 1)+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed (i + (primeX `shiftL` 1)) (j + primeY) x2 y2+        | otherwise =+            let ~x2 = x0 + g2+                ~y2 = y0 + (g2 - 1)+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed i (j + primeY) x2 y2++      ~vgy+        | yi - xmyi > 1 =+            let ~x3 = x0 + (3 * g2 - 1)+                ~y3 = y0 + (3 * g2 - 2)+                ~a3 = (2 / 3) - x3 * x3 - y3 * y3+             in attenuate a3 seed (i + primeX) (j + (primeY `shiftL` 1)) x3 y3+        | otherwise =+            let ~x3 = x0 + (g2 - 1)+                ~y3 = y0 + g2+                ~a3 = (2 / 3) - x3 * x3 - y3 * y3+             in attenuate a3 seed (i + primeX) j x3 y3++      ~vlx+        | xi + xmyi < 0 =+            let ~x2 = x0 + (1 - g2)+                ~y2 = y0 - g2+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed (i - primeX) j x2 y2+        | otherwise =+            let ~x2 = x0 + (g2 - 1)+                ~y2 = y0 + g2+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed (i + primeX) j x2 y2+      ~vly+        | yi < xmyi =+            let ~x2 = x0 - g2+                ~y2 = y0 - (g2 - 1)+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed i (j - primeY) x2 y2+        | otherwise =+            let ~x2 = x0 + g2+                ~y2 = y0 + (g2 - 1)+                ~a2 = (2 / 3) - x2 * x2 - y2 * y2+             in attenuate a2 seed i (j + primeY) x2 y2++      v2+        | t > g2 = vgx + vgy+        | otherwise = vlx + vly+   in normalize $ v0 + v1 + v2+{-# INLINE [2] noise2Base #-}++attenuate :: (RealFrac a) => a -> Seed -> Hash -> Hash -> a -> a -> a+attenuate !vi !seed !i !j !x !y =+  let !v = max 0 vi+   in (v * v) * (v * v) * gradCoord2 seed i j x y+{-# INLINE attenuate #-}++normalize :: (RealFrac a) => a -> a+normalize = (18.24196194486065 *)+{-# INLINE normalize #-}++noise3 :: (RealFrac a) => Noise3 a+noise3 = mkNoise3 noise3Base+{-# INLINE noise3 #-}++noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a+noise3Base seed xo yo zo =+  let (x, y, z) = rotate3 xo yo zo++      fi = floor x :: Hash+      fj = floor y :: Hash+      fk = floor z :: Hash+      xi = x - fromIntegral fi+      yi = y - fromIntegral fj+      zi = z - fromIntegral fk++      i = fi * primeX+      j = fj * primeY+      k = fk * primeZ+      seed2 = seed + 1293373++      -- FNL: (int)(-0.5f - xi), i.e. -1 when the offset is >= 0.5, else 0+      xnm = bool 0 (-1) (xi >= 0.5) :: Hash+      ynm = bool 0 (-1) (yi >= 0.5) :: Hash+      znm = bool 0 (-1) (zi >= 0.5) :: Hash++      x0 = xi + fromIntegral xnm+      y0 = yi + fromIntegral ynm+      z0 = zi + fromIntegral znm+      a0 = 0.75 - x0 * x0 - y0 * y0 - z0 * z0+      v0 =+        q a0+          * gradCoord3 seed (i + (xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (znm .&. primeZ)) x0 y0 z0++      x1 = xi - 0.5+      y1 = yi - 0.5+      z1 = zi - 0.5+      a1 = 0.75 - x1 * x1 - y1 * y1 - z1 * z1+      v1 = q a1 * gradCoord3 seed2 (i + primeX) (j + primeY) (k + primeZ) x1 y1 z1++      xFlip0 = fromIntegral ((xnm .|. 1) `shiftL` 1) * x1+      yFlip0 = fromIntegral ((ynm .|. 1) `shiftL` 1) * y1+      zFlip0 = fromIntegral ((znm .|. 1) `shiftL` 1) * z1+      xFlip1 = fromIntegral (-2 - (xnm `shiftL` 2)) * x1 - 1.0+      yFlip1 = fromIntegral (-2 - (ynm `shiftL` 2)) * y1 - 1.0+      zFlip1 = fromIntegral (-2 - (znm `shiftL` 2)) * z1 - 1.0++      a2 = xFlip0 + a0+      ~(vX, skip5)+        | a2 > 0 =+            let ~x2 = x0 - fromIntegral (xnm .|. 1)+             in ( q a2+                    * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (znm .&. primeZ)) x2 y0 z0+                , False+                )+        | otherwise =+            let a3 = yFlip0 + zFlip0 + a0+                ~v3+                  | a3 > 0 =+                      let ~y3 = y0 - fromIntegral (ynm .|. 1)+                          ~z3 = z0 - fromIntegral (znm .|. 1)+                       in q a3+                            * gradCoord3 seed (i + (xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (complement znm .&. primeZ)) x0 y3 z3+                  | otherwise = 0+                a4 = xFlip1 + a1+                ~(v4, sk)+                  | a4 > 0 =+                      let ~x4 = fromIntegral (xnm .|. 1) + x1+                       in ( q a4+                              * gradCoord3 seed2 (i + (xnm .&. (primeX * 2))) (j + primeY) (k + primeZ) x4 y1 z1+                          , True+                          )+                  | otherwise = (0, False)+             in (v3 + v4, sk)++      a6 = yFlip0 + a0+      ~(vY, skip9)+        | a6 > 0 =+            let ~y6 = y0 - fromIntegral (ynm .|. 1)+             in ( q a6+                    * gradCoord3 seed (i + (xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (znm .&. primeZ)) x0 y6 z0+                , False+                )+        | otherwise =+            let a7 = xFlip0 + zFlip0 + a0+                ~v7+                  | a7 > 0 =+                      let ~x7 = x0 - fromIntegral (xnm .|. 1)+                          ~z7 = z0 - fromIntegral (znm .|. 1)+                       in q a7+                            * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (complement znm .&. primeZ)) x7 y0 z7+                  | otherwise = 0+                a8 = yFlip1 + a1+                ~(v8, sk)+                  | a8 > 0 =+                      let ~y8 = fromIntegral (ynm .|. 1) + y1+                       in ( q a8+                              * gradCoord3 seed2 (i + primeX) (j + (ynm .&. (primeY `shiftL` 1))) (k + primeZ) x1 y8 z1+                          , True+                          )+                  | otherwise = (0, False)+             in (v7 + v8, sk)++      aA = zFlip0 + a0+      ~(vZ, skipD)+        | aA > 0 =+            let ~zA = z0 - fromIntegral (znm .|. 1)+             in ( q aA+                    * gradCoord3 seed (i + (xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (complement znm .&. primeZ)) x0 y0 zA+                , False+                )+        | otherwise =+            let aB = xFlip0 + yFlip0 + a0+                ~vB+                  | aB > 0 =+                      let ~xB = x0 - fromIntegral (xnm .|. 1)+                          ~yB = y0 - fromIntegral (ynm .|. 1)+                       in q aB+                            * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (znm .&. primeZ)) xB yB z0+                  | otherwise = 0+                aC = zFlip1 + a1+                ~(vC, sk)+                  | aC > 0 =+                      let ~zC = fromIntegral (znm .|. 1) + z1+                       in ( q aC+                              * gradCoord3 seed2 (i + primeX) (j + primeY) (k + (znm .&. (primeZ `shiftL` 1))) x1 y1 zC+                          , True+                          )+                  | otherwise = (0, False)+             in (vB + vC, sk)++      ~v5+        | not skip5+        , a5 <- yFlip1 + zFlip1 + a1+        , a5 > 0 =+            let ~y5 = fromIntegral (ynm .|. 1) + y1+                ~z5 = fromIntegral (znm .|. 1) + z1+             in q a5+                  * gradCoord3 seed2 (i + primeX) (j + (ynm .&. (primeY `shiftL` 1))) (k + (znm .&. (primeZ `shiftL` 1))) x1 y5 z5+        | otherwise = 0++      ~v9+        | not skip9+        , a9 <- xFlip1 + zFlip1 + a1+        , a9 > 0 =+            let ~x9 = fromIntegral (xnm .|. 1) + x1+                ~z9 = fromIntegral (znm .|. 1) + z1+             in q a9+                  * gradCoord3 seed2 (i + (xnm .&. (primeX * 2))) (j + primeY) (k + (znm .&. (primeZ `shiftL` 1))) x9 y1 z9+        | otherwise = 0++      ~vD+        | not skipD+        , aD <- xFlip1 + yFlip1 + a1+        , aD > 0 =+            let ~xD = fromIntegral (xnm .|. 1) + x1+                ~yD = fromIntegral (ynm .|. 1) + y1+             in q aD+                  * gradCoord3 seed2 (i + (xnm .&. (primeX `shiftL` 1))) (j + (ynm .&. (primeY `shiftL` 1))) (k + primeZ) xD yD z1+        | otherwise = 0+   in (v0 + v1 + vX + vY + vZ + v5 + v9 + vD) * 9.046026385208288+ where+  q a = (a * a) * (a * a)+  {-# INLINE q #-}+{-# INLINE [2] noise3Base #-}
− src/Numeric/Noise/SuperSimplex.hs
@@ -1,290 +0,0 @@-{-# LANGUAGE Strict #-}---- |--- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>--- Stability: experimental------ This module implements a variation of OpenSimplex2S noise derived from--- FastNoiseLite, exported from "Numeric.Noise" as 'Numeric.Noise.superSimplex2'--- and 'Numeric.Noise.superSimplex3'.-module Numeric.Noise.SuperSimplex (-  -- * 2D Noise-  noise2,-  noise2Base,--  -- * 3D Noise-  noise3,-  noise3Base,-) where--import Data.Bits-import Data.Bool (bool)-import Numeric.Noise.Internal-import Numeric.Noise.Internal.Math--noise2 :: (RealFrac a) => Noise2 a-noise2 = mkNoise2 noise2Base-{-# INLINE noise2 #-}--noise2Base :: (RealFrac a) => Seed -> a -> a -> a-noise2Base seed xo yo =-  let f2 = 0.5 * (sqrt3 - 1)-      to = (xo + yo) * f2-      x = xo + to-      y = yo + to--      fx = floor x-      fy = floor y-      xi = x - fromIntegral @Hash fx-      yi = y - fromIntegral @Hash fy--      i = fx * primeX-      j = fy * primeY-      i1 = i + primeX-      j1 = j + primeY--      t = (xi + yi) * g2-      x0 = xi - t-      y0 = yi - t--      a0 = (2 / 3) - x0 * x0 - y0 * y0-      v0 = (a0 * a0) * (a0 * a0) * gradCoord2 seed i j x0 y0--      v1 =-        let g2t = 1 - 2 * g2-            a1 =-              (2 * g2t * (1 / g2 - 2)) * t-                + ((-2 * g2t * g2t) + a0)-            x1 = x0 - g2t-            y1 = y0 - g2t-         in (a1 * a1) * (a1 * a1) * gradCoord2 seed i1 j1 x1 y1--      xmyi = xi - yi--      ~vgx-        | xi + xmyi > 1 =-            let ~x2 = x0 + (3 * g2 - 2)-                ~y2 = y0 + (3 * g2 - 1)-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed (i + (primeX `shiftL` 1)) (j + primeY) x2 y2-        | otherwise =-            let ~x2 = x0 + g2-                ~y2 = y0 + (g2 - 1)-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed i (j + primeY) x2 y2--      ~vgy-        | yi - xmyi > 1 =-            let ~x3 = x0 + (3 * g2 - 1)-                ~y3 = y0 + (3 * g2 - 2)-                ~a3 = (2 / 3) - x3 * x3 - y3 * y3-             in attenuate a3 seed (i + primeX) (j + (primeY `shiftL` 1)) x3 y3-        | otherwise =-            let ~x3 = x0 + (g2 - 1)-                ~y3 = y0 + g2-                ~a3 = (2 / 3) - x3 * x3 - y3 * y3-             in attenuate a3 seed (i + primeX) j x3 y3--      ~vlx-        | xi + xmyi < 0 =-            let ~x2 = x0 + (1 - g2)-                ~y2 = y0 - g2-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed (i - primeX) j x2 y2-        | otherwise =-            let ~x2 = x0 + (g2 - 1)-                ~y2 = y0 + g2-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed (i + primeX) j x2 y2-      ~vly-        | yi < xmyi =-            let ~x2 = x0 - g2-                ~y2 = y0 - (g2 - 1)-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed i (j - primeY) x2 y2-        | otherwise =-            let ~x2 = x0 + g2-                ~y2 = y0 + (g2 - 1)-                ~a2 = (2 / 3) - x2 * x2 - y2 * y2-             in attenuate a2 seed i (j + primeY) x2 y2--      v2-        | t > g2 = vgx + vgy-        | otherwise = vlx + vly-   in normalize $ v0 + v1 + v2-{-# INLINE [2] noise2Base #-}--attenuate :: (RealFrac a) => a -> Seed -> Hash -> Hash -> a -> a -> a-attenuate !vi !seed !i !j !x !y =-  let !v = max 0 vi-   in (v * v) * (v * v) * gradCoord2 seed i j x y-{-# INLINE attenuate #-}--normalize :: (RealFrac a) => a -> a-normalize = (18.24196194486065 *)-{-# INLINE normalize #-}--noise3 :: (RealFrac a) => Noise3 a-noise3 = mkNoise3 noise3Base-{-# INLINE noise3 #-}--noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a-noise3Base seed xo yo zo =-  let (x, y, z) = rotate3 xo yo zo--      fi = floor x :: Hash-      fj = floor y :: Hash-      fk = floor z :: Hash-      xi = x - fromIntegral fi-      yi = y - fromIntegral fj-      zi = z - fromIntegral fk--      i = fi * primeX-      j = fj * primeY-      k = fk * primeZ-      seed2 = seed + 1293373--      -- FNL: (int)(-0.5f - xi), i.e. -1 when the offset is >= 0.5, else 0-      xnm = bool 0 (-1) (xi >= 0.5) :: Hash-      ynm = bool 0 (-1) (yi >= 0.5) :: Hash-      znm = bool 0 (-1) (zi >= 0.5) :: Hash--      x0 = xi + fromIntegral xnm-      y0 = yi + fromIntegral ynm-      z0 = zi + fromIntegral znm-      a0 = 0.75 - x0 * x0 - y0 * y0 - z0 * z0-      v0 =-        q a0-          * gradCoord3 seed (i + (xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (znm .&. primeZ)) x0 y0 z0--      x1 = xi - 0.5-      y1 = yi - 0.5-      z1 = zi - 0.5-      a1 = 0.75 - x1 * x1 - y1 * y1 - z1 * z1-      v1 = q a1 * gradCoord3 seed2 (i + primeX) (j + primeY) (k + primeZ) x1 y1 z1--      xFlip0 = fromIntegral ((xnm .|. 1) `shiftL` 1) * x1-      yFlip0 = fromIntegral ((ynm .|. 1) `shiftL` 1) * y1-      zFlip0 = fromIntegral ((znm .|. 1) `shiftL` 1) * z1-      xFlip1 = fromIntegral (-2 - (xnm `shiftL` 2)) * x1 - 1.0-      yFlip1 = fromIntegral (-2 - (ynm `shiftL` 2)) * y1 - 1.0-      zFlip1 = fromIntegral (-2 - (znm `shiftL` 2)) * z1 - 1.0--      a2 = xFlip0 + a0-      ~(vX, skip5)-        | a2 > 0 =-            let ~x2 = x0 - fromIntegral (xnm .|. 1)-             in ( q a2-                    * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (znm .&. primeZ)) x2 y0 z0-                , False-                )-        | otherwise =-            let a3 = yFlip0 + zFlip0 + a0-                ~v3-                  | a3 > 0 =-                      let ~y3 = y0 - fromIntegral (ynm .|. 1)-                          ~z3 = z0 - fromIntegral (znm .|. 1)-                       in q a3-                            * gradCoord3 seed (i + (xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (complement znm .&. primeZ)) x0 y3 z3-                  | otherwise = 0-                a4 = xFlip1 + a1-                ~(v4, sk)-                  | a4 > 0 =-                      let ~x4 = fromIntegral (xnm .|. 1) + x1-                       in ( q a4-                              * gradCoord3 seed2 (i + (xnm .&. (primeX * 2))) (j + primeY) (k + primeZ) x4 y1 z1-                          , True-                          )-                  | otherwise = (0, False)-             in (v3 + v4, sk)--      a6 = yFlip0 + a0-      ~(vY, skip9)-        | a6 > 0 =-            let ~y6 = y0 - fromIntegral (ynm .|. 1)-             in ( q a6-                    * gradCoord3 seed (i + (xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (znm .&. primeZ)) x0 y6 z0-                , False-                )-        | otherwise =-            let a7 = xFlip0 + zFlip0 + a0-                ~v7-                  | a7 > 0 =-                      let ~x7 = x0 - fromIntegral (xnm .|. 1)-                          ~z7 = z0 - fromIntegral (znm .|. 1)-                       in q a7-                            * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (complement znm .&. primeZ)) x7 y0 z7-                  | otherwise = 0-                a8 = yFlip1 + a1-                ~(v8, sk)-                  | a8 > 0 =-                      let ~y8 = fromIntegral (ynm .|. 1) + y1-                       in ( q a8-                              * gradCoord3 seed2 (i + primeX) (j + (ynm .&. (primeY `shiftL` 1))) (k + primeZ) x1 y8 z1-                          , True-                          )-                  | otherwise = (0, False)-             in (v7 + v8, sk)--      aA = zFlip0 + a0-      ~(vZ, skipD)-        | aA > 0 =-            let ~zA = z0 - fromIntegral (znm .|. 1)-             in ( q aA-                    * gradCoord3 seed (i + (xnm .&. primeX)) (j + (ynm .&. primeY)) (k + (complement znm .&. primeZ)) x0 y0 zA-                , False-                )-        | otherwise =-            let aB = xFlip0 + yFlip0 + a0-                ~vB-                  | aB > 0 =-                      let ~xB = x0 - fromIntegral (xnm .|. 1)-                          ~yB = y0 - fromIntegral (ynm .|. 1)-                       in q aB-                            * gradCoord3 seed (i + (complement xnm .&. primeX)) (j + (complement ynm .&. primeY)) (k + (znm .&. primeZ)) xB yB z0-                  | otherwise = 0-                aC = zFlip1 + a1-                ~(vC, sk)-                  | aC > 0 =-                      let ~zC = fromIntegral (znm .|. 1) + z1-                       in ( q aC-                              * gradCoord3 seed2 (i + primeX) (j + primeY) (k + (znm .&. (primeZ `shiftL` 1))) x1 y1 zC-                          , True-                          )-                  | otherwise = (0, False)-             in (vB + vC, sk)--      ~v5-        | not skip5-        , a5 <- yFlip1 + zFlip1 + a1-        , a5 > 0 =-            let ~y5 = fromIntegral (ynm .|. 1) + y1-                ~z5 = fromIntegral (znm .|. 1) + z1-             in q a5-                  * gradCoord3 seed2 (i + primeX) (j + (ynm .&. (primeY `shiftL` 1))) (k + (znm .&. (primeZ `shiftL` 1))) x1 y5 z5-        | otherwise = 0--      ~v9-        | not skip9-        , a9 <- xFlip1 + zFlip1 + a1-        , a9 > 0 =-            let ~x9 = fromIntegral (xnm .|. 1) + x1-                ~z9 = fromIntegral (znm .|. 1) + z1-             in q a9-                  * gradCoord3 seed2 (i + (xnm .&. (primeX * 2))) (j + primeY) (k + (znm .&. (primeZ `shiftL` 1))) x9 y1 z9-        | otherwise = 0--      ~vD-        | not skipD-        , aD <- xFlip1 + yFlip1 + a1-        , aD > 0 =-            let ~xD = fromIntegral (xnm .|. 1) + x1-                ~yD = fromIntegral (ynm .|. 1) + y1-             in q aD-                  * gradCoord3 seed2 (i + (xnm .&. (primeX `shiftL` 1))) (j + (ynm .&. (primeY `shiftL` 1))) (k + primeZ) xD yD z1-        | otherwise = 0-   in (v0 + v1 + vX + vY + vZ + v5 + v9 + vD) * 9.046026385208288- where-  q a = (a * a) * (a * a)-  {-# INLINE q #-}-{-# INLINE [2] noise3Base #-}
test/FractalSpec.hs view
@@ -14,6 +14,8 @@     , testGroup "2D Sparse Tests" fractal2DSparseTests     , testGroup "3D Grid Tests" fractal3DGridTests     , testGroup "3D Sparse Tests" fractal3DSparseTests+    , testGroup "2D Weighted Sparse Tests" fractal2DWeightedSparseTests+    , testGroup "3D Weighted Sparse Tests" fractal3DWeightedSparseTests     ]  -- Fractal types to test@@ -66,3 +68,46 @@   , seed <- cellularSeeds   , let variant = show fractalType ++ "-perlin-3d-seed" ++ show seed   ]++weightedFractalConfig :: FractalConfig Double+weightedFractalConfig = defaultFractalConfig{weightedStrength = 0.5}++applyWeighted2D :: FractalType -> Noise2 Double -> Noise2 Double+applyWeighted2D FBM = fractal2 weightedFractalConfig+applyWeighted2D Billow = billow2 weightedFractalConfig+applyWeighted2D Ridged = ridged2 weightedFractalConfig+applyWeighted2D PingPong = pingPong2 weightedFractalConfig defaultPingPongStrength++applyWeighted3D :: FractalType -> Noise3 Double -> Noise3 Double+applyWeighted3D FBM = fractal3 weightedFractalConfig+applyWeighted3D Billow = billow3 weightedFractalConfig+applyWeighted3D Ridged = ridged3 weightedFractalConfig+applyWeighted3D PingPong = pingPong3 weightedFractalConfig defaultPingPongStrength++fractal2DWeightedSparseTests :: [TestTree]+fractal2DWeightedSparseTests =+  [ goldenSparseTest2D "fractal" variant (applyWeighted2D fractalType perlin2) seed+  | fractalType <- [minBound .. maxBound]+  , seed <- cellularSeeds+  , let variant = show fractalType ++ "-perlin-2d-weighted-seed" ++ show seed+  ]+    ++ [ goldenSparseTest2D+           "fractal"+           "FBM-perlin-scaled-2d-weighted-seed42"+           (fractal2 weightedFractalConfig (perlin2 * 2))+           42+       ]++fractal3DWeightedSparseTests :: [TestTree]+fractal3DWeightedSparseTests =+  [ goldenSparseTest3D "fractal" variant (applyWeighted3D fractalType perlin3) seed+  | fractalType <- [minBound .. maxBound]+  , seed <- cellularSeeds+  , let variant = show fractalType ++ "-perlin-3d-weighted-seed" ++ show seed+  ]+    ++ [ goldenSparseTest3D+           "fractal"+           "FBM-perlin-scaled-3d-weighted-seed42"+           (fractal3 weightedFractalConfig (perlin3 * 2))+           42+       ]
test/Golden/Util.hs view
@@ -280,9 +280,9 @@  where   throwIfDoesNotExist = do     exists <- doesFileExist ref-    unless exists $-      ioError $-        errnoToIOError "goldenVsFileDiff" eNOENT Nothing Nothing+    unless exists+      $ ioError+      $ errnoToIOError "goldenVsFileDiff" eNOENT Nothing Nothing   runDiff     :: SizeCutoff     -> IO (Maybe String)@@ -303,7 +303,7 @@         procConf = PT.setStdin PT.closed proc      (exitCode, out) <- PT.readProcessInterleaved procConf-    return $ case exitCode of+    pure $ case exitCode of       ExitSuccess -> Nothing       _ -> Just . LT.unpack . LT.decodeUtf8 . truncateLargeOutput sizeCutoff $ out   truncateLargeOutput (SizeCutoff n) str =
test/Noise3Spec.hs view
@@ -46,4 +46,4 @@ prop_1_is_multiplicative_identity :: Rational -> Rational -> Rational -> Rational -> Bool prop_1_is_multiplicative_identity v x y z =   let n1 = const3 v-   in noise3At (n1 * 1) seed x y z == v+   in noise3At n1 seed x y z == v
test/PerlinSpec.hs view
@@ -15,13 +15,13 @@  prop_noise2_addition_associative :: Rational -> Rational -> Bool prop_noise2_addition_associative x y =-  noise2At ((noinline perlin2 + noinline superSimplex2) + noinline openSimplex2) seed x y-    == noise2At (perlin2 + (noinline superSimplex2 + noinline openSimplex2)) seed x y+  noise2At ((noinline perlin2 + noinline smootherSimplex2) + noinline openSimplex2) seed x y+    == noise2At (perlin2 + (noinline smootherSimplex2 + noinline openSimplex2)) seed x y  prop_noise2_addition_commutative :: Rational -> Rational -> Bool prop_noise2_addition_commutative x y =-  noise2At (noinline perlin2 + noinline superSimplex2) seed x y-    == noise2At (noinline superSimplex2 + noinline perlin2) seed x y+  noise2At (noinline perlin2 + noinline smootherSimplex2) seed x y+    == noise2At (noinline smootherSimplex2 + noinline perlin2) seed x y  test_golden_perlin :: TestTree test_golden_perlin =
+ test/SmootherSimplexSpec.hs view
@@ -0,0 +1,27 @@+module SmootherSimplexSpec (test_golden_smoothersimplex) where++import Golden.Util+import Numeric.Noise+import Test.Tasty (TestTree, testGroup)++test_golden_smoothersimplex :: TestTree+test_golden_smoothersimplex =+  testGroup+    "SmootherSimplex Golden Tests"+    [ testGroup "2D Grid Tests" smootherSimplex2DGridTests+    , testGroup "2D Sparse Tests" smootherSimplex2DSparseTests+    , testGroup "3D Grid Tests" smootherSimplex3DGridTests+    , testGroup "3D Sparse Tests" smootherSimplex3DSparseTests+    ]++smootherSimplex2DGridTests :: [TestTree]+smootherSimplex2DGridTests = golden2DImageTests "smoothersimplex" defaultSeeds smootherSimplex2++smootherSimplex2DSparseTests :: [TestTree]+smootherSimplex2DSparseTests = golden2DSparseTests "smoothersimplex" defaultSeeds smootherSimplex2++smootherSimplex3DGridTests :: [TestTree]+smootherSimplex3DGridTests = golden3DImageTests "smoothersimplex" defaultSeeds smootherSimplex3++smootherSimplex3DSparseTests :: [TestTree]+smootherSimplex3DSparseTests = golden3DSparseTests "smoothersimplex" defaultSeeds smootherSimplex3
− test/SuperSimplexSpec.hs
@@ -1,27 +0,0 @@-module SuperSimplexSpec (test_golden_supersimplex) where--import Golden.Util-import Numeric.Noise-import Test.Tasty (TestTree, testGroup)--test_golden_supersimplex :: TestTree-test_golden_supersimplex =-  testGroup-    "SuperSimplex Golden Tests"-    [ testGroup "2D Grid Tests" superSimplex2DGridTests-    , testGroup "2D Sparse Tests" superSimplex2DSparseTests-    , testGroup "3D Grid Tests" superSimplex3DGridTests-    , testGroup "3D Sparse Tests" superSimplex3DSparseTests-    ]--superSimplex2DGridTests :: [TestTree]-superSimplex2DGridTests = golden2DImageTests "supersimplex" defaultSeeds superSimplex2--superSimplex2DSparseTests :: [TestTree]-superSimplex2DSparseTests = golden2DSparseTests "supersimplex" defaultSeeds superSimplex2--superSimplex3DGridTests :: [TestTree]-superSimplex3DGridTests = golden3DImageTests "supersimplex" defaultSeeds superSimplex3--superSimplex3DSparseTests :: [TestTree]-superSimplex3DSparseTests = golden3DSparseTests "supersimplex" defaultSeeds superSimplex3
test/TotalitySpec.hs view
@@ -19,7 +19,7 @@ noises2 =   [ ("perlin2", perlin2)   , ("openSimplex2", openSimplex2)-  , ("superSimplex2", superSimplex2)+  , ("smootherSimplex2", smootherSimplex2)   , ("value2", value2)   , ("valueCubic2", valueCubic2)   , ("cellular2", cellular2 defaultCellularConfig)@@ -30,7 +30,7 @@ noises3 =   [ ("perlin3", perlin3)   , ("openSimplex3", openSimplex3)-  , ("superSimplex3", superSimplex3)+  , ("smootherSimplex3", smootherSimplex3)   , ("value3", value3)   , ("valueCubic3", valueCubic3)   , ("cellular3", cellular3 defaultCellularConfig)