pure-noise-0.1.0.0: src/Numeric/Noise/Cellular.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
-- |
-- Maintainer: Jeremy Nuttall <jeremy@jeremy-nuttall.com>
-- Stability : experimental
module Numeric.Noise.Cellular (
-- * Configuration
CellularConfig (..),
defaultCellularConfig,
CellularDistanceFn (..),
CellularResult (..),
-- * 2D Noise
noise2,
noise2BaseWith,
) where
import Data.Bits
import Data.Foldable
import Data.Vector.Unboxed qualified as U
import GHC.Generics (Generic)
import Numeric.Noise.Internal
import Numeric.Noise.Internal.Math
data CellularConfig a = CellularConfig
{ cellularDistanceFn :: !CellularDistanceFn
, cellularJitter :: !a
, cellularResult :: !CellularResult
}
deriving (Generic, Show)
defaultCellularConfig :: (RealFrac a) => CellularConfig a
defaultCellularConfig =
CellularConfig
{ cellularDistanceFn = DistEuclidean
, cellularJitter = 1
, cellularResult = CellValue
}
data CellularDistanceFn
= DistEuclidean
| DistEuclideanSq
| DistManhattan
| DistHybrid
deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded)
data CellularResult
= CellValue
| Distance
| Distance2
| Distance2Add
| Distance2Sub
| Distance2Mul
| Distance2Div
deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded)
distance :: (RealFrac a) => CellularDistanceFn -> a -> a -> a
distance = \case
DistEuclidean -> \ !x !y -> x * x + y * y
DistEuclideanSq -> \ !x !y -> x * x + y * y
DistManhattan -> \ !x !y -> abs x + abs y
DistHybrid -> \ !x !y -> abs x + abs y + (x * x + y * y)
{-# INLINE distance #-}
normDist :: (Floating a) => CellularDistanceFn -> a -> a
normDist = \case
DistEuclidean -> sqrt
_ -> id
{-# INLINE normDist #-}
noise2 :: (RealFrac a, Floating a) => CellularConfig a -> Noise2 a
noise2 CellularConfig{..} =
let !jitter = cellularJitter * 0.43701595
!dist = distance cellularDistanceFn
!norm = normDist cellularDistanceFn
coeff = 1 / (fromIntegral (maxBound @Hash) + 1)
in Noise2 $ \seed x y ->
let (!hash, !d0u, !d1u) = noise2BaseWith jitter dist seed x y
!d0 = norm d0u
!d1 = norm d1u
in case cellularResult of
CellValue -> fromIntegral hash * coeff
Distance -> d0 - 1
Distance2 -> d1 - 1
Distance2Add -> (d1 + d0) * 0.5 - 1
Distance2Sub -> d1 - d0 - 1
Distance2Mul -> d1 * d0 * 0.5 - 1
Distance2Div -> d0 / d1 - 1
{-# INLINE noise2 #-}
-- | Calculate 2D cellular noise values at a given point using the given distance function
noise2BaseWith
:: (RealFrac a)
=> a
-- ^ cellular jitter
-> (a -> a -> a)
-- ^ distance function
-> Seed
-> a
-- ^ x
-> a
-- ^ y
-> (Hash, a, a)
noise2BaseWith !jitter !dist !seed !x !y =
foldl' @[]
minmax
(0, infinity, infinity)
[pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]]
where
!rx = round x
!ry = round y
minmax (!c, !d0, !d1) (!h, !d)
| d < d0 = (h, d, d1')
| otherwise = (c, d0, d1')
where
!d1' = max (min d1 d) d0
pointDist !xi !yi =
let !px = fromIntegral xi - x
!py = fromIntegral yi - y
!h = hash2 seed (primeX * xi) (primeY * yi)
!i = h .&. 510
!rvx = randVecs2d `U.unsafeIndex` fromIntegral i
!rvy = randVecs2d `U.unsafeIndex` (fromIntegral i .|. 1)
!d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter)
in (h, d)
{-# INLINE noise2BaseWith #-}
-- >>> U.length randVecs2d == 512
-- True
{- ORMOLU_DISABLE -}
randVecs2d :: U.Vector Float
randVecs2d =
[-0.2700222198,-0.9628540911,0.3863092627,-0.9223693152,0.04444859006,-0.999011673,-0.5992523158,-0.8005602176
,-0.7819280288,0.6233687174,0.9464672271,0.3227999196,-0.6514146797,-0.7587218957,0.9378472289,0.347048376
,-0.8497875957,-0.5271252623,-0.879042592,0.4767432447,-0.892300288,-0.4514423508,-0.379844434,-0.9250503802
,-0.9951650832,0.0982163789,0.7724397808,-0.6350880136,0.7573283322,-0.6530343002,-0.9928004525,-0.119780055
,-0.0532665713,0.9985803285,0.9754253726,-0.2203300762,-0.7665018163,0.6422421394,0.991636706,0.1290606184
,-0.994696838,0.1028503788,-0.5379205513,-0.84299554,0.5022815471,-0.8647041387,0.4559821461,-0.8899889226
,-0.8659131224,-0.5001944266,0.0879458407,-0.9961252577,-0.5051684983,0.8630207346,0.7753185226,-0.6315704146
,-0.6921944612,0.7217110418,-0.5191659449,-0.8546734591,0.8978622882,-0.4402764035,-0.1706774107,0.9853269617
,-0.9353430106,-0.3537420705,-0.9992404798,0.03896746794,-0.2882064021,-0.9575683108,-0.9663811329,0.2571137995
,-0.8759714238,-0.4823630009,-0.8303123018,-0.5572983775,0.05110133755,-0.9986934731,-0.8558373281,-0.5172450752
,0.09887025282,0.9951003332,0.9189016087,0.3944867976,-0.2439375892,-0.9697909324,-0.8121409387,-0.5834613061
,-0.9910431363,0.1335421355,0.8492423985,-0.5280031709,-0.9717838994,-0.2358729591,0.9949457207,0.1004142068
,0.6241065508,-0.7813392434,0.662910307,0.7486988212,-0.7197418176,0.6942418282,-0.8143370775,-0.5803922158
,0.104521054,-0.9945226741,-0.1065926113,-0.9943027784,0.445799684,-0.8951327509,0.105547406,0.9944142724
,-0.992790267,0.1198644477,-0.8334366408,0.552615025,0.9115561563,-0.4111755999,0.8285544909,-0.5599084351
,0.7217097654,-0.6921957921,0.4940492677,-0.8694339084,-0.3652321272,-0.9309164803,-0.9696606758,0.2444548501
,0.08925509731,-0.996008799,0.5354071276,-0.8445941083,-0.1053576186,0.9944343981,-0.9890284586,0.1477251101
,0.004856104961,0.9999882091,0.9885598478,0.1508291331,0.9286129562,-0.3710498316,-0.5832393863,-0.8123003252
,0.3015207509,0.9534596146,-0.9575110528,0.2883965738,0.9715802154,-0.2367105511,0.229981792,0.9731949318
,0.955763816,-0.2941352207,0.740956116,0.6715534485,-0.9971513787,-0.07542630764,0.6905710663,-0.7232645452
,-0.290713703,-0.9568100872,0.5912777791,-0.8064679708,-0.9454592212,-0.325740481,0.6664455681,0.74555369
,0.6236134912,0.7817328275,0.9126993851,-0.4086316587,-0.8191762011,0.5735419353,-0.8812745759,-0.4726046147
,0.9953313627,0.09651672651,0.9855650846,-0.1692969699,-0.8495980887,0.5274306472,0.6174853946,-0.7865823463
,0.8508156371,0.52546432,0.9985032451,-0.05469249926,0.1971371563,-0.9803759185,0.6607855748,-0.7505747292
,-0.03097494063,0.9995201614,-0.6731660801,0.739491331,-0.7195018362,-0.6944905383,0.9727511689,0.2318515979
,0.9997059088,-0.0242506907,0.4421787429,-0.8969269532,0.9981350961,-0.061043673,-0.9173660799,-0.3980445648
,-0.8150056635,-0.5794529907,-0.8789331304,0.4769450202,0.0158605829,0.999874213,-0.8095464474,0.5870558317
,-0.9165898907,-0.3998286786,-0.8023542565,0.5968480938,-0.5176737917,0.8555780767,-0.8154407307,-0.5788405779
,0.4022010347,-0.9155513791,-0.9052556868,-0.4248672045,0.7317445619,0.6815789728,-0.5647632201,-0.8252529947
,-0.8403276335,-0.5420788397,-0.9314281527,0.363925262,0.5238198472,0.8518290719,0.7432803869,-0.6689800195
,-0.985371561,-0.1704197369,0.4601468731,0.88784281,0.825855404,0.5638819483,0.6182366099,0.7859920446
,0.8331502863,-0.553046653,0.1500307506,0.9886813308,-0.662330369,-0.7492119075,-0.668598664,0.743623444
,0.7025606278,0.7116238924,-0.5419389763,-0.8404178401,-0.3388616456,0.9408362159,0.8331530315,0.5530425174
,-0.2989720662,-0.9542618632,0.2638522993,0.9645630949,0.124108739,-0.9922686234,-0.7282649308,-0.6852956957
,0.6962500149,0.7177993569,-0.9183535368,0.3957610156,-0.6326102274,-0.7744703352,-0.9331891859,-0.359385508
,-0.1153779357,-0.9933216659,0.9514974788,-0.3076565421,-0.08987977445,-0.9959526224,0.6678496916,0.7442961705
,0.7952400393,-0.6062947138,-0.6462007402,-0.7631674805,-0.2733598753,0.9619118351,0.9669590226,-0.254931851
,-0.9792894595,0.2024651934,-0.5369502995,-0.8436138784,-0.270036471,-0.9628500944,-0.6400277131,0.7683518247
,-0.7854537493,-0.6189203566,0.06005905383,-0.9981948257,-0.02455770378,0.9996984141,-0.65983623,0.751409442
,-0.6253894466,-0.7803127835,-0.6210408851,-0.7837781695,0.8348888491,0.5504185768,-0.1592275245,0.9872419133
,0.8367622488,0.5475663786,-0.8675753916,-0.4973056806,-0.2022662628,-0.9793305667,0.9399189937,0.3413975472
,0.9877404807,-0.1561049093,-0.9034455656,0.4287028224,0.1269804218,-0.9919052235,-0.3819600854,0.924178821
,0.9754625894,0.2201652486,-0.3204015856,-0.9472818081,-0.9874760884,0.1577687387,0.02535348474,-0.9996785487
,0.4835130794,-0.8753371362,-0.2850799925,-0.9585037287,-0.06805516006,-0.99768156,-0.7885244045,-0.6150034663
,0.3185392127,-0.9479096845,0.8880043089,0.4598351306,0.6476921488,-0.7619021462,0.9820241299,0.1887554194
,0.9357275128,-0.3527237187,-0.8894895414,0.4569555293,0.7922791302,0.6101588153,0.7483818261,0.6632681526
,-0.7288929755,-0.6846276581,0.8729032783,-0.4878932944,0.8288345784,0.5594937369,0.08074567077,0.9967347374
,0.9799148216,-0.1994165048,-0.580730673,-0.8140957471,-0.4700049791,-0.8826637636,0.2409492979,0.9705377045
,0.9437816757,-0.3305694308,-0.8927998638,-0.4504535528,-0.8069622304,0.5906030467,0.06258973166,0.9980393407
,-0.9312597469,0.3643559849,0.5777449785,0.8162173362,-0.3360095855,-0.941858566,0.697932075,-0.7161639607
,-0.002008157227,-0.9999979837,-0.1827294312,-0.9831632392,-0.6523911722,0.7578824173,-0.4302626911,-0.9027037258
,-0.9985126289,-0.05452091251,-0.01028102172,-0.9999471489,-0.4946071129,0.8691166802,-0.2999350194,0.9539596344
,0.8165471961,0.5772786819,0.2697460475,0.962931498,-0.7306287391,-0.6827749597,-0.7590952064,-0.6509796216
,-0.907053853,0.4210146171,-0.5104861064,-0.8598860013,0.8613350597,0.5080373165,0.5007881595,-0.8655698812
,-0.654158152,0.7563577938,-0.8382755311,-0.545246856,0.6940070834,0.7199681717,0.06950936031,0.9975812994
,0.1702942185,-0.9853932612,0.2695973274,0.9629731466,0.5519612192,-0.8338697815,0.225657487,-0.9742067022
,0.4215262855,-0.9068161835,0.4881873305,-0.8727388672,-0.3683854996,-0.9296731273,-0.9825390578,0.1860564427
,0.81256471,0.5828709909,0.3196460933,-0.9475370046,0.9570913859,0.2897862643,-0.6876655497,-0.7260276109
,-0.9988770922,-0.047376731,-0.1250179027,0.992154486,-0.8280133617,0.560708367,0.9324863769,-0.3612051451
,0.6394653183,0.7688199442,-0.01623847064,-0.9998681473,-0.9955014666,-0.09474613458,-0.81453315,0.580117012
,0.4037327978,-0.9148769469,0.9944263371,0.1054336766,-0.1624711654,0.9867132919,-0.9949487814,-0.100383875
,-0.6995302564,0.7146029809,0.5263414922,-0.85027327,-0.5395221479,0.841971408,0.6579370318,0.7530729462
,0.01426758847,-0.9998982128,-0.6734383991,0.7392433447,0.639412098,-0.7688642071,0.9211571421,0.3891908523
,-0.146637214,-0.9891903394,-0.782318098,0.6228791163,-0.5039610839,-0.8637263605,-0.7743120191,-0.6328039957
]