pure-noise-0.2.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,
) where
import Data.Bits
import Data.Foldable -- redundant since GHC 9.10.1, here for compat
import Data.Primitive.PrimArray
import GHC.Generics (Generic)
import Numeric.Noise.Internal
import Numeric.Noise.Internal.Math
-- | Configuration for cellular (Worley) noise generation.
--
-- Cellular noise is based on distances to randomly distributed cell points,
-- creating a distinctive cellular or organic pattern.
data CellularConfig a = CellularConfig
{ cellularDistanceFn :: !CellularDistanceFn
-- ^ Distance metric to use when computing distance to cell points.
, cellularJitter :: !a
-- ^ Amount of randomness in cell point positions.
-- 0 creates a regular grid, 1 creates fully random positions.
-- Values outside [0, 1] are valid but may produce unusual results.
, cellularResult :: !CellularResult
-- ^ What value to return from the noise function.
}
deriving (Generic, Show)
-- | Default configuration for cellular noise generation.
defaultCellularConfig :: (RealFrac a) => CellularConfig a
defaultCellularConfig =
CellularConfig
{ cellularDistanceFn = DistEuclidean
, cellularJitter = 1
, cellularResult = CellValue
}
-- | Distance function for cellular noise calculations.
--
-- Different distance metrics produce different visual characteristics
-- in the cellular pattern.
data CellularDistanceFn
= -- | Standard Euclidean distance (sqrt(dx² + dy²)).
-- Creates circular cells with smooth edges.
DistEuclidean
| -- | Squared Euclidean distance (dx² + dy²), no square root.
-- Faster than 'DistEuclidean' with similar appearance.
DistEuclideanSq
| -- | Manhattan/taxicab distance (|dx| + |dy|).
-- Creates diamond-shaped cells with sharp edges.
DistManhattan
| -- | Hybrid of Euclidean and Manhattan distances.
-- Combines characteristics of both metrics.
DistHybrid
deriving (Generic, Read, Show, Eq, Ord, Enum, Bounded)
-- | What value to return from cellular noise evaluation.
--
-- These options allow for different visual effects by returning different
-- properties of the cell structure.
data CellularResult
= -- | Return the hash value of the nearest cell point.
-- Creates discrete regions with constant values.
CellValue
| -- | Return the distance to the nearest cell point.
-- Creates a classic Worley noise pattern with cell boundaries.
Distance
| -- | Return the distance to the second-nearest cell point.
-- Creates larger, more organic-looking cells.
Distance2
| -- | Return the sum of distances to the two nearest cell points.
-- Creates smooth, rounded cells.
Distance2Add
| -- | Return the difference between distances to the two nearest cell points.
-- Emphasizes cell boundaries and creates sharp edges.
Distance2Sub
| -- | Return the product of distances to the two nearest cell points.
-- Creates cells with varying contrast.
Distance2Mul
| -- | Return the ratio of nearest to second-nearest distance.
-- Creates normalized cell patterns.
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{..} = Noise2 $ \ !seed !x !y ->
let !jitter = cellularJitter * 0.43701595
!rx = round x
!ry = round y
dist = distance cellularDistanceFn
norm = normDist cellularDistanceFn
coeff = 1 / (fromIntegral (maxBound @Hash) + 1)
{-# INLINE pointDist #-}
pointDist !xi !yi =
let !px = fromIntegral xi - x
!py = fromIntegral yi - y
!h = hash2 seed (primeX * xi) (primeY * yi)
!i = h .&. 0x1FE
!rvx = randVecs2d `indexPrimArray` fromIntegral i
!rvy = randVecs2d `indexPrimArray` (fromIntegral i .|. 1)
!d = dist (px + realToFrac rvx * jitter) (py + realToFrac rvy * jitter)
in (h, d)
{-# INLINE points #-}
points = [pointDist (rx + xi) (ry + yi) | !xi <- [-1 .. 1], !yi <- [-1 .. 1]]
{-# INLINE selectMinHash #-}
selectMinHash =
let minHash (!hMin, !dMin) (!h, !d)
| d < dMin = (h, d)
| otherwise = (hMin, dMin)
in foldl' minHash (0, infinity) points
{-# INLINE selectMinDist #-}
selectMinDist =
let minDist !dMin (_, !d)
| d < dMin = d
| otherwise = dMin
in foldl' minDist infinity points
{-# INLINE selectSmallestTwo #-}
selectSmallestTwo =
let smallestTwo (!c, !d0, !d1) (!h, !d)
| d < d0 = (h, d, d0)
| d < d1 = (c, d0, d)
| otherwise = (c, d0, d1)
in foldl' smallestTwo (0, infinity, infinity) points
in case cellularResult of
CellValue ->
let (!hash, !_) = selectMinHash
in fromIntegral hash * coeff
Distance ->
let !d0 = selectMinDist
in norm d0 - 1
Distance2 ->
let (!_, !_, !d1) = selectSmallestTwo
in norm d1 - 1
Distance2Add ->
let (!_, !d0, !d1) = selectSmallestTwo
in (norm d1 + norm d0) * 0.5 - 1
Distance2Sub ->
let (!_, !d0, !d1) = selectSmallestTwo
in norm d1 - norm d0 - 1
Distance2Mul ->
let (!_, !d0, !d1) = selectSmallestTwo
in norm d1 * norm d0 * 0.5 - 1
Distance2Div ->
let (!_, !d0, !d1) = selectSmallestTwo
in norm d0 / norm d1 - 1
where
{-# INLINE noise2 #-}
-- >>> sizeofPrimArray randVecs2d == 512
-- True
{- ORMOLU_DISABLE -}
randVecs2d :: PrimArray 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
]