diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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: + ## 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 diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -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) ] ] diff --git a/bench/fnl-compare/FnlBench.hs b/bench/fnl-compare/FnlBench.hs --- a/bench/fnl-compare/FnlBench.hs +++ b/bench/fnl-compare/FnlBench.hs @@ -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) ] ] diff --git a/doctest/Doctest.hs b/doctest/Doctest.hs new file mode 100644 --- /dev/null +++ b/doctest/Doctest.hs @@ -0,0 +1,7 @@ +module Main (main) where + +import System.Environment (getArgs) +import Test.DocTest (mainFromCabal) + +main :: IO () +main = mainFromCabal "pure-noise" =<< getArgs diff --git a/pure-noise.cabal b/pure-noise.cabal --- a/pure-noise.cabal +++ b/pure-noise.cabal @@ -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 diff --git a/src/Numeric/Noise.hs b/src/Numeric/Noise.hs --- a/src/Numeric/Noise.hs +++ b/src/Numeric/Noise.hs @@ -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 diff --git a/src/Numeric/Noise/Fractal.hs b/src/Numeric/Noise/Fractal.hs --- a/src/Numeric/Noise/Fractal.hs +++ b/src/Numeric/Noise/Fractal.hs @@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} +{-# LANGUAGE UnboxedTuples #-} -- | -- Maintainer: Jeremy Nuttall @@ -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 #-} diff --git a/src/Numeric/Noise/Internal.hs b/src/Numeric/Noise/Internal.hs --- a/src/Numeric/Noise/Internal.hs +++ b/src/Numeric/Noise/Internal.hs @@ -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 #-} diff --git a/src/Numeric/Noise/Internal/Math.hs b/src/Numeric/Noise/Internal/Math.hs --- a/src/Numeric/Noise/Internal/Math.hs +++ b/src/Numeric/Noise/Internal/Math.hs @@ -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 #-} diff --git a/src/Numeric/Noise/SmootherSimplex.hs b/src/Numeric/Noise/SmootherSimplex.hs new file mode 100644 --- /dev/null +++ b/src/Numeric/Noise/SmootherSimplex.hs @@ -0,0 +1,290 @@ +{-# LANGUAGE Strict #-} + +-- | +-- Maintainer: Jeremy Nuttall +-- 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 #-} diff --git a/src/Numeric/Noise/SuperSimplex.hs b/src/Numeric/Noise/SuperSimplex.hs deleted file mode 100644 --- a/src/Numeric/Noise/SuperSimplex.hs +++ /dev/null @@ -1,290 +0,0 @@ -{-# LANGUAGE Strict #-} - --- | --- Maintainer: Jeremy Nuttall --- 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 #-} diff --git a/test/FractalSpec.hs b/test/FractalSpec.hs --- a/test/FractalSpec.hs +++ b/test/FractalSpec.hs @@ -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 + ] diff --git a/test/Golden/Util.hs b/test/Golden/Util.hs --- a/test/Golden/Util.hs +++ b/test/Golden/Util.hs @@ -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 = diff --git a/test/Noise3Spec.hs b/test/Noise3Spec.hs --- a/test/Noise3Spec.hs +++ b/test/Noise3Spec.hs @@ -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 diff --git a/test/PerlinSpec.hs b/test/PerlinSpec.hs --- a/test/PerlinSpec.hs +++ b/test/PerlinSpec.hs @@ -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 = diff --git a/test/SmootherSimplexSpec.hs b/test/SmootherSimplexSpec.hs new file mode 100644 --- /dev/null +++ b/test/SmootherSimplexSpec.hs @@ -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 diff --git a/test/SuperSimplexSpec.hs b/test/SuperSimplexSpec.hs deleted file mode 100644 --- a/test/SuperSimplexSpec.hs +++ /dev/null @@ -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 diff --git a/test/TotalitySpec.hs b/test/TotalitySpec.hs --- a/test/TotalitySpec.hs +++ b/test/TotalitySpec.hs @@ -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)