added a perlin noise generator

ike/Readme.md

@@ -63,6 +63,7 @@ iKe extends the basic k5 intrinsics `sin` `cos` `log` and `exp` with a broader r
 - `asin`: monadic. inverse sine.
 - `atan`: monadic. inverse tangent.
 - `atan2`: dyadic. version of arctangent which disambiguates quadrants.
+- `pn`: triadic. 3d Perlin Noise generator.
 
 Variables
 ---------

ike/examples/eyes.k

@@ -6,8 +6,8 @@ ep: 4 3@cir[10]
 
 a1:   0
 a2:   0
-mm:   {a1:: atan2[y-70;x-50]
-       a2:: atan2[y-70;x-90]}
+mm:   {a1:: atan2[y-80;x- 60]
+       a2:: atan2[y-80;x-100]}
 
 draw: {(( 40 60;cga;ew)
         ( 80 60;cga;ew)

ike/examples/plasma.k

@@ -0,0 +1,5 @@
+/ perlin plasma
+
+size: 30
+grid: t{x,y}\:/:t:(!size)%10
+draw: {,(;solarized;_8*pn[f%50].''grid)}

ike/ike.html

@@ -145,6 +145,7 @@
 <script src="../oK.js"></script>
 <script src="../convert.js"></script>
 <script src="text.js"></script>
+<script src="noise.js"></script>
 <script>
 
 // install extended math/utility functions in oK:
@@ -155,16 +156,17 @@
 natives["asin"] = 0;
 natives["atan"] = 0;
 
-var dtramp = function(env, name, dyad) {
-	// construct a dyadic function-wrapper trampoline for a pseudonative.
-	// this permits dyadic extension functions to be properly curryable.
-	env.put(name, true, {t: 5, args:["x","y"], v: [
-		{"t":8,"v":name,"curry":[{"t":7,"v":"x"},{"t":7,"v":"y"}]}
-	]});
+var trampoline = function(env, name, args, body) {
+	// construct a function-wrapper trampoline for a pseudonative.
+	// this permits dyadic/triadic extension functions to be properly curryable.
+	var arguse = []; for(var z=0; z<args.length; z++) { arguse.push({"t":7, "v":args[z]}); }
+	env.put(name, true, {t: 5, args:args, v: [ {"t":8,"v":name,"curry":arguse} ]});
 }
 
 var katan2 = function(x, y) { return k(0, Math.atan2(n(x).v, n(y).v)); }
-verbs["atan2"] = [null, null, ad(katan2), ad(katan2), ad(katan2), ad(katan2), null, null];
+var knoise = function(a)    { return k(0, perlinnoise(n(a[0]).v, n(a[1]).v, n(a[2]).v)); }
+verbs["atan2"] = [null, null, ad(katan2), ad(katan2), ad(katan2), ad(katan2), null,   null];
+verbs["pn"   ] = [null, null, null,       null,       null,       null,       knoise, null];
 
 function extendedEnv() {
 	var env = baseEnv();
@@ -173,7 +175,8 @@
 	env.put("acos", true, k(13, am(function(x) { return k(0, Math.acos(n(x).v)) })));
 	env.put("asin", true, k(13, am(function(x) { return k(0, Math.asin(n(x).v)) })));
 	env.put("atan", true, k(13, am(function(x) { return k(0, Math.atan(n(x).v)) })));
-	dtramp(env, "atan2", katan2);
+	trampoline(env, "atan2", ["x", "y"],      katan2);
+	trampoline(env, "pn"   , ["x", "y", "z"], knoise);
 	return env;
 }
 

ike/noise.js

@@ -0,0 +1,48 @@
+
+// 3d Perlin noise
+
+// unfold two copies of a permutation array, for easy cyclic indexing.
+// most implementations hardcode this table, but it's easy to generate with K:
+var pp = tojs(run(parse("512#<?256"), baseEnv()));
+
+function perlinnoise(x, y, z) {
+	// find unit cube that contains point:
+	var X = Math.floor(x) & 255;
+	var Y = Math.floor(y) & 255;
+	var Z = Math.floor(z) & 255;
+
+	// find relative x/y/z of point in cube:
+	x -= Math.floor(x);
+	y -= Math.floor(y);
+	z -= Math.floor(z);
+
+	// compute fade curves for x/y/z:
+	function fade(t) { return t * t * t * (t * (t * 6 - 15) + 10); }
+	var u = fade(x);
+	var v = fade(y);
+	var w = fade(z);
+
+	// hash coordinates of the 8 cube corners:
+	var A = pp[X  ]+Y, AA = pp[A]+Z, AB = pp[A+1]+Z;
+	var B = pp[X+1]+Y, BA = pp[B]+Z, BB = pp[B+1]+Z;
+
+	// and add blended results from 8 corners of the cube:
+	function scale(n)      { return (1 + n)/2; }
+	function lerp(t, a, b) { return a + t * (b - a); }
+	function grad(hash, x, y, z) {
+		// convert low 4 bits of hashcode into 12 gradient directions:
+		var h = hash & 15;
+		var u = h<8 ? x : y;
+		var v = h<4 ? y : h==12||h==14 ? x : z;
+		return ((h&1) == 0 ? u : -u) + ((h&2) == 0 ? v : -v);
+	}	
+
+	return scale(lerp(w, lerp(v, lerp(u, grad(pp[AA  ], x  , y  , z   ),
+										 grad(pp[BA  ], x-1, y  , z   )),
+								 lerp(u, grad(pp[AB  ], x  , y-1, z   ),
+										 grad(pp[BB  ], x-1, y-1, z   ))),
+						 lerp(v, lerp(u, grad(pp[AA+1], x  , y  , z-1 ),
+										 grad(pp[BA+1], x-1, y  , z-1 )),
+								 lerp(u, grad(pp[AB+1], x  , y-1, z-1 ),
+										 grad(pp[BB+1], x-1, y-1, z-1 )))));
+}