{-# LANGUAGE Strict #-}

-- |
-- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>
-- Stability: experimental
--
-- This module implements a variation of value noise derived from FastNoiseLite.
module Numeric.Noise.Value (
  -- * 2D Noise
  noise2,
  noise2Base,

  -- * 3D Noise
  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 #-}