{-# LANGUAGE Strict #-}
module Numeric.Noise.Value (
noise2,
noise2Base,
noise3,
noise3Base,
)
where
import Numeric.Noise.Internal
import Numeric.Noise.Internal.Math
noise2 :: (RealFrac a) => Noise2 a
noise2 :: forall a. RealFrac a => Noise2 a
noise2 = (Seed -> a -> a -> a) -> Noise2 a
forall a. (Seed -> a -> a -> a) -> Noise2 a
Noise2 Seed -> a -> a -> a
forall a. RealFrac a => Seed -> a -> a -> a
noise2Base
{-# INLINE noise2 #-}
noise2Base :: (RealFrac a) => Seed -> a -> a -> a
noise2Base :: forall a. RealFrac a => Seed -> a -> a -> a
noise2Base Seed
seed a
x a
y =
let x0 :: Hash
x0 = a -> Hash
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x
y0 :: Hash
y0 = a -> Hash
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
y
xs :: a
xs = a -> a
forall a. Num a => a -> a
hermiteInterp (a
x a -> a -> a
forall a. Num a => a -> a -> a
- Hash -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
x0)
ys :: a
ys = a -> a
forall a. Num a => a -> a
hermiteInterp (a
y a -> a -> a
forall a. Num a => a -> a -> a
- Hash -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
y0)
x0p :: Hash
x0p = Hash
x0 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
* Hash
primeX
y0p :: Hash
y0p = Hash
y0 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
* Hash
primeY
x1 :: Hash
x1 = Hash
x0p Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Hash
primeX
y1 :: Hash
y1 = Hash
y0p Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Hash
primeY
in a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> a
valCoord2 Seed
seed Hash
x0p Hash
y0p)
(Seed -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> a
valCoord2 Seed
seed Hash
x1 Hash
y0p)
a
xs
)
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> a
valCoord2 Seed
seed Hash
x0p Hash
y1)
(Seed -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> a
valCoord2 Seed
seed Hash
x1 Hash
y1)
a
xs
)
a
ys
{-# INLINE noise2Base #-}
noise3 :: (RealFrac a) => Noise3 a
noise3 :: forall a. RealFrac a => Noise3 a
noise3 = (Seed -> a -> a -> a -> a) -> Noise3 a
forall a. (Seed -> a -> a -> a -> a) -> Noise3 a
Noise3 Seed -> a -> a -> a -> a
forall a. RealFrac a => Seed -> a -> a -> a -> a
noise3Base
{-# INLINE noise3 #-}
noise3Base :: (RealFrac a) => Seed -> a -> a -> a -> a
noise3Base :: forall a. RealFrac a => Seed -> a -> a -> a -> a
noise3Base Seed
seed a
x a
y a
z =
let x0 :: Hash
x0 = a -> Hash
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x
y0 :: Hash
y0 = a -> Hash
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
y
z0 :: Hash
z0 = a -> Hash
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
z
xs :: a
xs = a -> a
forall a. Num a => a -> a
hermiteInterp (a
x a -> a -> a
forall a. Num a => a -> a -> a
- Hash -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
x0)
ys :: a
ys = a -> a
forall a. Num a => a -> a
hermiteInterp (a
y a -> a -> a
forall a. Num a => a -> a -> a
- Hash -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
y0)
zs :: a
zs = a -> a
forall a. Num a => a -> a
hermiteInterp (a
z a -> a -> a
forall a. Num a => a -> a -> a
- Hash -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hash
z0)
x0p :: Hash
x0p = Hash
x0 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
* Hash
primeX
y0p :: Hash
y0p = Hash
y0 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
* Hash
primeY
z0p :: Hash
z0p = Hash
z0 Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
* Hash
primeZ
x1 :: Hash
x1 = Hash
x0p Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Hash
primeX
y1 :: Hash
y1 = Hash
y0p Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Hash
primeY
z1 :: Hash
z1 = Hash
z0p Hash -> Hash -> Hash
forall a. Num a => a -> a -> a
+ Hash
primeZ
in a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x0p Hash
y0p Hash
z0p)
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x1 Hash
y0p Hash
z0p)
a
xs
)
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x0p Hash
y1 Hash
z0p)
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x1 Hash
y1 Hash
z0p)
a
xs
)
a
ys
)
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x0p Hash
y0p Hash
z1)
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x1 Hash
y0p Hash
z1)
a
xs
)
( a -> a -> a -> a
forall a. Num a => a -> a -> a -> a
lerp
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x0p Hash
y1 Hash
z1)
(Seed -> Hash -> Hash -> Hash -> a
forall a. RealFrac a => Seed -> Hash -> Hash -> Hash -> a
valCoord3 Seed
seed Hash
x1 Hash
y1 Hash
z1)
a
xs
)
a
ys
)
a
zs
{-# INLINE noise3Base #-}