-- | Simplex noise functions in various dimensions.
--
-- Based on
-- [example Java code by Stefan Gustavson](https://weber.itn.liu.se/~stegu/simplexnoise/SimplexNoise.java).
-- Optimisations by Peter Eastman. Better rank ordering method for 4D by Stefan
-- Gustavson in 2012.
--
-- This code was placed in the public domain by its original author, Stefan
-- Gustavson. You may use it as you see fit, but attribution is appreciated.
--
-- <<docs/haddock/Geometry/Algorithms/SimplexNoise/simplex_noise.svg>>
--
-- === __(image code)__
-- >>> :{
-- haddockRender "Geometry/Algorithms/SimplexNoise/simplex_noise.svg" 500 500 $ \(Vec2 w h) -> do
-- let (simplexNoiseColor, simplexNoiseVisibility) = runST $ MWC.withRng [] $ \gen -> do
--         c <- simplex2 gen def
--             { _simplexFrequency = 5/(2*w)
--             }
--         v <- simplex2 gen def
--             { _simplexFrequency = 10/(2*w)
--             }
--         pure (c,v)
--     cellSize = 5
--     hexes = hexagonsInRange 30 hexZero
--     fitToViewport = transformBoundingBox (map (hexagonPoly cellSize) hexes) (shrinkBoundingBox 10 [zero, Vec2 w h]) def
-- for_ hexes $ \hex -> do
--     let polygon = hexagonPoly cellSize hex
--         vec = toVec2 cellSize hex
--         color = icefire (lerp (-1,1) (0,1) (simplexNoiseColor vec))
--     sketch (transform fitToViewport (shrinkPolygon 1 polygon))
--     setColor (color `withOpacity` (lerp (-1,1) (0,1) (simplexNoiseVisibility vec)))
--     C.fillPreserve
--     setColor (color `withOpacity` (lerp (-1,1) (1,0.2) (simplexNoiseVisibility vec)))
--     C.stroke
-- :}
-- Generated file: size 1MB, crc32: 0x1e0dba00
module Geometry.Algorithms.SimplexNoise (
      SimplexParameters(..)
    , simplex1
    , simplex2
    , simplex3
    , simplex4
) where



import           Control.Monad.Primitive
import           Control.Monad.ST
import           Data.Bits
import           Data.Default.Class
import           Data.List
import           Data.STRef
import           Data.Vector.Extended    (Vector, (!))
import qualified Data.Vector.Extended    as V
import qualified Data.Vector.Mutable     as VM
import qualified System.Random.MWC       as MWC

import Geometry.Core



-- $setup
-- >>> import           Draw
-- >>> import           Geometry.Coordinates.Hexagonal
-- >>> import qualified Graphics.Rendering.Cairo       as C
-- >>> import           Numerics.Interpolation
-- >>> import qualified System.Random.MWC.Extended     as MWC



sum' :: [Double] -> Double
sum' :: [Double] -> Double
sum' = (Double -> Double -> Double) -> Double -> [Double] -> Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0

data Grad3 = Grad3 !Double !Double !Double
    deriving (Grad3 -> Grad3 -> Bool
(Grad3 -> Grad3 -> Bool) -> (Grad3 -> Grad3 -> Bool) -> Eq Grad3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Grad3 -> Grad3 -> Bool
== :: Grad3 -> Grad3 -> Bool
$c/= :: Grad3 -> Grad3 -> Bool
/= :: Grad3 -> Grad3 -> Bool
Eq, Eq Grad3
Eq Grad3
-> (Grad3 -> Grad3 -> Ordering)
-> (Grad3 -> Grad3 -> Bool)
-> (Grad3 -> Grad3 -> Bool)
-> (Grad3 -> Grad3 -> Bool)
-> (Grad3 -> Grad3 -> Bool)
-> (Grad3 -> Grad3 -> Grad3)
-> (Grad3 -> Grad3 -> Grad3)
-> Ord Grad3
Grad3 -> Grad3 -> Bool
Grad3 -> Grad3 -> Ordering
Grad3 -> Grad3 -> Grad3
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Grad3 -> Grad3 -> Ordering
compare :: Grad3 -> Grad3 -> Ordering
$c< :: Grad3 -> Grad3 -> Bool
< :: Grad3 -> Grad3 -> Bool
$c<= :: Grad3 -> Grad3 -> Bool
<= :: Grad3 -> Grad3 -> Bool
$c> :: Grad3 -> Grad3 -> Bool
> :: Grad3 -> Grad3 -> Bool
$c>= :: Grad3 -> Grad3 -> Bool
>= :: Grad3 -> Grad3 -> Bool
$cmax :: Grad3 -> Grad3 -> Grad3
max :: Grad3 -> Grad3 -> Grad3
$cmin :: Grad3 -> Grad3 -> Grad3
min :: Grad3 -> Grad3 -> Grad3
Ord, Int -> Grad3 -> ShowS
[Grad3] -> ShowS
Grad3 -> String
(Int -> Grad3 -> ShowS)
-> (Grad3 -> String) -> ([Grad3] -> ShowS) -> Show Grad3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Grad3 -> ShowS
showsPrec :: Int -> Grad3 -> ShowS
$cshow :: Grad3 -> String
show :: Grad3 -> String
$cshowList :: [Grad3] -> ShowS
showList :: [Grad3] -> ShowS
Show)

data Grad4 = Grad4 !Double !Double !Double !Double
    deriving (Grad4 -> Grad4 -> Bool
(Grad4 -> Grad4 -> Bool) -> (Grad4 -> Grad4 -> Bool) -> Eq Grad4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Grad4 -> Grad4 -> Bool
== :: Grad4 -> Grad4 -> Bool
$c/= :: Grad4 -> Grad4 -> Bool
/= :: Grad4 -> Grad4 -> Bool
Eq, Eq Grad4
Eq Grad4
-> (Grad4 -> Grad4 -> Ordering)
-> (Grad4 -> Grad4 -> Bool)
-> (Grad4 -> Grad4 -> Bool)
-> (Grad4 -> Grad4 -> Bool)
-> (Grad4 -> Grad4 -> Bool)
-> (Grad4 -> Grad4 -> Grad4)
-> (Grad4 -> Grad4 -> Grad4)
-> Ord Grad4
Grad4 -> Grad4 -> Bool
Grad4 -> Grad4 -> Ordering
Grad4 -> Grad4 -> Grad4
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Grad4 -> Grad4 -> Ordering
compare :: Grad4 -> Grad4 -> Ordering
$c< :: Grad4 -> Grad4 -> Bool
< :: Grad4 -> Grad4 -> Bool
$c<= :: Grad4 -> Grad4 -> Bool
<= :: Grad4 -> Grad4 -> Bool
$c> :: Grad4 -> Grad4 -> Bool
> :: Grad4 -> Grad4 -> Bool
$c>= :: Grad4 -> Grad4 -> Bool
>= :: Grad4 -> Grad4 -> Bool
$cmax :: Grad4 -> Grad4 -> Grad4
max :: Grad4 -> Grad4 -> Grad4
$cmin :: Grad4 -> Grad4 -> Grad4
min :: Grad4 -> Grad4 -> Grad4
Ord, Int -> Grad4 -> ShowS
[Grad4] -> ShowS
Grad4 -> String
(Int -> Grad4 -> ShowS)
-> (Grad4 -> String) -> ([Grad4] -> ShowS) -> Show Grad4
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Grad4 -> ShowS
showsPrec :: Int -> Grad4 -> ShowS
$cshow :: Grad4 -> String
show :: Grad4 -> String
$cshowList :: [Grad4] -> ShowS
showList :: [Grad4] -> ShowS
Show)

-- | To speed up gradient calculations. This is also used for the 2D case (ignoring
-- the 3rd component).
grad3 :: Vector Grad3
grad3 :: Vector Grad3
grad3 = [Grad3] -> Vector Grad3
forall a. [a] -> Vector a
V.fromList
    [ Double -> Double -> Double -> Grad3
Grad3 Double
1    Double
1    Double
0
    , Double -> Double -> Double -> Grad3
Grad3 (-Double
1) Double
1    Double
0
    , Double -> Double -> Double -> Grad3
Grad3 Double
1    (-Double
1) Double
0
    , Double -> Double -> Double -> Grad3
Grad3 (-Double
1) (-Double
1) Double
0
    , Double -> Double -> Double -> Grad3
Grad3 Double
1    Double
0    Double
1
    , Double -> Double -> Double -> Grad3
Grad3 (-Double
1) Double
0    Double
1
    , Double -> Double -> Double -> Grad3
Grad3 Double
1    Double
0    (-Double
1)
    , Double -> Double -> Double -> Grad3
Grad3 (-Double
1) Double
0    (-Double
1)
    , Double -> Double -> Double -> Grad3
Grad3 Double
0    Double
1    Double
1
    , Double -> Double -> Double -> Grad3
Grad3 Double
0    (-Double
1) Double
1
    , Double -> Double -> Double -> Grad3
Grad3 Double
0    Double
1    (-Double
1)
    , Double -> Double -> Double -> Grad3
Grad3 Double
0    (-Double
1) (-Double
1)
    ]

-- | To speed up gradient calculations
grad4 :: Vector Grad4
grad4 :: Vector Grad4
grad4 = [Grad4] -> Vector Grad4
forall a. [a] -> Vector a
V.fromList
    [ Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    Double
1    Double
1    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    Double
1    Double
1    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    Double
1    (-Double
1) Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    Double
1    (-Double
1) (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    (-Double
1) Double
1    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    (-Double
1) Double
1    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    (-Double
1) (-Double
1) Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
0    (-Double
1) (-Double
1) (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
0    Double
1    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
0    Double
1    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
0    (-Double
1) Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
0    (-Double
1) (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
0    Double
1    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
0    Double
1    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
0    (-Double
1) Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
0    (-Double
1) (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
1    Double
0    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
1    Double
0    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    (-Double
1) Double
0    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    (-Double
1) Double
0    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
1    Double
0    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
1    Double
0    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) (-Double
1) Double
0    Double
1
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) (-Double
1) Double
0    (-Double
1)
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
1    Double
1    Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    Double
1    (-Double
1) Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    (-Double
1) Double
1    Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 Double
1    (-Double
1) (-Double
1) Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
1    Double
1    Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) Double
1    (-Double
1) Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) (-Double
1) Double
1    Double
0
    , Double -> Double -> Double -> Double -> Grad4
Grad4 (-Double
1) (-Double
1) (-Double
1) Double
0
    ]

dot2 :: Grad3 -> Double -> Double -> Double
dot2 :: Grad3 -> Double -> Double -> Double
dot2 (Grad3 Double
gx Double
gy Double
_) Double
x Double
y = Double
gxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gyDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y

dot3 :: Grad3 -> Double -> Double -> Double -> Double
dot3 :: Grad3 -> Double -> Double -> Double -> Double
dot3 (Grad3 Double
gx Double
gy Double
gz) Double
x Double
y Double
z = Double
gxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gyDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gzDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z

dot4 :: Grad4 -> Double -> Double -> Double -> Double -> Double
dot4 :: Grad4 -> Double -> Double -> Double -> Double -> Double
dot4 (Grad4 Double
gx Double
gy Double
gz Double
gw) Double
x Double
y Double
z Double
w = Double
gxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gyDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gzDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gwDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w

-- | Raw 1D simplex noise, with ampltude 1 and frequency 1/px.
rawSimplexNoise1
    :: Vector Int -- ^ Permutation of [0..255], concatenated with itself to save us a modulo calculation.
    -> Vector Int -- ^ Permutation table mod 12.
    -> Double     -- ^ x
    -> Double     -- ^ \(\in [-1,1]\)
rawSimplexNoise1 :: Vector Int -> Vector Int -> Double -> Double
rawSimplexNoise1 Vector Int
perm Vector Int
permModX Double
xin = Vector Int -> Vector Int -> Double -> Double -> Double
rawSimplexNoise2 Vector Int
perm Vector Int
permModX Double
xin Double
0

-- | Raw 2D simplex noise, with ampltude 1 and frequency 1/px.
rawSimplexNoise2
    :: Vector Int -- ^ Permutation of [0..255], concatenated with itself to save us a modulo calculation.
    -> Vector Int -- ^ Permutation table mod 12.
    -> Double     -- ^ x
    -> Double     -- ^ y
    -> Double     -- ^ \(\in [-1,1]\)
rawSimplexNoise2 :: Vector Int -> Vector Int -> Double -> Double -> Double
rawSimplexNoise2 Vector Int
perm Vector Int
permMod12 Double
xin Double
yin =
    let
        -- Skewing and unskewing factors for 2 dimensions
        f2, g2 :: Double
        f2 :: Double
f2 = Double
0.5Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double -> Double
forall a. Floating a => a -> a
sqrt Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)
        g2 :: Double
