// Perlin Noise 
//
// coherent noise function over 3 dimensions
// (after Ken Perlin)
// 
// from the paper 'Improving Noise'
// uses modified S-curve to correct curvature discontinuity
// uses reduced number of gradients
// 
// realised as SDL function by Mike Andrews 28/6/2004

global_settings{
  assumed_gamma 1
  max_trace_level 20
}

// set up the hashing array
#declare N = 300;
#declare aP = array[N]

#declare C = 0; #while (C < N)
  #declare aP[C] = C;
#declare C = C + 1; #end

#declare S = seed(478696);
#declare C = 0; #while (C < N)
  #declare C2 = floor(rand(S)*N);
  #declare T = aP[C];
  #declare aP[C] = aP[C2];
  #declare aP[C2] = T;
#declare C = C + 1; #end

// hash lookup function
#declare P = function { 
  spline {
    linear_spline
    #declare C = 0; #while (C < (N+N+2))
      C, aP[mod(C,N)],
    #declare C = C + 1; #end
  }
}

#declare SQ2 = sqrt(2);

// gradients lookup function
#declare G = function { 
  spline {
    linear_spline
     0,<-1,-1, 0>/SQ2, 
     1,<-1, 1, 0>/SQ2, 
     2,< 1, 1, 0>/SQ2, 
     3,< 1,-1, 0>/SQ2, 
     4,<-1, 0,-1>/SQ2,
     5,<-1, 0, 1>/SQ2,
     6,< 1, 0, 1>/SQ2,
     7,< 1, 0,-1>/SQ2,
     8,< 0,-1,-1>/SQ2,
     9,< 0,-1, 1>/SQ2,
    10,< 0, 1, 1>/SQ2,
    11,< 0, 1,-1>/SQ2 
  }
}

// modified s-curve: f(0) = 0, f(1) = 1, f(0)' = f(1)' = f(0)" = f(1)" = 0
#declare sCurve = function (_T) { ((6*_T - 15) * _T + 10) * pow(_T,3) }

// linear interpolation function
#declare Lerp   = function (_T,_A,_B) { _A + _T*(_B - _A) }

// integer mod() function - note: returned value has same sign as _B
#declare pMod = function (_A,_B) { floor(((_A/_B)-floor(_A/_B))*_B) }

// mod(_A,1) function - note: always returns +ve value
#declare M1 = function (_A) { _A-floor(_A) }

// 3D hash into gradients array
#declare Hash = function { pMod(P(P(P(x).x+y).x+z).x,12) }

// get value from 3D gradients
#declare AT3 = function (_X,_Y,_Z,_H) { _X*G(_H).x + _Y*G(_H).y + _Z*G(_H).z }

// interpolate x
#declare LX = function (_SX,_X,_Y,_Z,_IX,_IY,_IZ) { Lerp(_SX,AT3(_X,_Y,_Z,Hash(_IX,_IY,_IZ)),AT3(_X-1,_Y,_Z,Hash(_IX+1,_IY,_IZ))) }

// interpolate y
#declare LY = function (_SX,_SY,_X,_Y,_Z,_IX,_IY,_IZ) { Lerp(_SY,LX(_SX,_X,_Y,_Z,_IX,_IY,_IZ),LX(_SX,_X,_Y-1,_Z,_IX,_IY+1,_IZ)) }

// interpolate z
#declare LZ = function (_SX,_SY,_SZ,_X,_Y,_Z,_IX,_IY,_IZ) { Lerp(_SZ,LY(_SX,_SY,_X,_Y,_Z,_IX,_IY,_IZ),LY(_SX,_SY,_X,_Y,_Z-1,_IX,_IY,_IZ+1)) }

// calculate s-curve interpolants
#declare sInterp = function (_X,_Y,_Z,_IX,_IY,_IZ) { LZ(sCurve(_X),sCurve(_Y),sCurve(_Z),_X,_Y,_Z,_IX,_IY,_IZ) }

// the Noise function itself - returns [-1,1]
#declare sNoise2 = function { sInterp(M1(x),M1(y),M1(z),pMod(x,N),pMod(y,N),pMod(z,N)) }


// A small scene to compare this Noise function with the 
// built-in noise generators.

#include "functions.inc"

#declare S = 11;

#declare Surf = texture {
  pigment { rgb 0.8 }
  finish { ambient 0 diffuse 0.3 specular 0.7 brilliance 10 roughness 0.01 reflection {0.6,1} }
}

isosurface {
  function { -S*f_superellipsoid(x/S,y/S,z/S,0.2,0.2) + 0.15*(0.5*sNoise2(x/2,y/2,z/2)+0.5) }
  contained_by { box {-S, S} }
  texture { Surf }
  translate <-S,S,0>
  scale 0.5
  translate <0,0,28>
  no_reflection
}

isosurface {
  function { -S*f_superellipsoid(x/S,y/S,z/S,0.2,0.2) + 0.15*f_noise_generator(x/2,y/2,z/2,3) }
  contained_by { box {-S, S} }
  texture { Surf }
  translate <S,S,0>
  scale 0.5
  translate <0,0,28>
  no_reflection
}

isosurface {
  function { -S*f_superellipsoid(x/S,y/S,z/S,0.2,0.2) + 0.15*f_noise_generator(x/2,y/2,z/2,2) }
  contained_by { box {-S, S} }
  texture { Surf }
  translate <-S,-S,0>
  scale 0.5
  translate <0,0,28>
  no_reflection
}

isosurface {
  function { -S*f_superellipsoid(x/S,y/S,z/S,0.2,0.2) + 0.15*f_noise_generator(x/2,y/2,z/2,1) }
  contained_by { box {-S, S} }
  texture { Surf }
  translate <S,-S,0>
  scale 0.5
  translate <0,0,28>
  no_reflection
}

light_source { <0,0,0> rgb <1,1,.6>*.6 }
light_source { <0,0,-3000> rgb <.6,1,1>*.5 }

#macro vpow(_V,_P) <pow(_V.x,_P),pow(_V.y,_P),pow(_V.z,_P)> #end

#declare BC = <4/7,5.5/7,1>;

sky_sphere { 
  pigment { 
    planar 
    colour_map {
      [0 rgb 0.3*vpow(BC,4)]
      [1 rgb 0.7*BC]
    } 
  } 
}

sphere { 
  0, 7 
  pigment { 
    bozo
    colour_map {
      [0 rgb 0.7*vpow(BC,4)]
      [0.5 rgb 0.3]
      [1 rgb 0.7*(1-vpow(BC,4))]
    } 
  }
  scale 1000
  no_image
  no_shadow
  hollow 
}