pure-noise-0.2.0.0: src/Numeric/Noise/Internal/Math.hs

{-# LANGUAGE OverloadedLists #-}

-- |
-- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>
-- License: BSD-3-Clause
-- Stability : experimental
module Numeric.Noise.Internal.Math (
  Seed,
  Hash,
  lerp,
  cubicInterp,
  hermiteInterp,
  quinticInterp,
  clamp,
  primeX,
  primeY,
  primeZ,
  hash2,
  hash3,
  infinity,
  g2,
  sqrt3,
  valCoord2,
  valCoord3,
  gradCoord2,
  gradCoord3,
  maxHash,
) where

import Data.Bits
import Data.Int
import Data.Primitive.PrimArray
import Data.Word

-- | Seed value for deterministic noise generation.
--
-- Using the same 'Seed' value will produce the same noise pattern,
-- allowing for reproducible results. Different seed values produce
-- different, independent noise patterns.
type Seed = Word64

-- | Internal hash value type used in noise calculations.
type Hash = Int32

-- | Linear interpolation between two values.
--
-- Monotonic lerp
lerp
  :: (Num a)
  => a
  -- ^ start
  -> a
  -- ^ end
  -> a
  -- ^ parameter in range [0, 1]
  -> a
lerp v0 v1 t = v0 + t * (v1 - v0)
{-# INLINE lerp #-}

-- | cubic interpolation
cubicInterp :: (Num a) => a -> a -> a -> a -> a -> a
cubicInterp a b c d t =
  let !p = (d - c) - (a - b)
   in t * t * t * p + t * t * ((a - b) - p) + t * (c - a) + b
{-# INLINE cubicInterp #-}

-- | hermite interpolation
hermiteInterp :: (Num a) => a -> a
hermiteInterp t = t * t * (3 - 2 * t)
{-# INLINE hermiteInterp #-}

-- | quintic interpolation
quinticInterp :: (Num a) => a -> a
quinticInterp t = t * t * t * (t * (t * 6 - 15) + 10)
{-# INLINE quinticInterp #-}

-- | Clamp a value to a specified range.
--
-- Returns the value if it's within bounds, otherwise returns
-- the nearest boundary.
clamp
  :: (Ord a)
  => a
  -- ^ lower bound
  -> a
  -- ^ upper bound
  -> a
  -- ^ value
  -> a
clamp l u v
  | v < l = l
  | v > u = u
  | otherwise = v
{-# INLINE clamp #-}

primeX, primeY, primeZ :: Hash
primeX = 501125321
{-# INLINE primeX #-}
primeY = 1136930381
{-# INLINE primeY #-}
primeZ = 1720413743
{-# INLINE primeZ #-}

hash2 :: Seed -> Hash -> Hash -> Hash
hash2 seed xPrimed yPrimed =
  (fromIntegral seed `xor` xPrimed `xor` yPrimed)
    * 0x27d4eb2d
{-# INLINE hash2 #-}

hash3 :: Seed -> Hash -> Hash -> Hash -> Hash
hash3 seed xPrimed yPrimed zPrimed =
  (fromIntegral seed `xor` xPrimed `xor` yPrimed `xor` zPrimed)
    * 0x27d4eb2d
{-# INLINE hash3 #-}

infinity :: (Fractional a) => a
infinity = 1 / 0
{-# INLINE infinity #-}

g2 :: (Fractional a) => a
g2 = (3 - sqrt3) / 6
{-# INLINE g2 #-}

sqrt3 :: (Fractional a) => a
sqrt3 = 1.7320508075688772935274463415059
{-# INLINE sqrt3 #-}

valCoord2 :: (RealFrac a) => Word64 -> Hash -> Hash -> a
valCoord2 seed xPrimed yPrimed =
  let !hash = hash2 seed xPrimed yPrimed
      !val = (hash * hash) `xor` (hash `shiftL` 19)
   in fromIntegral val / maxHash
{-# INLINE valCoord2 #-}

valCoord3 :: (RealFrac a) => Word64 -> Hash -> Hash -> Hash -> a
valCoord3 seed xPrimed yPrimed zPrimed =
  let !hash = hash3 seed xPrimed yPrimed zPrimed
      !val = (hash * hash) `xor` (hash `shiftL` 19)
   in fromIntegral val / maxHash
{-# INLINE valCoord3 #-}

gradCoord2 :: (RealFrac a) => Seed -> Hash -> Hash -> a -> a -> a
gradCoord2 seed xPrimed yPrimed xd yd =
  let !hash = hash2 seed xPrimed yPrimed
      !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFE
      !xg = grad2d `indexPrimArray` fromIntegral ix
      !yg = grad2d `indexPrimArray` fromIntegral (ix .|. 1)
   in xd * realToFrac xg + yd * realToFrac yg
{-# INLINE gradCoord2 #-}

gradCoord3 :: (RealFrac a) => Seed -> Hash -> Hash -> Hash -> a -> a -> a -> a
gradCoord3 seed xPrimed yPrimed zPrimed xd yd zd =
  let !hash = hash3 seed xPrimed yPrimed zPrimed
      !ix = (hash `xor` (hash `shiftR` 15)) .&. 0xFC
      !xg = grad3d `indexPrimArray` fromIntegral ix
      !yg = grad3d `indexPrimArray` fromIntegral (ix .|. 1)
      !zg = grad3d `indexPrimArray` fromIntegral (ix .|. 2)
   in xd * fromIntegral xg + yd * fromIntegral yg + zd * fromIntegral zg
{-# INLINE gradCoord3 #-}

maxHash :: (RealFrac a) => a
maxHash = realToFrac (maxBound @Hash)
{-# INLINE maxHash #-}

{- ORMOLU_DISABLE -}
-- >>> sizeofPrimArray grad2d == 256
-- True
grad2d :: PrimArray Float
grad2d =
  [ 0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,
    0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,
    0.793353340291235, -0.60876142900872 ,  0.608761429008721, -0.793353340291235,  0.38268343236509 , -0.923879532511287,  0.130526192220052, -0.99144486137381,
   -0.130526192220052, -0.99144486137381 , -0.38268343236509 , -0.923879532511287, -0.608761429008721, -0.793353340291235, -0.793353340291235, -0.608761429008721,
   -0.923879532511287, -0.38268343236509 , -0.99144486137381 , -0.130526192220052, -0.99144486137381 ,  0.130526192220051, -0.923879532511287,  0.38268343236509,
   -0.793353340291235,  0.608761429008721, -0.608761429008721,  0.793353340291235, -0.38268343236509 ,  0.923879532511287, -0.130526192220052,  0.99144486137381,
    0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,
    0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,
    0.793353340291235, -0.60876142900872 ,  0.608761429008721, -0.793353340291235,  0.38268343236509 , -0.923879532511287,  0.130526192220052, -0.99144486137381,
   -0.130526192220052, -0.99144486137381 , -0.38268343236509 , -0.923879532511287, -0.608761429008721, -0.793353340291235, -0.793353340291235, -0.608761429008721,
   -0.923879532511287, -0.38268343236509 , -0.99144486137381 , -0.130526192220052, -0.99144486137381 ,  0.130526192220051, -0.923879532511287,  0.38268343236509,
   -0.793353340291235,  0.608761429008721, -0.608761429008721,  0.793353340291235, -0.38268343236509 ,  0.923879532511287, -0.130526192220052,  0.99144486137381,
    0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,
    0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,
    0.793353340291235, -0.60876142900872 ,  0.608761429008721, -0.793353340291235,  0.38268343236509 , -0.923879532511287,  0.130526192220052, -0.99144486137381,
   -0.130526192220052, -0.99144486137381 , -0.38268343236509 , -0.923879532511287, -0.608761429008721, -0.793353340291235, -0.793353340291235, -0.608761429008721,
   -0.923879532511287, -0.38268343236509 , -0.99144486137381 , -0.130526192220052, -0.99144486137381 ,  0.130526192220051, -0.923879532511287,  0.38268343236509,
   -0.793353340291235,  0.608761429008721, -0.608761429008721,  0.793353340291235, -0.38268343236509 ,  0.923879532511287, -0.130526192220052,  0.99144486137381,
    0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,
    0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,
    0.793353340291235, -0.60876142900872 ,  0.608761429008721, -0.793353340291235,  0.38268343236509 , -0.923879532511287,  0.130526192220052, -0.99144486137381,
   -0.130526192220052, -0.99144486137381 , -0.38268343236509 , -0.923879532511287, -0.608761429008721, -0.793353340291235, -0.793353340291235, -0.608761429008721,
   -0.923879532511287, -0.38268343236509 , -0.99144486137381 , -0.130526192220052, -0.99144486137381 ,  0.130526192220051, -0.923879532511287,  0.38268343236509,
   -0.793353340291235,  0.608761429008721, -0.608761429008721,  0.793353340291235, -0.38268343236509 ,  0.923879532511287, -0.130526192220052,  0.99144486137381,
    0.130526192220052,  0.99144486137381 ,  0.38268343236509 ,  0.923879532511287,  0.608761429008721,  0.793353340291235,  0.793353340291235,  0.608761429008721,
    0.923879532511287,  0.38268343236509 ,  0.99144486137381 ,  0.130526192220051,  0.99144486137381 , -0.130526192220051,  0.923879532511287, -0.38268343236509,
    0.793353340291235, -0.60876142900872 ,  0.608761429008721, -0.793353340291235,  0.38268343236509 , -0.923879532511287,  0.130526192220052, -0.99144486137381,
   -0.130526192220052, -0.99144486137381 , -0.38268343236509 , -0.923879532511287, -0.608761429008721, -0.793353340291235, -0.793353340291235, -0.608761429008721,
   -0.923879532511287, -0.38268343236509 , -0.99144486137381 , -0.130526192220052, -0.99144486137381 ,  0.130526192220051, -0.923879532511287,  0.38268343236509,
   -0.793353340291235,  0.608761429008721, -0.608761429008721,  0.793353340291235, -0.38268343236509 ,  0.923879532511287, -0.130526192220052,  0.99144486137381,
    0.38268343236509 ,  0.923879532511287,  0.923879532511287,  0.38268343236509 ,  0.923879532511287, -0.38268343236509 ,  0.38268343236509 , -0.923879532511287,
   -0.38268343236509 , -0.923879532511287, -0.923879532511287, -0.38268343236509 , -0.923879532511287,  0.38268343236509 , -0.38268343236509 ,  0.923879532511287
  ]
{-# INLINABLE grad2d #-}

-- >>> sizeofPrimArray grad3d == 256
-- True
grad3d :: PrimArray Int
grad3d =
  [ 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0
  , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0
  , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
  , 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0
  , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0
  , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
  , 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0
  , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0
  , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
  , 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0
  , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0
  , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
  , 0, 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0
  , 1, 0, 1, 0, -1, 0, 1, 0, 1, 0, -1, 0, -1, 0, -1, 0
  , 1, 1, 0, 0, -1, 1, 0, 0, 1, -1, 0, 0, -1, -1, 0, 0
  , 1, 1, 0, 0, 0, -1, 1, 0, -1, 1, 0, 0, 0, -1, -1, 0
  ]
{-# INLINABLE grad3d #-}