g2 = (Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double -> Double
forall a. Floating a => a -> a
sqrt Double
3)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6

        -- Skew the input space to determine which simplex cell we’re in
        i, j :: Int
        (Int
i,Int
j) = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
yinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s))
          where
            s :: Double
s = (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yin)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
f2  -- Hairy factor for 2D

        -- The x,y distances from the cell origin
        x0, y0 :: Double
        (Double
x0, Double
y0) = (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
xx0, Double
yinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
yy0)
          where
            t :: Double
t = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g2
            xx0 :: Double
xx0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t -- Unskew the cell origin back to (x,y) space
            yy0 :: Double
yy0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t

        -- For the 2D case, the simplex shape is an equilateral triangle.
        -- Determine which simplex we are in.
        i1, j1 :: Int -- Offsets for second (middle) corner of simplex in (i,j) coords
        (Int
i1, Int
j1)
            | Double
x0Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>Double
y0 = (Int
1,Int
0) -- lower triangle, XY order: (0,0)->(1,0)->(1,1)
            | Bool
otherwise = (Int
0,Int
1) -- upper triangle, YX order: (0,0)->(0,1)->(1,1)

        -- A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and
        -- a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), where c = (3-sqrt 3)/6

        -- Offsets for middle corner in (x,y) unskewed coords
        x1, y1 :: Double
        (Double
x1, Double
y1) =
            ( Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g2
            , Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g2
            )

        -- Offsets for last corner in (x,y) unskewed coords
        x2, y2 :: Double
        (Double
x2, Double
y2) =
            ( Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g2
            , Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g2
            )

        -- Work out the hashed gradient indices of the three simplex corners
        gi0, gi1, gi2 :: Int
        (Int
gi0, Int
gi1, Int
gi2) =
            ( Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+   (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
!  Int
jj    ))
            , Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j1)))
            , Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) )))
          where
            ii :: Int
