hsnoise 0.0.2 → 0.0.3
raw patch · 9 files changed
+681/−674 lines, 9 filessetup-changedPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Numeric.Noise.Perlin: instance Noise Perlin
- Numeric.Noise.Ridged: instance Noise Ridged
+ Numeric.Noise.Perlin: instance Numeric.Noise.Noise Numeric.Noise.Perlin.Perlin
+ Numeric.Noise.Ridged: instance Numeric.Noise.Noise Numeric.Noise.Ridged.Ridged
Files
- LICENSE +24/−24
- Setup.hs +8/−7
- examples/Perlin.hs +35/−35
- examples/Ridged.hs +39/−39
- hsnoise.cabal +43/−37
- src/Numeric/Noise.hs +361/−361
- src/Numeric/Noise/Perlin.hs +47/−47
- src/Numeric/Noise/Random.hs +53/−53
- src/Numeric/Noise/Ridged.hs +71/−71
LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2011, Colin Hill-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:- * Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.- * Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.- * Neither the name of the <organization> nor the- names of its contributors may be used to endorse or promote products- derived from this software without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2011, Colin Hill +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + * Neither the name of the <organization> nor the + names of its contributors may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY +DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,7 +1,8 @@-#!/usr/bin/runhaskell -module Main where--import Distribution.Simple--main :: IO ()-main = defaultMain+#!/usr/bin/runhaskell +module Main where + +import Distribution.Simple + +main :: IO () +main = defaultMain +
examples/Perlin.hs view
@@ -1,35 +1,35 @@-module Main where--import Numeric.Noise.Perlin--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 persistance = 0.5-- -- Create the perlin function.- 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 perlinNoise (x, y, 0) | y <- coords, x <- coords]- - -- 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+module Main where + +import Numeric.Noise.Perlin + +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 persistance = 0.5 + + -- Create the perlin function. + 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 perlinNoise (x, y, 0) | y <- coords, x <- coords] + + -- 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
examples/Ridged.hs view
@@ -1,39 +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+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
hsnoise.cabal view
@@ -1,37 +1,43 @@-name: hsnoise-version: 0.0.2--cabal-version: >= 1.2.3-build-type: Simple--license: BSD3-license-file: LICENSE-copyright: Copyright (c) 2011, Colin Hill-author: Colin Hill <colin.james.hill@gmail.com>-maintainer: Colin Hill <colin.james.hill@gmail.com>--stability: Experimental--homepage: https://github.com/colinhect/hsnoise--synopsis: A coherent 3d noise library.--description: A coherent 3d noise library loosely based on libnoise. Currently has an- 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.- .- Example of Perlin noise output image: <http://i.imgur.com/cPOZ2.png>- .--category: Noise--extra-source-files: examples/Perlin.hs, examples/Ridged.hs--library- 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+cabal-version: >= 1.10 + +name: hsnoise +version: 0.0.3 + +build-type: Simple + +license: BSD3 +license-file: LICENSE +copyright: Copyright (c) 2011, Colin Hill +author: Colin Hill <colin.james.hill@gmail.com> +maintainer: Colin Hill <colin.james.hill@gmail.com> + +stability: Experimental + +homepage: https://github.com/colinhect/hsnoise + +synopsis: A coherent 3d noise library. + +description: A coherent 3d noise library loosely based on libnoise. Currently has an + 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. + . + Example of Perlin noise output image: <http://i.imgur.com/cPOZ2.png> + . + +category: Noise + +extra-source-files: examples/Perlin.hs, examples/Ridged.hs + +library + 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 + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/colinhect/hsnoise.git
src/Numeric/Noise.hs view
@@ -1,361 +1,361 @@--- Copyright (c) 2011, Colin Hill------ 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(noiseValue),- pmap,- clamp,- coherentNoise-) where--import Data.Bits-import Data.Vector.Unboxed (Vector, fromList, (!))---- | A point in 3-space.-type Point = (Double, Double, Double)---- | A seed for a random function.-type Seed = Int---- | Class of noise functions.-class Noise a where- -- | 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) = 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- y0 = if oy > 0.0 then floor oy else floor oy - 1- y1 = y0 + 1- z0 = if oz > 0.0 then floor oz else floor oz - 1- z1 = z0 + 1- sx = scurve (ox - fromIntegral x0)- sy = scurve (oy - fromIntegral y0)- 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- ix1 = lerp sx n2 n3- ix2 = lerp sx n4 n5- ix3 = lerp sx n6 n7- iy0 = 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))- (ox, oy, oz) = (fx - fromIntegral ix,- fy - fromIntegral iy,- fz - fromIntegral iz)- 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.-lerp :: Double -> Double -> Double -> Double-lerp t a b = (1.0 - t) * a + t * b---- | Maps a value onto a quintic s-curve.-scurve :: Double -> Double-scurve a = (6.0 * a5) - (15.0 * a4) + (10.0 * a3)- where a3 = a * a * a- a4 = a3 * a- a5 = a4 * a---- | Clamps a 'Double' to the range of an 'Int'.-clampToIntRange :: Double -> Double-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) :: Int) * y---- | Table of random normalized vectors.-vectorTable :: Vector Double-vectorTable = fromList [- -0.763874, -0.596439, -0.246489, 0.0,- 0.396055, 0.904518, -0.158073, 0.0,- -0.499004, -0.8665, -0.0131631, 0.0,- 0.468724, -0.824756, 0.316346, 0.0,- 0.829598, 0.43195, 0.353816, 0.0,- -0.454473, 0.629497, -0.630228, 0.0,- -0.162349, -0.869962, -0.465628, 0.0,- 0.932805, 0.253451, 0.256198, 0.0,- -0.345419, 0.927299, -0.144227, 0.0,- -0.715026, -0.293698, -0.634413, 0.0,- -0.245997, 0.717467, -0.651711, 0.0,- -0.967409, -0.250435, -0.037451, 0.0,- 0.901729, 0.397108, -0.170852, 0.0,- 0.892657, -0.0720622, -0.444938, 0.0,- 0.0260084, -0.0361701, 0.999007, 0.0,- 0.949107, -0.19486, 0.247439, 0.0,- 0.471803, -0.807064, -0.355036, 0.0,- 0.879737, 0.141845, 0.453809, 0.0,- 0.570747, 0.696415, 0.435033, 0.0,- -0.141751, -0.988233, -0.0574584, 0.0,- -0.58219, -0.0303005, 0.812488, 0.0,- -0.60922, 0.239482, -0.755975, 0.0,- 0.299394, -0.197066, -0.933557, 0.0,- -0.851615, -0.220702, -0.47544, 0.0,- 0.848886, 0.341829, -0.403169, 0.0,- -0.156129, -0.687241, 0.709453, 0.0,- -0.665651, 0.626724, 0.405124, 0.0,- 0.595914, -0.674582, 0.43569, 0.0,- 0.171025, -0.509292, 0.843428, 0.0,- 0.78605, 0.536414, -0.307222, 0.0,- 0.18905, -0.791613, 0.581042, 0.0,- -0.294916, 0.844994, 0.446105, 0.0,- 0.342031, -0.58736, -0.7335, 0.0,- 0.57155, 0.7869, 0.232635, 0.0,- 0.885026, -0.408223, 0.223791, 0.0,- -0.789518, 0.571645, 0.223347, 0.0,- 0.774571, 0.31566, 0.548087, 0.0,- -0.79695, -0.0433603, -0.602487, 0.0,- -0.142425, -0.473249, -0.869339, 0.0,- -0.0698838, 0.170442, 0.982886, 0.0,- 0.687815, -0.484748, 0.540306, 0.0,- 0.543703, -0.534446, -0.647112, 0.0,- 0.97186, 0.184391, -0.146588, 0.0,- 0.707084, 0.485713, -0.513921, 0.0,- 0.942302, 0.331945, 0.043348, 0.0,- 0.499084, 0.599922, 0.625307, 0.0,- -0.289203, 0.211107, 0.9337, 0.0,- 0.412433, -0.71667, -0.56239, 0.0,- 0.87721, -0.082816, 0.47291, 0.0,- -0.420685, -0.214278, 0.881538, 0.0,- 0.752558, -0.0391579, 0.657361, 0.0,- 0.0765725, -0.996789, 0.0234082, 0.0,- -0.544312, -0.309435, -0.779727, 0.0,- -0.455358, -0.415572, 0.787368, 0.0,- -0.874586, 0.483746, 0.0330131, 0.0,- 0.245172, -0.0838623, 0.965846, 0.0,- 0.382293, -0.432813, 0.81641, 0.0,- -0.287735, -0.905514, 0.311853, 0.0,- -0.667704, 0.704955, -0.239186, 0.0,- 0.717885, -0.464002, -0.518983, 0.0,- 0.976342, -0.214895, 0.0240053, 0.0,- -0.0733096, -0.921136, 0.382276, 0.0,- -0.986284, 0.151224, -0.0661379, 0.0,- -0.899319, -0.429671, 0.0812908, 0.0,- 0.652102, -0.724625, 0.222893, 0.0,- 0.203761, 0.458023, -0.865272, 0.0,- -0.030396, 0.698724, -0.714745, 0.0,- -0.460232, 0.839138, 0.289887, 0.0,- -0.0898602, 0.837894, 0.538386, 0.0,- -0.731595, 0.0793784, 0.677102, 0.0,- -0.447236, -0.788397, 0.422386, 0.0,- 0.186481, 0.645855, -0.740335, 0.0,- -0.259006, 0.935463, 0.240467, 0.0,- 0.445839, 0.819655, -0.359712, 0.0,- 0.349962, 0.755022, -0.554499, 0.0,- -0.997078, -0.0359577, 0.0673977, 0.0,- -0.431163, -0.147516, -0.890133, 0.0,- 0.299648, -0.63914, 0.708316, 0.0,- 0.397043, 0.566526, -0.722084, 0.0,- -0.502489, 0.438308, -0.745246, 0.0,- 0.0687235, 0.354097, 0.93268, 0.0,- -0.0476651, -0.462597, 0.885286, 0.0,- -0.221934, 0.900739, -0.373383, 0.0,- -0.956107, -0.225676, 0.186893, 0.0,- -0.187627, 0.391487, -0.900852, 0.0,- -0.224209, -0.315405, 0.92209, 0.0,- -0.730807, -0.537068, 0.421283, 0.0,- -0.0353135, -0.816748, 0.575913, 0.0,- -0.941391, 0.176991, -0.287153, 0.0,- -0.154174, 0.390458, 0.90762, 0.0,- -0.283847, 0.533842, 0.796519, 0.0,- -0.482737, -0.850448, 0.209052, 0.0,- -0.649175, 0.477748, 0.591886, 0.0,- 0.885373, -0.405387, -0.227543, 0.0,- -0.147261, 0.181623, -0.972279, 0.0,- 0.0959236, -0.115847, -0.988624, 0.0,- -0.89724, -0.191348, 0.397928, 0.0,- 0.903553, -0.428461, -0.00350461, 0.0,- 0.849072, -0.295807, -0.437693, 0.0,- 0.65551, 0.741754, -0.141804, 0.0,- 0.61598, -0.178669, 0.767232, 0.0,- 0.0112967, 0.932256, -0.361623, 0.0,- -0.793031, 0.258012, 0.551845, 0.0,- 0.421933, 0.454311, 0.784585, 0.0,- -0.319993, 0.0401618, -0.946568, 0.0,- -0.81571, 0.551307, -0.175151, 0.0,- -0.377644, 0.00322313, 0.925945, 0.0,- 0.129759, -0.666581, -0.734052, 0.0,- 0.601901, -0.654237, -0.457919, 0.0,- -0.927463, -0.0343576, -0.372334, 0.0,- -0.438663, -0.868301, -0.231578, 0.0,- -0.648845, -0.749138, -0.133387, 0.0,- 0.507393, -0.588294, 0.629653, 0.0,- 0.726958, 0.623665, 0.287358, 0.0,- 0.411159, 0.367614, -0.834151, 0.0,- 0.806333, 0.585117, -0.0864016, 0.0,- 0.263935, -0.880876, 0.392932, 0.0,- 0.421546, -0.201336, 0.884174, 0.0,- -0.683198, -0.569557, -0.456996, 0.0,- -0.117116, -0.0406654, -0.992285, 0.0,- -0.643679, -0.109196, -0.757465, 0.0,- -0.561559, -0.62989, 0.536554, 0.0,- 0.0628422, 0.104677, -0.992519, 0.0,- 0.480759, -0.2867, -0.828658, 0.0,- -0.228559, -0.228965, -0.946222, 0.0,- -0.10194, -0.65706, -0.746914, 0.0,- 0.0689193, -0.678236, 0.731605, 0.0,- 0.401019, -0.754026, 0.52022, 0.0,- -0.742141, 0.547083, -0.387203, 0.0,- -0.00210603, -0.796417, -0.604745, 0.0,- 0.296725, -0.409909, -0.862513, 0.0,- -0.260932, -0.798201, 0.542945, 0.0,- -0.641628, 0.742379, 0.192838, 0.0,- -0.186009, -0.101514, 0.97729, 0.0,- 0.106711, -0.962067, 0.251079, 0.0,- -0.743499, 0.30988, -0.592607, 0.0,- -0.795853, -0.605066, -0.0226607, 0.0,- -0.828661, -0.419471, -0.370628, 0.0,- 0.0847218, -0.489815, -0.8677, 0.0,- -0.381405, 0.788019, -0.483276, 0.0,- 0.282042, -0.953394, 0.107205, 0.0,- 0.530774, 0.847413, 0.0130696, 0.0,- 0.0515397, 0.922524, 0.382484, 0.0,- -0.631467, -0.709046, 0.313852, 0.0,- 0.688248, 0.517273, 0.508668, 0.0,- 0.646689, -0.333782, -0.685845, 0.0,- -0.932528, -0.247532, -0.262906, 0.0,- 0.630609, 0.68757, -0.359973, 0.0,- 0.577805, -0.394189, 0.714673, 0.0,- -0.887833, -0.437301, -0.14325, 0.0,- 0.690982, 0.174003, 0.701617, 0.0,- -0.866701, 0.0118182, 0.498689, 0.0,- -0.482876, 0.727143, 0.487949, 0.0,- -0.577567, 0.682593, -0.447752, 0.0,- 0.373768, 0.0982991, 0.922299, 0.0,- 0.170744, 0.964243, -0.202687, 0.0,- 0.993654, -0.035791, -0.106632, 0.0,- 0.587065, 0.4143, -0.695493, 0.0,- -0.396509, 0.26509, -0.878924, 0.0,- -0.0866853, 0.83553, -0.542563, 0.0,- 0.923193, 0.133398, -0.360443, 0.0,- 0.00379108, -0.258618, 0.965972, 0.0,- 0.239144, 0.245154, -0.939526, 0.0,- 0.758731, -0.555871, 0.33961, 0.0,- 0.295355, 0.309513, 0.903862, 0.0,- 0.0531222, -0.91003, -0.411124, 0.0,- 0.270452, 0.0229439, -0.96246, 0.0,- 0.563634, 0.0324352, 0.825387, 0.0,- 0.156326, 0.147392, 0.976646, 0.0,- -0.0410141, 0.981824, 0.185309, 0.0,- -0.385562, -0.576343, -0.720535, 0.0,- 0.388281, 0.904441, 0.176702, 0.0,- 0.945561, -0.192859, -0.262146, 0.0,- 0.844504, 0.520193, 0.127325, 0.0,- 0.0330893, 0.999121, -0.0257505, 0.0,- -0.592616, -0.482475, -0.644999, 0.0,- 0.539471, 0.631024, -0.557476, 0.0,- 0.655851, -0.027319, -0.754396, 0.0,- 0.274465, 0.887659, 0.369772, 0.0,- -0.123419, 0.975177, -0.183842, 0.0,- -0.223429, 0.708045, 0.66989, 0.0,- -0.908654, 0.196302, 0.368528, 0.0,- -0.95759, -0.00863708, 0.288005, 0.0,- 0.960535, 0.030592, 0.276472, 0.0,- -0.413146, 0.907537, 0.0754161, 0.0,- -0.847992, 0.350849, -0.397259, 0.0,- 0.614736, 0.395841, 0.68221, 0.0,- -0.503504, -0.666128, -0.550234, 0.0,- -0.268833, -0.738524, -0.618314, 0.0,- 0.792737, -0.60001, -0.107502, 0.0,- -0.637582, 0.508144, -0.579032, 0.0,- 0.750105, 0.282165, -0.598101, 0.0,- -0.351199, -0.392294, -0.850155, 0.0,- 0.250126, -0.960993, -0.118025, 0.0,- -0.732341, 0.680909, -0.0063274, 0.0,- -0.760674, -0.141009, 0.633634, 0.0,- 0.222823, -0.304012, 0.926243, 0.0,- 0.209178, 0.505671, 0.836984, 0.0,- 0.757914, -0.56629, -0.323857, 0.0,- -0.782926, -0.339196, 0.52151, 0.0,- -0.462952, 0.585565, 0.665424, 0.0,- 0.61879, 0.194119, -0.761194, 0.0,- 0.741388, -0.276743, 0.611357, 0.0,- 0.707571, 0.702621, 0.0752872, 0.0,- 0.156562, 0.819977, 0.550569, 0.0,- -0.793606, 0.440216, 0.42, 0.0,- 0.234547, 0.885309, -0.401517, 0.0,- 0.132598, 0.80115, -0.58359, 0.0,- -0.377899, -0.639179, 0.669808, 0.0,- -0.865993, -0.396465, 0.304748, 0.0,- -0.624815, -0.44283, 0.643046, 0.0,- -0.485705, 0.825614, -0.287146, 0.0,- -0.971788, 0.175535, 0.157529, 0.0,- -0.456027, 0.392629, 0.798675, 0.0,- -0.0104443, 0.521623, -0.853112, 0.0,- -0.660575, -0.74519, 0.091282, 0.0,- -0.0157698, -0.307475, -0.951425, 0.0,- -0.603467, -0.250192, 0.757121, 0.0,- 0.506876, 0.25006, 0.824952, 0.0,- 0.255404, 0.966794, 0.00884498, 0.0,- 0.466764, -0.874228, -0.133625, 0.0,- 0.475077, -0.0682351, -0.877295, 0.0,- -0.224967, -0.938972, -0.260233, 0.0,- -0.377929, -0.814757, -0.439705, 0.0,- -0.305847, 0.542333, -0.782517, 0.0,- 0.26658, -0.902905, -0.337191, 0.0,- 0.0275773, 0.322158, -0.946284, 0.0,- 0.0185422, 0.716349, 0.697496, 0.0,- -0.20483, 0.978416, 0.0273371, 0.0,- -0.898276, 0.373969, 0.230752, 0.0,- -0.00909378, 0.546594, 0.837349, 0.0,- 0.6602, -0.751089, 0.000959236, 0.0,- 0.855301, -0.303056, 0.420259, 0.0,- 0.797138, 0.0623013, -0.600574, 0.0,- 0.48947, -0.866813, 0.0951509, 0.0,- 0.251142, 0.674531, 0.694216, 0.0,- -0.578422, -0.737373, -0.348867, 0.0,- -0.254689, -0.514807, 0.818601, 0.0,- 0.374972, 0.761612, 0.528529, 0.0,- 0.640303, -0.734271, -0.225517, 0.0,- -0.638076, 0.285527, 0.715075, 0.0,- 0.772956, -0.15984, -0.613995, 0.0,- 0.798217, -0.590628, 0.118356, 0.0,- -0.986276, -0.0578337, -0.154644, 0.0,- -0.312988, -0.94549, 0.0899272, 0.0,- -0.497338, 0.178325, 0.849032, 0.0,- -0.101136, -0.981014, 0.165477, 0.0,- -0.521688, 0.0553434, -0.851339, 0.0,- -0.786182, -0.583814, 0.202678, 0.0,- -0.565191, 0.821858, -0.0714658, 0.0,- 0.437895, 0.152598, -0.885981, 0.0,- -0.92394, 0.353436, -0.14635, 0.0,- 0.212189, -0.815162, -0.538969, 0.0,- -0.859262, 0.143405, -0.491024, 0.0,- 0.991353, 0.112814, 0.0670273, 0.0,- 0.0337884, -0.979891, -0.196654, 0.0]+-- Copyright (c) 2011, Colin Hill +-- +-- 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(noiseValue), + pmap, + clamp, + coherentNoise +) where + +import Data.Bits +import Data.Vector.Unboxed (Vector, fromList, (!)) + +-- | A point in 3-space. +type Point = (Double, Double, Double) + +-- | A seed for a random function. +type Seed = Int + +-- | Class of noise functions. +class Noise a where + -- | 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) = clamp noise (-1) 1 + where (ox, oy, oz) = (clampToIntRange x, clampToIntRange y, clampToIntRange z) + x0 = floor ox + x1 = x0 + 1 + y0 = floor oy + y1 = y0 + 1 + z0 = floor oz + z1 = z0 + 1 + sx = scurve (ox - fromIntegral x0) + sy = scurve (oy - fromIntegral y0) + 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 + ix1 = lerp sx n2 n3 + ix2 = lerp sx n4 n5 + ix3 = lerp sx n6 n7 + iy0 = 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)) + (ox, oy, oz) = (fx - fromIntegral ix, + fy - fromIntegral iy, + fz - fromIntegral iz) + 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. +lerp :: Double -> Double -> Double -> Double +lerp t a b = (1.0 - t) * a + t * b + +-- | Maps a value onto a quintic s-curve. +scurve :: Double -> Double +scurve a = (6.0 * a5) - (15.0 * a4) + (10.0 * a3) + where a3 = a * a * a + a4 = a3 * a + a5 = a4 * a + +-- | Clamps a 'Double' to the range of an 'Int'. +clampToIntRange :: Double -> Double +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) :: Int) * y + +-- | Table of random normalized vectors. +vectorTable :: Vector Double +vectorTable = fromList [ + -0.763874, -0.596439, -0.246489, 0.0, + 0.396055, 0.904518, -0.158073, 0.0, + -0.499004, -0.8665, -0.0131631, 0.0, + 0.468724, -0.824756, 0.316346, 0.0, + 0.829598, 0.43195, 0.353816, 0.0, + -0.454473, 0.629497, -0.630228, 0.0, + -0.162349, -0.869962, -0.465628, 0.0, + 0.932805, 0.253451, 0.256198, 0.0, + -0.345419, 0.927299, -0.144227, 0.0, + -0.715026, -0.293698, -0.634413, 0.0, + -0.245997, 0.717467, -0.651711, 0.0, + -0.967409, -0.250435, -0.037451, 0.0, + 0.901729, 0.397108, -0.170852, 0.0, + 0.892657, -0.0720622, -0.444938, 0.0, + 0.0260084, -0.0361701, 0.999007, 0.0, + 0.949107, -0.19486, 0.247439, 0.0, + 0.471803, -0.807064, -0.355036, 0.0, + 0.879737, 0.141845, 0.453809, 0.0, + 0.570747, 0.696415, 0.435033, 0.0, + -0.141751, -0.988233, -0.0574584, 0.0, + -0.58219, -0.0303005, 0.812488, 0.0, + -0.60922, 0.239482, -0.755975, 0.0, + 0.299394, -0.197066, -0.933557, 0.0, + -0.851615, -0.220702, -0.47544, 0.0, + 0.848886, 0.341829, -0.403169, 0.0, + -0.156129, -0.687241, 0.709453, 0.0, + -0.665651, 0.626724, 0.405124, 0.0, + 0.595914, -0.674582, 0.43569, 0.0, + 0.171025, -0.509292, 0.843428, 0.0, + 0.78605, 0.536414, -0.307222, 0.0, + 0.18905, -0.791613, 0.581042, 0.0, + -0.294916, 0.844994, 0.446105, 0.0, + 0.342031, -0.58736, -0.7335, 0.0, + 0.57155, 0.7869, 0.232635, 0.0, + 0.885026, -0.408223, 0.223791, 0.0, + -0.789518, 0.571645, 0.223347, 0.0, + 0.774571, 0.31566, 0.548087, 0.0, + -0.79695, -0.0433603, -0.602487, 0.0, + -0.142425, -0.473249, -0.869339, 0.0, + -0.0698838, 0.170442, 0.982886, 0.0, + 0.687815, -0.484748, 0.540306, 0.0, + 0.543703, -0.534446, -0.647112, 0.0, + 0.97186, 0.184391, -0.146588, 0.0, + 0.707084, 0.485713, -0.513921, 0.0, + 0.942302, 0.331945, 0.043348, 0.0, + 0.499084, 0.599922, 0.625307, 0.0, + -0.289203, 0.211107, 0.9337, 0.0, + 0.412433, -0.71667, -0.56239, 0.0, + 0.87721, -0.082816, 0.47291, 0.0, + -0.420685, -0.214278, 0.881538, 0.0, + 0.752558, -0.0391579, 0.657361, 0.0, + 0.0765725, -0.996789, 0.0234082, 0.0, + -0.544312, -0.309435, -0.779727, 0.0, + -0.455358, -0.415572, 0.787368, 0.0, + -0.874586, 0.483746, 0.0330131, 0.0, + 0.245172, -0.0838623, 0.965846, 0.0, + 0.382293, -0.432813, 0.81641, 0.0, + -0.287735, -0.905514, 0.311853, 0.0, + -0.667704, 0.704955, -0.239186, 0.0, + 0.717885, -0.464002, -0.518983, 0.0, + 0.976342, -0.214895, 0.0240053, 0.0, + -0.0733096, -0.921136, 0.382276, 0.0, + -0.986284, 0.151224, -0.0661379, 0.0, + -0.899319, -0.429671, 0.0812908, 0.0, + 0.652102, -0.724625, 0.222893, 0.0, + 0.203761, 0.458023, -0.865272, 0.0, + -0.030396, 0.698724, -0.714745, 0.0, + -0.460232, 0.839138, 0.289887, 0.0, + -0.0898602, 0.837894, 0.538386, 0.0, + -0.731595, 0.0793784, 0.677102, 0.0, + -0.447236, -0.788397, 0.422386, 0.0, + 0.186481, 0.645855, -0.740335, 0.0, + -0.259006, 0.935463, 0.240467, 0.0, + 0.445839, 0.819655, -0.359712, 0.0, + 0.349962, 0.755022, -0.554499, 0.0, + -0.997078, -0.0359577, 0.0673977, 0.0, + -0.431163, -0.147516, -0.890133, 0.0, + 0.299648, -0.63914, 0.708316, 0.0, + 0.397043, 0.566526, -0.722084, 0.0, + -0.502489, 0.438308, -0.745246, 0.0, + 0.0687235, 0.354097, 0.93268, 0.0, + -0.0476651, -0.462597, 0.885286, 0.0, + -0.221934, 0.900739, -0.373383, 0.0, + -0.956107, -0.225676, 0.186893, 0.0, + -0.187627, 0.391487, -0.900852, 0.0, + -0.224209, -0.315405, 0.92209, 0.0, + -0.730807, -0.537068, 0.421283, 0.0, + -0.0353135, -0.816748, 0.575913, 0.0, + -0.941391, 0.176991, -0.287153, 0.0, + -0.154174, 0.390458, 0.90762, 0.0, + -0.283847, 0.533842, 0.796519, 0.0, + -0.482737, -0.850448, 0.209052, 0.0, + -0.649175, 0.477748, 0.591886, 0.0, + 0.885373, -0.405387, -0.227543, 0.0, + -0.147261, 0.181623, -0.972279, 0.0, + 0.0959236, -0.115847, -0.988624, 0.0, + -0.89724, -0.191348, 0.397928, 0.0, + 0.903553, -0.428461, -0.00350461, 0.0, + 0.849072, -0.295807, -0.437693, 0.0, + 0.65551, 0.741754, -0.141804, 0.0, + 0.61598, -0.178669, 0.767232, 0.0, + 0.0112967, 0.932256, -0.361623, 0.0, + -0.793031, 0.258012, 0.551845, 0.0, + 0.421933, 0.454311, 0.784585, 0.0, + -0.319993, 0.0401618, -0.946568, 0.0, + -0.81571, 0.551307, -0.175151, 0.0, + -0.377644, 0.00322313, 0.925945, 0.0, + 0.129759, -0.666581, -0.734052, 0.0, + 0.601901, -0.654237, -0.457919, 0.0, + -0.927463, -0.0343576, -0.372334, 0.0, + -0.438663, -0.868301, -0.231578, 0.0, + -0.648845, -0.749138, -0.133387, 0.0, + 0.507393, -0.588294, 0.629653, 0.0, + 0.726958, 0.623665, 0.287358, 0.0, + 0.411159, 0.367614, -0.834151, 0.0, + 0.806333, 0.585117, -0.0864016, 0.0, + 0.263935, -0.880876, 0.392932, 0.0, + 0.421546, -0.201336, 0.884174, 0.0, + -0.683198, -0.569557, -0.456996, 0.0, + -0.117116, -0.0406654, -0.992285, 0.0, + -0.643679, -0.109196, -0.757465, 0.0, + -0.561559, -0.62989, 0.536554, 0.0, + 0.0628422, 0.104677, -0.992519, 0.0, + 0.480759, -0.2867, -0.828658, 0.0, + -0.228559, -0.228965, -0.946222, 0.0, + -0.10194, -0.65706, -0.746914, 0.0, + 0.0689193, -0.678236, 0.731605, 0.0, + 0.401019, -0.754026, 0.52022, 0.0, + -0.742141, 0.547083, -0.387203, 0.0, + -0.00210603, -0.796417, -0.604745, 0.0, + 0.296725, -0.409909, -0.862513, 0.0, + -0.260932, -0.798201, 0.542945, 0.0, + -0.641628, 0.742379, 0.192838, 0.0, + -0.186009, -0.101514, 0.97729, 0.0, + 0.106711, -0.962067, 0.251079, 0.0, + -0.743499, 0.30988, -0.592607, 0.0, + -0.795853, -0.605066, -0.0226607, 0.0, + -0.828661, -0.419471, -0.370628, 0.0, + 0.0847218, -0.489815, -0.8677, 0.0, + -0.381405, 0.788019, -0.483276, 0.0, + 0.282042, -0.953394, 0.107205, 0.0, + 0.530774, 0.847413, 0.0130696, 0.0, + 0.0515397, 0.922524, 0.382484, 0.0, + -0.631467, -0.709046, 0.313852, 0.0, + 0.688248, 0.517273, 0.508668, 0.0, + 0.646689, -0.333782, -0.685845, 0.0, + -0.932528, -0.247532, -0.262906, 0.0, + 0.630609, 0.68757, -0.359973, 0.0, + 0.577805, -0.394189, 0.714673, 0.0, + -0.887833, -0.437301, -0.14325, 0.0, + 0.690982, 0.174003, 0.701617, 0.0, + -0.866701, 0.0118182, 0.498689, 0.0, + -0.482876, 0.727143, 0.487949, 0.0, + -0.577567, 0.682593, -0.447752, 0.0, + 0.373768, 0.0982991, 0.922299, 0.0, + 0.170744, 0.964243, -0.202687, 0.0, + 0.993654, -0.035791, -0.106632, 0.0, + 0.587065, 0.4143, -0.695493, 0.0, + -0.396509, 0.26509, -0.878924, 0.0, + -0.0866853, 0.83553, -0.542563, 0.0, + 0.923193, 0.133398, -0.360443, 0.0, + 0.00379108, -0.258618, 0.965972, 0.0, + 0.239144, 0.245154, -0.939526, 0.0, + 0.758731, -0.555871, 0.33961, 0.0, + 0.295355, 0.309513, 0.903862, 0.0, + 0.0531222, -0.91003, -0.411124, 0.0, + 0.270452, 0.0229439, -0.96246, 0.0, + 0.563634, 0.0324352, 0.825387, 0.0, + 0.156326, 0.147392, 0.976646, 0.0, + -0.0410141, 0.981824, 0.185309, 0.0, + -0.385562, -0.576343, -0.720535, 0.0, + 0.388281, 0.904441, 0.176702, 0.0, + 0.945561, -0.192859, -0.262146, 0.0, + 0.844504, 0.520193, 0.127325, 0.0, + 0.0330893, 0.999121, -0.0257505, 0.0, + -0.592616, -0.482475, -0.644999, 0.0, + 0.539471, 0.631024, -0.557476, 0.0, + 0.655851, -0.027319, -0.754396, 0.0, + 0.274465, 0.887659, 0.369772, 0.0, + -0.123419, 0.975177, -0.183842, 0.0, + -0.223429, 0.708045, 0.66989, 0.0, + -0.908654, 0.196302, 0.368528, 0.0, + -0.95759, -0.00863708, 0.288005, 0.0, + 0.960535, 0.030592, 0.276472, 0.0, + -0.413146, 0.907537, 0.0754161, 0.0, + -0.847992, 0.350849, -0.397259, 0.0, + 0.614736, 0.395841, 0.68221, 0.0, + -0.503504, -0.666128, -0.550234, 0.0, + -0.268833, -0.738524, -0.618314, 0.0, + 0.792737, -0.60001, -0.107502, 0.0, + -0.637582, 0.508144, -0.579032, 0.0, + 0.750105, 0.282165, -0.598101, 0.0, + -0.351199, -0.392294, -0.850155, 0.0, + 0.250126, -0.960993, -0.118025, 0.0, + -0.732341, 0.680909, -0.0063274, 0.0, + -0.760674, -0.141009, 0.633634, 0.0, + 0.222823, -0.304012, 0.926243, 0.0, + 0.209178, 0.505671, 0.836984, 0.0, + 0.757914, -0.56629, -0.323857, 0.0, + -0.782926, -0.339196, 0.52151, 0.0, + -0.462952, 0.585565, 0.665424, 0.0, + 0.61879, 0.194119, -0.761194, 0.0, + 0.741388, -0.276743, 0.611357, 0.0, + 0.707571, 0.702621, 0.0752872, 0.0, + 0.156562, 0.819977, 0.550569, 0.0, + -0.793606, 0.440216, 0.42, 0.0, + 0.234547, 0.885309, -0.401517, 0.0, + 0.132598, 0.80115, -0.58359, 0.0, + -0.377899, -0.639179, 0.669808, 0.0, + -0.865993, -0.396465, 0.304748, 0.0, + -0.624815, -0.44283, 0.643046, 0.0, + -0.485705, 0.825614, -0.287146, 0.0, + -0.971788, 0.175535, 0.157529, 0.0, + -0.456027, 0.392629, 0.798675, 0.0, + -0.0104443, 0.521623, -0.853112, 0.0, + -0.660575, -0.74519, 0.091282, 0.0, + -0.0157698, -0.307475, -0.951425, 0.0, + -0.603467, -0.250192, 0.757121, 0.0, + 0.506876, 0.25006, 0.824952, 0.0, + 0.255404, 0.966794, 0.00884498, 0.0, + 0.466764, -0.874228, -0.133625, 0.0, + 0.475077, -0.0682351, -0.877295, 0.0, + -0.224967, -0.938972, -0.260233, 0.0, + -0.377929, -0.814757, -0.439705, 0.0, + -0.305847, 0.542333, -0.782517, 0.0, + 0.26658, -0.902905, -0.337191, 0.0, + 0.0275773, 0.322158, -0.946284, 0.0, + 0.0185422, 0.716349, 0.697496, 0.0, + -0.20483, 0.978416, 0.0273371, 0.0, + -0.898276, 0.373969, 0.230752, 0.0, + -0.00909378, 0.546594, 0.837349, 0.0, + 0.6602, -0.751089, 0.000959236, 0.0, + 0.855301, -0.303056, 0.420259, 0.0, + 0.797138, 0.0623013, -0.600574, 0.0, + 0.48947, -0.866813, 0.0951509, 0.0, + 0.251142, 0.674531, 0.694216, 0.0, + -0.578422, -0.737373, -0.348867, 0.0, + -0.254689, -0.514807, 0.818601, 0.0, + 0.374972, 0.761612, 0.528529, 0.0, + 0.640303, -0.734271, -0.225517, 0.0, + -0.638076, 0.285527, 0.715075, 0.0, + 0.772956, -0.15984, -0.613995, 0.0, + 0.798217, -0.590628, 0.118356, 0.0, + -0.986276, -0.0578337, -0.154644, 0.0, + -0.312988, -0.94549, 0.0899272, 0.0, + -0.497338, 0.178325, 0.849032, 0.0, + -0.101136, -0.981014, 0.165477, 0.0, + -0.521688, 0.0553434, -0.851339, 0.0, + -0.786182, -0.583814, 0.202678, 0.0, + -0.565191, 0.821858, -0.0714658, 0.0, + 0.437895, 0.152598, -0.885981, 0.0, + -0.92394, 0.353436, -0.14635, 0.0, + 0.212189, -0.815162, -0.538969, 0.0, + -0.859262, 0.143405, -0.491024, 0.0, + 0.991353, 0.112814, 0.0670273, 0.0, + 0.0337884, -0.979891, -0.196654, 0.0]
src/Numeric/Noise/Perlin.hs view
@@ -1,47 +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,- noiseValue-) where--import Numeric.Noise---- | A Perlin noise function.-data Perlin = Perlin Seed Int Double Double--instance Noise Perlin where- noiseValue perlinNoise xyz = clamp noise (-1) 1- where Perlin _ octs _ _ = perlinNoise- noise = perlinNoiseValue perlinNoise octs 1 1 xyz---- | 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+-- 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, + noiseValue +) where + +import Numeric.Noise + +-- | A Perlin noise function. +data Perlin = Perlin Seed Int Double Double + +instance Noise Perlin where + noiseValue perlinNoise xyz = clamp noise (-1) 1 + where Perlin _ octs _ _ = perlinNoise + noise = perlinNoiseValue perlinNoise octs 1 1 xyz + +-- | 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
src/Numeric/Noise/Random.hs view
@@ -1,53 +1,53 @@--- 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,- shuffle-) where--import Numeric.Noise--import Data.Bits---- | Returns a random 'Int' and the next seed given a seed.-randomInt :: Seed -> (Int, Seed)-randomInt seed = randomInt' seed 0 16---- | Helper for 'randomInt'.-randomInt' :: Int -> Seed -> Int -> (Int, Seed)-randomInt' r seed 0 = (r, seed)-randomInt' r seed n = randomInt' r' seed' (n - 1)- where seed' = 3039177861 * seed + 1- r' = shiftL r 2 + shiftR seed' 30---- | Returns a random sequence of 'Int's given a seed and the number of 'Int's to generate.-randomInts :: Seed -> Int -> [Int]-randomInts _ 0 = []-randomInts seed n = r : randomInts seed' (n - 1)- where (r, seed') = randomInt seed---- | Returns a shuffled list containing the same elements as the given list given a seed.-shuffle :: [a] -> Seed -> [a]-shuffle xs seed = fst (shuffle' xs [] seed)---- | Helper function for 'shuffle'.-shuffle' :: [a] -> [a] -> Seed -> ([a], Seed)-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+-- 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, + shuffle +) where + +import Numeric.Noise + +import Data.Bits + +-- | Returns a random 'Int' and the next seed given a seed. +randomInt :: Seed -> (Int, Seed) +randomInt seed = randomInt' seed 0 16 + +-- | Helper for 'randomInt'. +randomInt' :: Int -> Seed -> Int -> (Int, Seed) +randomInt' r seed 0 = (r, seed) +randomInt' r seed n = randomInt' r' seed' (n - 1) + where seed' = 3039177861 * seed + 1 + r' = shiftL r 2 + shiftR seed' 30 + +-- | Returns a random sequence of 'Int's given a seed and the number of 'Int's to generate. +randomInts :: Seed -> Int -> [Int] +randomInts _ 0 = [] +randomInts seed n = r : randomInts seed' (n - 1) + where (r, seed') = randomInt seed + +-- | Returns a shuffled list containing the same elements as the given list given a seed. +shuffle :: [a] -> Seed -> [a] +shuffle xs seed = fst (shuffle' xs [] seed) + +-- | Helper function for 'shuffle'. +shuffle' :: [a] -> [a] -> Seed -> ([a], Seed) +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
src/Numeric/Noise/Ridged.hs view
@@ -1,71 +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'+-- 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'