module Data.GlomeTexture where
import Data.GlomeVec
import Data.Array.IArray
square_wave :: Flt -> Flt
square_wave x =
let offset = x (fromIntegral (floor x))
in if offset < 0.5 then 0 else 1
triangle_wave :: Flt -> Flt
triangle_wave x =
let offset = x (fromIntegral (floor x))
in if offset < 0.5
then (offset*2)
else (2(offset*2))
sine_wave :: Flt -> Flt
sine_wave x = (sin (x*2*pi))*0.5 + 0.5
lump_wave :: Flt -> Flt
lump_wave x = 1 x*x*x
stripe :: Vec -> (Flt -> Flt) -> (Vec -> Flt)
stripe axis interp =
let len = vlen axis
in
(\pos -> let offset = vdot pos axis
in interp offset)
omega :: Flt -> Flt
omega t_ =
let t = fabs t_
tsqr = t*t
tcube = tsqr*t
in (6)*tcube*tsqr + 15*tcube*t 10*tcube + 1
phi :: Array Int Int
phi = listArray (0,11) [3,0,2,7,4,1,5,11,8,10,9,6]
grad :: Array Int Vec
grad = listArray (0,11)
$ filter (\x -> let l = vlen x in l < 1.5 && l > 1.1)
[Vec x y z | x <- [(1),0,1],
y <- [(1),0,1],
z <- [(1),0,1]]
gamma :: Int -> Int -> Int -> Vec
gamma i j k =
let a = phi!(mod (iabs k) 12)
b = phi!(mod (iabs (j+a)) 12)
c = phi!(mod (iabs (i+b)) 12)
in grad!c
knot :: Int -> Int -> Int -> Vec -> Flt
knot i j k v =
let Vec x y z = v
in (omega x) * (omega y) * (omega z) * (vdot (gamma i j k) v)
intGamma :: Int -> Int -> Int
intGamma i j =
let a = phi!(mod (iabs j) 16)
b = phi!(mod (iabs (i+a)) 16)
in b
turbulence :: Vec -> Int -> Flt
turbulence p 1 = fabs(noise(p))
turbulence p n =
let newp = vscale p 0.5
t = fabs (noise p)
in t + (0.5 * (turbulence newp (n1)))
noise :: Vec -> Flt
noise (Vec x y z) =
let i = floor x
j = floor y
k = floor z
u = x(fromIntegral i)
v = y(fromIntegral j)
w = z(fromIntegral k)
in knot i j k (Vec u v w) +
knot (i+1) j k (Vec (u1) v w) +
knot i (j+1) k (Vec u (v1) w) +
knot i j (k+1) (Vec u v (w1)) +
knot (i+1) (j+1) k (Vec (u1) (v1) w) +
knot (i+1) j (k+1) (Vec (u1) v (w1)) +
knot i (j+1) (k+1) (Vec u (v1) (w1)) +
knot (i+1) (j+1) (k+1) (Vec (u1) (v1) (w1))
perlin :: Vec -> Flt
perlin v =
let p = ((noise v)+1)*0.5
in if p > 1
then error $ "perlin noise error, 1 < " ++ (show p)
else if p < 0
then error $ "perlin noise error, 0 > " ++ (show p)
else p
--untested
perlin_turb :: Vec -> Int -> Flt
perlin_turb v l =
let p = turbulence v l
in if p > 1
then error $ "perlin turbulence error, 1 < " ++ (show p)
else if p < 0
then error $ "perlin turbulence error, 0 > " ++ (show p)
else p