ii = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            jj :: Int
jj = Int
j Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255

        cornerContribution :: Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Int
gi =
            let t1 :: Double
t1 = Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y;
                t2 :: Double
t2 = Double
t1Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
            in if Double
t1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
                then Double
0
                else Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Grad3 -> Double -> Double -> Double
dot2 (Vector Grad3
grad3Vector Grad3 -> Int -> Grad3
forall a. Vector a -> Int -> a
!Int
gi) Double
x Double
y

        -- Noise contributions from the three corners
        cornerContributions :: [Double]
        cornerContributions :: [Double]
cornerContributions@[Double
_, Double
_, Double
_] = [Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Int
gi | (Double
x,Double
y,Int
gi) <- [(Double
x0,Double
y0,Int
gi0), (Double
x1,Double
y1,Int
gi1), (Double
x2,Double
y2,Int
gi2)]]

    in
        -- Add contributions from each corner to get the final noise value.
        -- The result is scaled to return values in the interval [-1,1].
        Double
70 Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
sum' [Double]
cornerContributions

-- | Raw 3D simplex noise, with ampltude 1 and frequency 1/px.
rawSimplexNoise3
    :: Vector Int -- ^ Permutation of [0..255], concatenated with itself to save us a modulo calculation.
    -> Vector Int -- ^ Permutation table mod 12.
    -> Double     -- ^ x
    -> Double     -- ^ y
    -> Double     -- ^ z
    -> Double     -- ^ \(\in [-1,1]\)
rawSimplexNoise3 :: Vector Int -> Vector Int -> Double -> Double -> Double -> Double
rawSimplexNoise3 Vector Int
perm Vector Int
permMod12 Double
xin Double
yin Double
zin =
    let
        -- Skewing and unskewing factors for 2 dimensions
        f3, g3 :: Double
        f3 :: Double
f3 = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3 -- Very nice and simple skew factor for 3D
        g3 :: Double
