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 +31/−0
- README.md +52/−33
- bench/Bench.hs +23/−23
- bench/fnl-compare/FnlBench.hs +2/−2
- doctest/Doctest.hs +7/−0
- pure-noise.cabal +29/−19
- src/Numeric/Noise.hs +32/−46
- src/Numeric/Noise/Fractal.hs +128/−105
- src/Numeric/Noise/Internal.hs +19/−24
- src/Numeric/Noise/Internal/Math.hs +4/−2
- src/Numeric/Noise/SmootherSimplex.hs +290/−0
- src/Numeric/Noise/SuperSimplex.hs +0/−290
- test/FractalSpec.hs +45/−0
- test/Golden/Util.hs +4/−4
- test/Noise3Spec.hs +1/−1
- test/PerlinSpec.hs +4/−4
- test/SmootherSimplexSpec.hs +27/−0
- test/SuperSimplexSpec.hs +0/−27
- test/TotalitySpec.hs +2/−2
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)