hsnoise 0.0.1 → 0.0.2

raw patch · 7 files changed

+206/−55 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• examples/Perlin.hs +5/−5
• examples/Ridged.hs +39/−0
• hsnoise.cabal +7/−8
• src/Numeric/Noise.hs +35/−21
• src/Numeric/Noise/Perlin.hs +35/−20
• src/Numeric/Noise/Random.hs +14/−1
• src/Numeric/Noise/Ridged.hs +71/−0

@@ -1,9 +1,9 @@-module Perlin where+module Main where -import Noise.Perlin+import Numeric.Noise.Perlin  import Codec.PPM.Binary-import Data.Word+import Data.Word (Word8)  main = do     -- The size of the resulting image.@@ -16,11 +16,11 @@     let persistance = 0.5      -- Create the perlin function.-    let perlin = Perlin seed octaves scale persistance    +    let perlinNoise = perlin seed octaves scale persistance          -- Compute the noise value for each pixel in the image.     let coords = [1.0..fromInteger size]-    let xs = [noiseValue perlin (x, y, 0) | y <- coords, x <- coords]+    let xs = [noiseValue perlinNoise (x, y, 0) | y <- coords, x <- coords]          -- Convert the noise values to grayscale colors.     let ps = map noiseToColor xs

@@ -0,0 +1,39 @@+module Main where++import Numeric.Noise.Ridged++import Codec.PPM.Binary+import Data.Word (Word8)++main = do+    -- The size of the resulting image.+    let size = 200++    -- Parameters for the noise function.+    let seed = 1+    let octaves = 5+    let scale = 0.05+    let frequency = 1+    let lacunarity = 2++    -- Create the ridged multi-fractal function.+    let ridgedNoise = ridged seed octaves scale frequency lacunarity ++    -- Compute the noise value for each pixel in the image.+    let coords = [1.0..fromInteger size]+    let xs = [noiseValue ridgedNoise (x, y, 0) | y <- coords, x <- coords]++    putStrLn (show (maximum xs))+    putStrLn (show (minimum xs))+    +    -- Convert the noise values to grayscale colors.+    let ps = map noiseToColor xs+    +    -- Write the image.+    writePPM "Noise.ppm" (size, size) ps+    return ()++-- Converts a value from -1 to 1 to a gray 24-bit color value from 0 to 255.+noiseToColor :: Double -> (Word8, Word8, Word8)+noiseToColor n = (n', n', n')+    where n' = fromInteger (floor ((n * 0.5 + 0.5) * 255)) :: Word8

@@ -1,5 +1,5 @@ name:               hsnoise-version:            0.0.1+version:            0.0.2  cabal-version:      >= 1.2.3 build-type:         Simple@@ -17,8 +17,8 @@ synopsis:           A coherent 3d noise library.  description:        A coherent 3d noise library loosely based on libnoise.  Currently has an-                    implementation of perlin noise.  Will eventually support other noise-                    types as well as noise function combinations.+                    implementation of Perlin noise and ridged multi-fractal noise.  Will +                    eventually support other noise types as well as noise function combinations.                     .                     Code examples included in package.                     .@@ -27,12 +27,11 @@  category:           Noise -extra-source-files: examples/Perlin.hs+extra-source-files: examples/Perlin.hs, examples/Ridged.hs  library-    exposed-modules:-        Numeric.Noise-        Numeric.Noise.Perlin-        Numeric.Noise.Random +    exposed-modules:    Numeric.Noise, Numeric.Noise.Perlin, Numeric.Noise.Random,+                        Numeric.Noise.Ridged      build-depends:      base >= 4 && < 5, vector -any     hs-source-dirs:     src+    ghc-options:        -Wall

@@ -1,12 +1,16 @@ -- Copyright (c) 2011, Colin Hill--- Loosely based on implementation of Libnoise (libnoise.sourceforge.net)+--+-- Loosely based on implementation of libnoise by Jason Bevins Copyright (C) 2003, 2004+-- http://libnoise.sourceforge.net  -- | Contains 'Noise' class as well as a general coherent noise generating function which -- the specific noise implementations are based on. module Numeric.Noise (     Point,     Seed,-    Noise(..),+    Noise(noiseValue),+    pmap,+    clamp,     coherentNoise ) where @@ -24,9 +28,17 @@     -- | Maps 3-space points to a noise value between -1 and 1 for the given noise function.     noiseValue :: a -> Point -> Double +-- | Map a function on a 'Point'.+pmap :: (Double -> Double) -> Point -> Point+pmap f (x, y, z) = (f x, f y, f z)++-- | Returns a clamped value between a min and max value.+clamp :: Ord a => a -> a -> a -> a+clamp v m m' = max m (min m' v)+ -- | Returns a coherent noise value between -1 and 1 given a seed and a point in 3-space. coherentNoise :: Seed -> Point -> Double-coherentNoise seed (x, y, z) = max (-1.0) (min 1.0 (lerp sz iy0 iy1))+coherentNoise seed (x, y, z) = clamp noise (-1) 1     where (ox, oy, oz) = (clampToIntRange x, clampToIntRange y, clampToIntRange z)           x0           = if ox > 0.0 then floor ox else floor ox - 1           x1           = x0 + 1@@ -39,30 +51,31 @@           sz           = scurve (oz - fromIntegral z0)           n0           = gradientNoise seed ox oy oz x0 y0 z0           n1           = gradientNoise seed ox oy oz x1 y0 z0+          n2           = gradientNoise seed ox oy oz x0 y1 z0+          n3           = gradientNoise seed ox oy oz x1 y1 z0+          n4           = gradientNoise seed ox oy oz x0 y0 z1+          n5           = gradientNoise seed ox oy oz x1 y0 z1+          n6           = gradientNoise seed ox oy oz x0 y1 z1+          n7           = gradientNoise seed ox oy oz x1 y1 z1           ix0          = lerp sx n0 n1-          n0'          = gradientNoise seed ox oy oz x0 y1 z0-          n1'          = gradientNoise seed ox oy oz x1 y1 z0-          ix1          = lerp sx n0' n1'+          ix1          = lerp sx n2 n3+          ix2          = lerp sx n4 n5+          ix3          = lerp sx n6 n7           iy0          = lerp sy ix0 ix1-          n0''         = gradientNoise seed ox oy oz x0 y0 z1-          n1''         = gradientNoise seed ox oy oz x1 y0 z1-          ix0'         = lerp sx n0'' n1''-          n0'''        = gradientNoise seed ox oy oz x0 y1 z1-          n1'''        = gradientNoise seed ox oy oz x1 y1 z1-          ix1'         = lerp sx n0''' n1'''-          iy1          = lerp sy ix0' ix1'+          iy1          = lerp sy ix2 ix3+          noise        = lerp sz iy0 iy1  -- | Returns a gradient noise value given a seed, a point in 3-space, and a nearby integer -- point in 3-space. gradientNoise :: Seed -> Double -> Double -> Double -> Int -> Int -> Int -> Double gradientNoise seed fx fy fz ix iy iz = 2.12 * (gx * ox + gy * oy + gz * oz)-    where (gx, gy, gz) = (vectorTable ! (shiftL i 2),-                          vectorTable ! ((shiftL i 2) + 1),-                          vectorTable ! ((shiftL i 2) + 2))+    where (gx, gy, gz) = (vectorTable ! shiftL i 2,+                          vectorTable ! (shiftL i 2 + 1),+                          vectorTable ! (shiftL i 2 + 2))           (ox, oy, oz) = (fx - fromIntegral ix,                           fy - fromIntegral iy,                           fz - fromIntegral iz)-          i            = (i' `xor` (shiftR i' 8)) .&. 0xff+          i            = (i' `xor` shiftR i' 8) .&. 0xff           i'           = (1619 * ix + 31337 * iy + 6971 * iz + 1013 * seed) .&. 0xffffffff  -- | Returns the linearly interpolated value between two values given a delta.@@ -76,15 +89,16 @@           a4 = a3 * a           a5 = a4 * a --- | Clamps a 'Double' to the range of a 32 bit 'Int'.+-- | Clamps a 'Double' to the range of an 'Int'. clampToIntRange :: Double -> Double-clampToIntRange n | n >=   1073741824.0  = 2.0 * (fmod n 1073741824.0) - 1073741824.0-                  | n <= (-1073741824.0) = 2.0 * (fmod n 1073741824.0) + 1073741824.0+clampToIntRange n | n >= maxInt    = 2.0 * fmod n maxInt - maxInt+                  | n <= (-maxInt) = 2.0 * fmod n maxInt + maxInt                   | otherwise            = n+    where maxInt = 1073741824.0 -- Max 32 bit signed Int.  Should not be hardcoded.  -- | Floating point modulus function. fmod :: Double -> Double -> Double-fmod x y = x - fromIntegral (floor (x / y)) * y+fmod x y = x - fromIntegral (floor (x / y) :: Int) * y  -- | Table of random normalized vectors. vectorTable :: Vector Double

@@ -1,32 +1,47 @@ -- Copyright (c) 2011, Colin Hill  -- | Implementation of Perlin noise.+--+-- Example of use:+--+-- @+--main = putStrLn (\"Noise value at (1, 2, 3): \" ++ show x)+--    where seed        = 1+--          octaves     = 5+--          scale       = 0.05+--          persistance = 0.5+--          perlinNoise = perlin seed octaves scale persistance+--          x           = noiseValue perlinNoise (1, 2, 3)+-- @ module Numeric.Noise.Perlin (-    Perlin(..),+    Perlin,+    perlin,     noiseValue ) where  import Numeric.Noise --- | Perlin noise function.-data Perlin =-    -- | Constructs a perlin noise function given a 'Seed', number of octaves, scale, and -    -- persistance.-    Perlin Seed Int Double Double+-- | A Perlin noise function.+data Perlin = Perlin Seed Int Double Double --- | Implementation of 'Noise' for 'Perlin'. instance Noise Perlin where-    -- | Returns a perlin noise value given a 'Perlin' function and a point.-    noiseValue nf xyz = max (-1.0) (min 1.0 noise)-        where Perlin _ octs _ _ = nf-              noise             = perlinNoise nf octs 0 1.0 1.0 xyz+    noiseValue perlinNoise xyz = clamp noise (-1) 1+        where Perlin _ octs _ _ = perlinNoise+              noise             = perlinNoiseValue perlinNoise octs 1 1 xyz --- | Evaluates a given number of octaves of perlin noise holding the total, amplitude--- and frequency in the arguments.-perlinNoise :: Perlin -> Int -> Double -> Double -> Double -> Point -> Double-perlinNoise nf 0 t freq amp xyz = t-perlinNoise nf o t freq amp xyz = t + perlinNoise nf (o - 1) t' (freq * 2.0) (amp * persist) xyz-    where Perlin seed _ scale persist = nf-          (x, y, z)                   = xyz-          (x', y', z')                = (x * scale * freq, y * scale * freq, z * scale * freq)-          t'                          = coherentNoise seed (x', y', z') * amp+-- | Constructs a Perlin noise function given a seed, number of octaves, scale, and persistance.+perlin :: Seed -> Int -> Double -> Double -> Perlin+perlin = Perlin++-- | Evaluates a given number of octaves of perlin noise holding the frequency and amplitude in +-- the arguments.+perlinNoiseValue :: Perlin -> Int -> Double -> Double -> Point -> Double+perlinNoiseValue _           0   _    _   _   = 0+perlinNoiseValue perlinNoise oct freq amp xyz = noise + noise'+    where Perlin seed _ scale pers = perlinNoise+          oct'   = oct - 1+          freq'  = freq * 2+          amp'   = amp * pers+          xyz'   = pmap (* (scale * freq)) xyz+          noise  = coherentNoise seed xyz' * amp+          noise' = perlinNoiseValue perlinNoise oct' freq' amp' xyz

@@ -1,6 +1,19 @@ -- Copyright (c) 2011, Colin Hill  -- | A simple implementation of a pure linear congruential psuedo-random number generator.+--+-- Example of use:+--+-- @+--main = do+--    let seed = 1+--    let (r, seed') = randomInt seed+--    putStrLn (\"Random number 1: \" ++ show r)+--    let (r', seed'') = randomInt seed'+--    putStrLn (\"Random number 2: \" ++ show r')+--    putStrLn (\"Random int list: \" ++ show (randomInts 10 seed))+--    putStrLn (\"Shuffled list: \" ++ show (shuffle [1..10] seed))+-- @ module Numeric.Noise.Random (     randomInt,     randomInts,@@ -37,4 +50,4 @@ shuffle' [] acc seed = (acc, seed) shuffle' xs acc seed = shuffle' (h ++ ys) (y:acc) seed'     where (seed', r) = randomInt seed-          (h, y:ys)  = splitAt (r `mod` (length xs)) xs+          (h, y:ys)  = splitAt (r `mod` length xs) xs

@@ -0,0 +1,71 @@+-- Copyright (c) 2011, Colin Hill++-- | Implementation of ridged multi-fractal noise.+--+-- Example of use:+--+-- @+--main = putStrLn (\"Noise value at (1, 2, 3): \" ++ show x)+--    where seed        = 1+--          octaves     = 5+--          scale       = 0.005+--          frequency   = 1+--          lacunarity  = 2+--          ridgedNoise = ridged seed octaves scale frequency lacunarity+--          x           = noiseValue ridgedNoise (1, 2, 3)+-- @+module Numeric.Noise.Ridged (+    Ridged,+    ridged,+    noiseValue+) where++import Numeric.Noise++import Data.Bits ((.&.))+import Data.Vector.Unboxed (Vector, fromList, (!))++-- | A ridged multi-fractal noise function.+data Ridged = Ridged Seed Int Double Double Double (Vector Double)++-- | Constructs a ridged multi-fractal noise function given a seed, number of octaves, scale, +-- frequency, and lacunarity.+ridged :: Seed -> Int -> Double -> Double -> Double -> Ridged+ridged seed octs scale freq lac = ridgedNoise+    where specWeights = computeSpecWeights octs lac+          ridgedNoise = Ridged seed octs scale freq lac specWeights++instance Noise Ridged where+    noiseValue ridgedNoise xyz = clamp noise (-1) 1+        where Ridged _ octs scale freq _ _ = ridgedNoise+              xyz'  = pmap (* (scale * freq)) xyz+              noise = ridgedNoiseValue ridgedNoise octs 1 xyz' * 1.25 - 1++-- | Computes the noise value for a ridged multi-fractal noise function given the octave number, +-- the weight, and the point.+ridgedNoiseValue :: Ridged -> Int -> Double -> Point -> Double+ridgedNoiseValue _           0   _      _   = 0+ridgedNoiseValue ridgedNoise oct weight xyz = noise + noise'+    where Ridged seed octs _ _ lac specWeights = ridgedNoise+          oct'    = oct - 1+          xyz'    = pmap (* lac) xyz+          seed'   = (seed + (octs - oct)) .&. 0x7fffffff+          signal  = (offset - abs (coherentNoise seed' xyz)) * weight * weight+          weight' = clamp (signal * gain) 0 1+          noise   = signal * (specWeights ! (octs - oct))+          noise'  = ridgedNoiseValue ridgedNoise oct' weight' xyz'+          gain    = 2+          offset  = 1++-- | Computes the spectral weight for each oct given the number of octs and the lac.+computeSpecWeights :: Int -> Double -> Vector Double+computeSpecWeights octs lac = fromList (computeSpecWeights' octs lac 1)++-- | Helper for 'computeSpecWeights'.+computeSpecWeights' :: Int -> Double -> Double -> [Double]+computeSpecWeights' 0   _   _    = []+computeSpecWeights' oct lac freq = weight : weights+    where freq'   = freq * lac+          oct'    = oct - 1+          weight  = freq ** (-1)+          weights = computeSpecWeights' oct' lac freq'