g3 = Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6

        i, j, k :: Int
        (Int
i,Int
j,Int
k) = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
yinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
zinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
s))
          where
            s :: Double
s = (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yinDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
zin)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
f3 -- Factor for 3D skewing

        -- The x,y,z distances from the cell origin
        x0, y0, z0 :: Double
        (Double
x0, Double
y0, Double
z0) = (Double
xinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
xx0, Double
yinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
yy0, Double
zinDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
zz0)
          where
            t :: Double
t = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            xx0 :: Double
xx0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
iDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t -- Unskew the cell origin back to (x,y,z) space
            yy0 :: Double
yy0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
jDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t
            zz0 :: Double
zz0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
t


        -- For the 3D case, the simplex shape is a slightly irregular tetrahedron.
        -- Determine which simplex we are in.
        i1, j1, k1 :: Int -- Offsets for second corner of simplex in (i,j,k) coords
        i2, j2, k2 :: Int -- Offsets for third corner of simplex in (i,j,k) coords
        (Int
i1, Int
j1, Int
k1, Int
i2, Int
j2, Int
k2)
            | Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y0 = if
                | Double
y0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
z0  -> (Int
1, Int
0, Int
0, Int
1, Int
1, Int
0) -- X Y Z order
                | Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
z0  -> (Int
1, Int
0, Int
0, Int
1, Int
0, Int
1) -- X Z Y order
                | Bool
otherwise -> (Int
0, Int
0, Int
1, Int
1, Int
0, Int
1) -- Z X Y order
            | Bool
otherwise = if
                | Double
y0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
z0   -> (Int
0, Int
0, Int
1, Int
0, Int
1, Int
1) -- Z Y X order
                | Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
z0   -> (Int
0, Int
1, Int
0, Int
0, Int
1, Int
1) -- Y Z X order
                | Bool
otherwise -> (Int
0, Int
1, Int
0, Int
1, Int
1, Int
0) -- Y X Z order

        -- A step of (1,0,0) in (i,j,k) means a step of (1-c,-c,-c) in (x,y,z),
        -- a step of (0,1,0) in (i,j,k) means a step of (-c,1-c,-c) in (x,y,z), and
        -- a step of (0,0,1) in (i,j,k) means a step of (-c,-c,1-c) in (x,y,z), where
        -- c = 1/6.

        -- Offsets for second corner in (x,y,z) coords
        x1, y1, z1 :: Double
        (Double
x1, Double
y1, Double
z1) =
            ( Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g3
            , Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g3
            , Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g3
            )

        -- Offsets for third corner in (x,y,z) coords
        x2, y2, z2 :: Double
        (Double
x2, Double
y2, Double
z2) =
            ( Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            , Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            , Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            )

        -- Offsets for last corner in (x,y,z) coords
        x3, y3, z3 :: Double
        (Double
x3, Double
y3, Double
z3) =
            ( Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            , Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            , Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g3
            )

        -- Work out the hashed gradient indices of the four simplex corners
        gi0, gi1, gi2, gi3 :: Int
        (Int
gi0, Int
gi1, Int
gi2, Int
gi3) =
            ( Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+   (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+   (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
!  Int
kk    ))))
            , Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j1Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k1)))))
            , Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j2Int -> Int -> Int
forall a. Num a => a -> a -> a
+(Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k2)))))
            , Vector Int
permMod12 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 )))))
            )
          where
            ii :: Int
ii = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            jj :: Int
jj = Int
j Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            kk :: Int
kk = Int
k Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255

        cornerContribution :: Double -> Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Double
z Int
gi =
            let t1 :: Double
t1 = Double
0.6 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z
                t2 :: Double
t2 = Double
t1Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
            in if Double
t1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
                then Double
0
                else Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Grad3 -> Double -> Double -> Double -> Double
dot3 (Vector Grad3
grad3Vector Grad3 -> Int -> Grad3
forall a. Vector a -> Int -> a
!Int
gi) Double
x Double
y Double
z

        cornerContributions :: [Double]
        cornerContributions :: [Double]
cornerContributions@[Double
_, Double
_, Double
_, Double
_] = [Double -> Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Double
z Int
gi | (Double
x,Double
y,Double
z,Int
gi) <- [(Double
x0,Double
y0,Double
z0,Int
gi0), (Double
x1,Double
y1,Double
z1,Int
gi1), (Double
x2,Double
y2,Double
z2,Int
gi2), (Double
x3,Double
y3,Double
z3,Int
gi3)]]

    in
        -- Add contributions from each corner to get the final noise value.
        -- The result is scaled to stay just inside [-1,1]
        Double
32 Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
sum' [Double]
cornerContributions

-- | Raw 4D simplex noise, with ampltude 1 and frequency 1/px.
rawSimplexNoise4
    :: Vector Int -- ^ Permutation of [0..255], concatenated with itself to save us a modulo calculation.
    -> Vector Int -- ^ Permutation table mod 32.
    -> Double     -- ^ x
    -> Double     -- ^ y
    -> Double     -- ^ z
    -> Double     -- ^ w
    -> Double     -- ^ \(\in [-1,1]\)
rawSimplexNoise4 :: Vector Int
-> Vector Int -> Double -> Double -> Double -> Double -> Double
rawSimplexNoise4 Vector Int
perm Vector Int
permMod32 Double
xin Double
yin Double
zin Double
win =
    let
        -- Skewing and unskewing factors for 4 dimensions
        f4, g4 :: Double
        f4 :: Double
f4 = (Double -> Double
forall a. Floating a => a -> a
sqrt Double
5Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
4
        g4 :: Double
g4 = (Double
5Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double -> Double
forall a. Floating a => a -> a
sqrt Double
5)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
20

        -- Skew the (x,y,z,w) space to determine which cell of 24 simplices we’re in
        i, j, k, l :: Int
        (Int
i, Int
j, Int
k, Int
l) = (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
xin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
yin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
zin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
win Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s))
          where
            s :: Double
s = (Double
xin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
zin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
win) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
f4 -- Factor for 4D skewing

        -- The x,y,z,w distances from the cell origin
        x0, y0, z0, w0 :: Double
        (Double
x0, Double
y0, Double
z0, Double
w0) =
            ( Double
xin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xx0
            , Double
yin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yy0
            , Double
zin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zz0
            , Double
win Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ww0
            )
          where
            t :: Double
t = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
g4 -- Factor for 4D unskewing
            xx0 :: Double
xx0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t -- Unskew the cell origin back to (x,y,z,w) space
            yy0 :: Double
yy0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t
            zz0 :: Double
zz0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t
            ww0 :: Double
ww0 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t

        -- For the 4D case, the simplex is a 4D shape I won't even try to describe.
        -- To find out which of the 24 possible simplices we’re in, we need to
        -- determine the magnitude ordering of x0, y0, z0 and w0. Six pair-wise
        -- comparisons are performed between each possible pair of the four
        -- coordinates, and the results are used to rank the numbers.

        -- (rankX, rankY, rankZ, rankW) is a 4-vector with the numbers 0, 1, 2 and 3
        -- in some order. We use a thresholding to set the coordinates in turn.
        (Integer
rankX, Integer
rankY, Integer
rankZ, Integer
rankW) = (forall s. ST s (Integer, Integer, Integer, Integer))
-> (Integer, Integer, Integer, Integer)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Integer, Integer, Integer, Integer))
 -> (Integer, Integer, Integer, Integer))
-> (forall s. ST s (Integer, Integer, Integer, Integer))
-> (Integer, Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ do
            let increment :: STRef s a -> ST s ()
increment STRef s a
ref = STRef s a -> (a -> a) -> ST s ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s a
ref (a -> a -> a
forall a. Num a => a -> a -> a
+a
1)
            STRef s Integer
rankXRef <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
            STRef s Integer
rankYRef <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
            STRef s Integer
rankZRef <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
            STRef s Integer
rankWRef <- Integer -> ST s (STRef s Integer)
forall a s. a -> ST s (STRef s a)
newSTRef Integer
0
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
y0 then STRef s Integer
rankXRef else STRef s Integer
rankYRef)
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
z0 then STRef s Integer
rankXRef else STRef s Integer
rankZRef)
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
x0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
w0 then STRef s Integer
rankXRef else STRef s Integer
rankWRef)
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
y0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
z0 then STRef s Integer
rankYRef else STRef s Integer
rankZRef)
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
y0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
w0 then STRef s Integer
rankYRef else STRef s Integer
rankWRef)
            STRef s Integer -> ST s ()
forall {a} {s}. Num a => STRef s a -> ST s ()
increment (if Double
z0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
w0 then STRef s Integer
rankZRef else STRef s Integer
rankWRef)
            (,,,)
                (Integer
 -> Integer
 -> Integer
 -> Integer
 -> (Integer, Integer, Integer, Integer))
-> ST s Integer
-> ST
     s
     (Integer
      -> Integer -> Integer -> (Integer, Integer, Integer, Integer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
rankXRef
                ST
  s
  (Integer
   -> Integer -> Integer -> (Integer, Integer, Integer, Integer))
-> ST s Integer
-> ST
     s (Integer -> Integer -> (Integer, Integer, Integer, Integer))
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
rankYRef
                ST s (Integer -> Integer -> (Integer, Integer, Integer, Integer))
-> ST s Integer
-> ST s (Integer -> (Integer, Integer, Integer, Integer))
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
rankZRef
                ST s (Integer -> (Integer, Integer, Integer, Integer))
-> ST s Integer -> ST s (Integer, Integer, Integer, Integer)
forall a b. ST s (a -> b) -> ST s a -> ST s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STRef s Integer -> ST s Integer
forall s a. STRef s a -> ST s a
readSTRef STRef s Integer
rankWRef

        if01 :: Bool -> a
if01 Bool
p = if Bool
p then a
1 else a
0


        i1, j1, k1, l1 :: Int -- The integer offsets for the second simplex corner
        -- Rank 3 denotes the largest coordinate.
        i1 :: Int
i1 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankX Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
3)
        j1 :: Int
j1 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankY Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
3)
        k1 :: Int
k1 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankZ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
3)
        l1 :: Int
l1 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankW Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
3)

        i2, j2, k2, l2 :: Int -- The integer offsets for the third simplex corner
        -- Rank 2 denotes the second largest coordinate.
        i2 :: Int
i2 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankX Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2)
        j2 :: Int
j2 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankY Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2)
        k2 :: Int
k2 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankZ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2)
        l2 :: Int
l2 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankW Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
2)

        -- Rank 1 denotes the second smallest coordinate.
        i3, j3, k3, l3 :: Int -- The integer offsets for the fourth simplex corner
        i3 :: Int
i3 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankX Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1)
        j3 :: Int
j3 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankY Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1)
        k3 :: Int
k3 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankZ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1)
        l3 :: Int
l3 = Bool -> Int
forall {a}. Num a => Bool -> a
if01 (Integer
rankW Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
1)

        -- The fifth corner has all coordinate offsets = 1, so no need to compute that.

        -- Offsets for second corner in (x,y,z,w) coords
        x1, y1, z1, w1 :: Double
        x1 :: Double
x1 = Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g4;
        y1 :: Double
y1 = Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g4;
        z1 :: Double
z1 = Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g4;
        w1 :: Double
w1 = Double
w0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
g4;

        -- Offsets for third corner in (x,y,z,w) coords
        x2, y2, z2, w2 :: Double
        x2 :: Double
x2 = Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        y2 :: Double
y2 = Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        z2 :: Double
z2 = Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        w2 :: Double
w2 = Double
w0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;

        -- Offsets for fourth corner in (x,y,z,w) coords
        x3, y3, z3, w3 :: Double
        x3 :: Double
x3 = Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        y3 :: Double
y3 = Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        z3 :: Double
z3 = Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        w3 :: Double
w3 = Double
w0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l3 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
3Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;

        -- Offsets for last corner in (x,y,z,w) coords
        x4, y4, z4, w4 :: Double
        x4 :: Double
x4 = Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        y4 :: Double
y4 = Double
y0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        z4 :: Double
z4 = Double
z0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;
        w4 :: Double
w4 = Double
w0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
g4;

        -- Work out the hashed gradient indices of the five simplex corners
        gi0, gi1, gi2, gi3, gi4 :: Int
        (Int
gi0, Int
gi1, Int
gi2, Int
gi3, Int
gi4) =
            ( Vector Int
permMod32 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+   Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+   Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+   Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
!  Int
ll    )))
            , Vector Int
permMod32 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
llInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l1))))
            , Vector Int
permMod32 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
llInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l2))))
            , Vector Int
permMod32 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
i3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
k3Int -> Int -> Int
forall a. Num a => a -> a -> a
+Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
llInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l3))))
            , Vector Int
permMod32 Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
iiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
jjInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
kkInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int
perm Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
! (Int
llInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 ))))
            )
          where
            ii :: Int
ii = Int
i Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            jj :: Int
jj = Int
j Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            kk :: Int
kk = Int
k Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255
            ll :: Int
ll = Int
l Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
255

        cornerContribution :: Double -> Double -> Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Double
z Double
w Int
gi =
            let t1 :: Double
t1 = Double
0.6 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
w
                t2 :: Double
t2 = Double
t1Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
            in if Double
t1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
                then Double
0
                else Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Grad4 -> Double -> Double -> Double -> Double -> Double
dot4 (Vector Grad4
grad4Vector Grad4 -> Int -> Grad4
forall a. Vector a -> Int -> a
!Int
gi) Double
x Double
y Double
z Double
w

        cornerContributions :: [Double]
        cornerContributions :: [Double]
cornerContributions@[Double
_, Double
_, Double
_, Double
_, Double
_] = [Double -> Double -> Double -> Double -> Int -> Double
cornerContribution Double
x Double
y Double
z Double
w Int
gi | (Double
x,Double
y,Double
z,Double
w,Int
gi) <- [(Double
x0,Double
y0,Double
z0,Double
w0,Int
gi0), (Double
x1,Double
y1,Double
z1,Double
w1,Int
gi1), (Double
x2,Double
y2,Double
z2,Double
w2,Int
gi2), (Double
x3,Double
y3,Double
z3,Double
w3,Int
gi3), (Double
x4,Double
y4,Double
z4,Double
w4,Int
gi4)]]

    in Double
27 Double -> Double -> Double
forall a. Num a => a -> a -> a
* [Double] -> Double
sum' [Double]
cornerContributions

-- | Named arguments for 'simplex1', 'simplex2', 'simplex3', 'simplex4'.
data SimplexParameters = SimplexParameters
    { SimplexParameters -> Double
_simplexFrequency :: Double
        -- ^ Frequency of the first octave, e.g. \(\frac1{2\text{width}}\) to span the whole width of the picture.
        --   'def'ault: 1.

    , SimplexParameters -> Double
_simplexLacunarity :: Double
        -- ^ Frequency multiplier between octaves.
        --   'def'ault: 2.

    , SimplexParameters -> Int
_simplexOctaves :: Int
        -- ^ Number of octaves to generate.
        --   'def'ault: 6.

    , SimplexParameters -> Double
_simplexPersistence :: Double
        -- ^ Amplitude multiplier between octaves.
        --   'def'ault: 0.5.
    } deriving (SimplexParameters -> SimplexParameters -> Bool
(SimplexParameters -> SimplexParameters -> Bool)
-> (SimplexParameters -> SimplexParameters -> Bool)
-> Eq SimplexParameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimplexParameters -> SimplexParameters -> Bool
== :: SimplexParameters -> SimplexParameters -> Bool
$c/= :: SimplexParameters -> SimplexParameters -> Bool
/= :: SimplexParameters -> SimplexParameters -> Bool
Eq, Eq SimplexParameters
Eq SimplexParameters
-> (SimplexParameters -> SimplexParameters -> Ordering)
-> (SimplexParameters -> SimplexParameters -> Bool)
-> (SimplexParameters -> SimplexParameters -> Bool)
-> (SimplexParameters -> SimplexParameters -> Bool)
-> (SimplexParameters -> SimplexParameters -> Bool)
-> (SimplexParameters -> SimplexParameters -> SimplexParameters)
-> (SimplexParameters -> SimplexParameters -> SimplexParameters)
-> Ord SimplexParameters
SimplexParameters -> SimplexParameters -> Bool
SimplexParameters -> SimplexParameters -> Ordering
SimplexParameters -> SimplexParameters -> SimplexParameters
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SimplexParameters -> SimplexParameters -> Ordering
compare :: SimplexParameters -> SimplexParameters -> Ordering
$c< :: SimplexParameters -> SimplexParameters -> Bool
< :: SimplexParameters -> SimplexParameters -> Bool
$c<= :: SimplexParameters -> SimplexParameters -> Bool
<= :: SimplexParameters -> SimplexParameters -> Bool
$c> :: SimplexParameters -> SimplexParameters -> Bool
> :: SimplexParameters -> SimplexParameters -> Bool
$c>= :: SimplexParameters -> SimplexParameters -> Bool
>= :: SimplexParameters -> SimplexParameters -> Bool
$cmax :: SimplexParameters -> SimplexParameters -> SimplexParameters
max :: SimplexParameters -> SimplexParameters -> SimplexParameters
$cmin :: SimplexParameters -> SimplexParameters -> SimplexParameters
min :: SimplexParameters -> SimplexParameters -> SimplexParameters
Ord, Int -> SimplexParameters -> ShowS
[SimplexParameters] -> ShowS
SimplexParameters -> String
(Int -> SimplexParameters -> ShowS)
-> (SimplexParameters -> String)
-> ([SimplexParameters] -> ShowS)
-> Show SimplexParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimplexParameters -> ShowS
showsPrec :: Int -> SimplexParameters -> ShowS
$cshow :: SimplexParameters -> String
show :: SimplexParameters -> String
$cshowList :: [SimplexParameters] -> ShowS
showList :: [SimplexParameters] -> ShowS
Show)

instance Default SimplexParameters where
    def :: SimplexParameters
def = SimplexParameters
        { _simplexFrequency :: Double
_simplexFrequency   = Double
1
        , _simplexLacunarity :: Double
_simplexLacunarity  = Double
2
        , _simplexOctaves :: Int
_simplexOctaves     = Int
6
        , _simplexPersistence :: Double
_simplexPersistence = Double
0.5
        }

createPermutationTable :: PrimMonad st => MWC.Gen (PrimState st) -> st (Vector Int)
createPermutationTable :: forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> st (Vector Int)
createPermutationTable Gen (PrimState st)
gen = do
    MVector (PrimState st) Int
vecMut <- Int -> (Int -> Int) -> st (MVector (PrimState st) Int)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> (Int -> a) -> m (MVector (PrimState m) a)
VM.generate Int
256 Int -> Int
forall a. a -> a
id
    Gen (PrimState st) -> MVector (PrimState st) Int -> st ()
forall (f :: * -> *) a.
PrimMonad f =>
Gen (PrimState f) -> MVector (PrimState f) a -> f ()
V.fisherYatesShuffle Gen (PrimState st)
gen MVector (PrimState st) Int
vecMut
    Vector Int
vec <- MVector (PrimState st) Int -> st (Vector Int)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze MVector (PrimState st) Int
vecMut
    Vector Int -> st (Vector Int)
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Int
vec Vector Int -> Vector Int -> Vector Int
forall a. Semigroup a => a -> a -> a
<> Vector Int
vec) -- To remove the need for index wrapping, double the permutation table length

-- | One-dimensional simplex noise. See 'simplex2' for a code example.
simplex1
    :: PrimMonad st
    => MWC.Gen (PrimState st) -- ^ To initialize the permutation table
    -> SimplexParameters
    -> st (Double -> Double)
simplex1 :: forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> SimplexParameters -> st (Double -> Double)
simplex1 Gen (PrimState st)
gen SimplexParameters{Double
Int
_simplexFrequency :: SimplexParameters -> Double
_simplexLacunarity :: SimplexParameters -> Double
_simplexOctaves :: SimplexParameters -> Int
_simplexPersistence :: SimplexParameters -> Double
_simplexFrequency :: Double
_simplexLacunarity :: Double
_simplexOctaves :: Int
_simplexPersistence :: Double
..} = do
    let frequencies :: [Double]
frequencies = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexLacunarity) Double
_simplexFrequency
        amplitudes :: [Double]
amplitudes = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexPersistence) Double
1
    Vector Int
perm <- Gen (PrimState st) -> st (Vector Int)
forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> st (Vector Int)
createPermutationTable Gen (PrimState st)
gen
    (Double -> Double) -> st (Double -> Double)
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> Double) -> st (Double -> Double))
-> (Double -> Double) -> st (Double -> Double)
forall a b. (a -> b) -> a -> b
$ \Double
x ->
        [Double] -> Double
sum' (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
_simplexOctaves
                   ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
freq Double
amp ->
                                Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Double
amp
                                    (Vector Int -> Vector Int -> Double -> Double
rawSimplexNoise1 Vector Int
perm
                                                      ((Int -> Int) -> Vector Int -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) Vector Int
perm)
                                                      (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)))
                            [Double]
frequencies
                            [Double]
amplitudes))

-- | Two-dimensional simplex noise.
--
-- @
-- noiseFunction = 'runST' $ do
--     gen <- 'MWC.create'
--     'simplex2' gen 'def'
-- 'for_' [1..10] $ \x ->
--     'for_' [1..10] $ \y ->
--         'print' ('noiseFunction' (Vec2 x y))
-- @
simplex2
    :: PrimMonad st
    => MWC.Gen (PrimState st) -- ^ To initialize the permutation table
    -> SimplexParameters
    -> st (Vec2 -> Double)
simplex2 :: forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> SimplexParameters -> st (Vec2 -> Double)
simplex2 Gen (PrimState st)
gen SimplexParameters{Double
Int
_simplexFrequency :: SimplexParameters -> Double
_simplexLacunarity :: SimplexParameters -> Double
_simplexOctaves :: SimplexParameters -> Int
_simplexPersistence :: SimplexParameters -> Double
_simplexFrequency :: Double
_simplexLacunarity :: Double
_simplexOctaves :: Int
_simplexPersistence :: Double
..} = do
    let frequencies :: [Double]
frequencies = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexLacunarity) Double
_simplexFrequency
        amplitudes :: [Double]
amplitudes = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexPersistence) Double
1
    Vector Int
perm <- Gen (PrimState st) -> st (Vector Int)
forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> st (Vector Int)
createPermutationTable Gen (PrimState st)
gen
    (Vec2 -> Double) -> st (Vec2 -> Double)
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Vec2 -> Double) -> st (Vec2 -> Double))
-> (Vec2 -> Double) -> st (Vec2 -> Double)
forall a b. (a -> b) -> a -> b
$ \(Vec2 Double
x Double
y) ->
        [Double] -> Double
sum' (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
_simplexOctaves
                   ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
freq Double
amp ->
                                Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Double
amp
                                    (Vector Int -> Vector Int -> Double -> Double -> Double
rawSimplexNoise2 Vector Int
perm
                                                      ((Int -> Int) -> Vector Int -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) Vector Int
perm)
                                                      (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)
                                                      (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)))
                            [Double]
frequencies
                            [Double]
amplitudes))

-- | Three-dimensional simplex noise. See 'simplex2' for a code example.
simplex3
    :: PrimMonad st
    => MWC.Gen (PrimState st) -- ^ To initialize the permutation table
    -> SimplexParameters
    -> st (Double -> Double -> Double -> Double) -- ^ \(\text{noise}(x,y,z)\)
simplex3 :: forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st)
-> SimplexParameters -> st (Double -> Double -> Double -> Double)
simplex3 Gen (PrimState st)
gen SimplexParameters{Double
Int
_simplexFrequency :: SimplexParameters -> Double
_simplexLacunarity :: SimplexParameters -> Double
_simplexOctaves :: SimplexParameters -> Int
_simplexPersistence :: SimplexParameters -> Double
_simplexFrequency :: Double
_simplexLacunarity :: Double
_simplexOctaves :: Int
_simplexPersistence :: Double
..} = do
    let frequencies :: [Double]
frequencies = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexLacunarity) Double
_simplexFrequency
        amplitudes :: [Double]
amplitudes = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexPersistence) Double
1
    Vector Int
perm <- Gen (PrimState st) -> st (Vector Int)
forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> st (Vector Int)
createPermutationTable Gen (PrimState st)
gen
    (Double -> Double -> Double -> Double)
-> st (Double -> Double -> Double -> Double)
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> Double -> Double -> Double)
 -> st (Double -> Double -> Double -> Double))
-> (Double -> Double -> Double -> Double)
-> st (Double -> Double -> Double -> Double)
forall a b. (a -> b) -> a -> b
$ \Double
x Double
y Double
z ->
        [Double] -> Double
sum' (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
_simplexOctaves
                   ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
freq Double
amp ->
                                Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Double
amp
                                    (Vector Int -> Vector Int -> Double -> Double -> Double -> Double
rawSimplexNoise3 Vector Int
perm
                                                      ((Int -> Int) -> Vector Int -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
12) Vector Int
perm)
                                                      (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)
                                                      (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq) (Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)))
                            [Double]
frequencies
                            [Double]
amplitudes))

-- | Four-dimensional simplex noise. See 'simplex2' for a code example.
simplex4
    :: PrimMonad st
    => MWC.Gen (PrimState st) -- ^ To initialize the permutation table
    -> SimplexParameters
    -> st (Double -> Double -> Double -> Double -> Double) -- ^ \(\text{noise}(x,y,z,w)\)
simplex4 :: forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st)
-> SimplexParameters
-> st (Double -> Double -> Double -> Double -> Double)
simplex4 Gen (PrimState st)
gen SimplexParameters{Double
Int
_simplexFrequency :: SimplexParameters -> Double
_simplexLacunarity :: SimplexParameters -> Double
_simplexOctaves :: SimplexParameters -> Int
_simplexPersistence :: SimplexParameters -> Double
_simplexFrequency :: Double
_simplexLacunarity :: Double
_simplexOctaves :: Int
_simplexPersistence :: Double
..} = do
    let frequencies :: [Double]
frequencies = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexLacunarity) Double
_simplexFrequency
        amplitudes :: [Double]
amplitudes = (Double -> Double) -> Double -> [Double]
forall a. (a -> a) -> a -> [a]
iterate (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
_simplexPersistence) Double
1
    Vector Int
perm <- Gen (PrimState st) -> st (Vector Int)
forall (st :: * -> *).
PrimMonad st =>
Gen (PrimState st) -> st (Vector Int)
createPermutationTable Gen (PrimState st)
gen
    (Double -> Double -> Double -> Double -> Double)
-> st (Double -> Double -> Double -> Double -> Double)
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> Double -> Double -> Double -> Double)
 -> st (Double -> Double -> Double -> Double -> Double))
-> (Double -> Double -> Double -> Double -> Double)
-> st (Double -> Double -> Double -> Double -> Double)
forall a b. (a -> b) -> a -> b
$ \Double
x Double
y Double
z Double
w ->
        [Double] -> Double
sum' (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
_simplexOctaves
                   ((Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
freq Double
amp ->
                                Double -> Double -> Double
forall a. Num a => a -> a -> a
(*) Double
amp
                                    (Vector Int
-> Vector Int -> Double -> Double -> Double -> Double -> Double
rawSimplexNoise4 Vector Int
perm
                                                      ((Int -> Int) -> Vector Int -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32) Vector Int
perm)
                                                      (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)
                                                      (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq) (Double
zDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq) (Double
wDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
freq)))
                            [Double]
frequencies
                            [Double]
amplitudes))