Hi monks,
I've been growing an interest for computer graphics lately, and most especially for proceduraly generated landscapes (the kind of stuff we can see in open-world or sandbox games). So while educating myself on this subject I learnt a few things about noise, and I learnt about the so-called Perlin noise, which was invented in the eighties or something. In 2002, Perlin improved his algorithm by using a better tesselation of space. It's called the Simplex noise and it's discussed and explained by Stefan Gustavson in this document, while providing a java implementation in public domain.
Well, I don't like java so I wanted to translate it into Perl. I've done it for the 2D dimension, and I thought it was worth sharing with you monks. I'll certainly translate the rest (3D and 4D) later. I will almost certainly write a Perl 6 version as well.
I also added a few lines to create a noise image in PGM format. Here is the result:
http://imgur.com/ArVvBvN
And here is the code (the original java code is in the __END__)
package SimplexNoise;
# see __END__ for credits
use strict;
use warnings;
my @grad3 = (
[1, 1, 0], [-1, 1, 0], [1, -1, 0], [-1, -1, 0],
[1, 0, 1], [-1, 0, 1], [1, 0, -1], [-1, 0, -1],
[0, 1, 1], [0, -1, 1], [0, 1, -1], [0, -1, -1],
);
my @grad4 = (
[0, 1, 1, 1], [0, 1, 1, -1], [0, 1, -1, 1], [0, 1, -1, -1],
[0, -1, 1, 1], [0, -1, 1, -1], [0, -1, -1, 1], [0, -1, -1, -1],
[1, 0, 1, 1], [1, 0, 1, -1], [1, 0, -1, 1], [1, 0, -1, -1],
[-1, 0, 1, 1], [-1, 0, 1, -1], [-1, 0, -1, 1], [-1, 0, -1, -1],
[1, 1, 0, 1], [1, 1, 0, -1], [1, -1, 0, 1], [1, -1, 0, -1],
[-1, 1, 0, 1], [-1, 1, 0, -1], [-1, -1, 0, 1], [-1, -1, 0, -1],
[1, 1, 1, 0], [1, 1, -1, 0], [1, -1, 1, 0], [1, -1, -1, 0],
[-1, 1, 1, 0], [-1, 1, -1, 0], [-1, -1, 1, 0], [-1, -1, -1, 0],
);
use constant p => qw(151 160 137 91 90 15 131 13 201 95 96 53 194 233
+7 225
140 36 103 30 69 142 8 99 37 240 21 10 23 190 6 148 247 120 234 75 0 2
+6 197 62
94 252 219 203 117 35 11 32 57 177 33 88 237 149 56 87 174 20 125 136
+171 168
68 175 74 165 71 134 139 48 27 166 77 146 158 231 83 111 229 122 60 21
+1 133 230
220 105 92 41 55 46 245 40 244 102 143 54 65 25 63 161 1 216 80 73 209
+ 76 132
187 208 89 18 169 200 196 135 130 116 188 159 86 164 100 109 198 173 1
+86 3 64
52 217 226 250 124 123 5 202 38 147 118 126 255 82 85 212 207 206 59 2
+27 47 16
58 17 182 189 28 42 223 183 170 213 119 248 152 2 44 154 163 70 221 15
+3 101 155
167 43 172 9 129 22 39 253 19 98 108 110 79 113 224 232 178 185 112 10
+4 218 246
97 228 251 34 242 193 238 210 144 12 191 179 162 241 81 51 145 235 249
+ 14 239
107 49 192 214 31 181 199 106 157 184 84 204 176 115 121 50 45 127 4 1
+50 254
138 236 205 93 222 114 67 29 24 72 243 141 128 195 78 66 215 61 156 18
+0);
use constant perm => (p, p);
use constant permMod12 => map { $_ % 12 } perm;
# Skewing and unskewing factors for 2, 3, and 4 dimensions
use constant {
F2 => 0.5 * (sqrt(3.0) - 1.0),
G2 => (3.0 - sqrt(3.0)) / 6.0,
F3 => 1.0 / 3.0,
G3 => 1.0 / 6.0,
F4 => (sqrt(5.0) - 1.0) / 4.0,
G4 => (5.0 - sqrt(5.0)) / 20.0,
};
sub floor {
my $x = shift;
my $xi = int($x);
return $x < $xi ? $xi - 1 : $xi;
}
sub dot {
my @grad = @{shift()};
my $sum = 0;
$sum += $_ * shift @grad for @_;
$sum;
}
sub noise {
if (@_ == 2) {
# 2D noise
my ($n0, $n1, $n2);
my ($xin, $yin) = @_;
my $s = ($xin + $yin) * F2;
my ($i, $j) = map { floor($_) } $xin + $s, $yin + $s;
my $t = ($i + $j) * G2;
my ($X0, $Y0) = ($i - $t, $j - $t);
my ($x0, $y0) = ($xin - $X0, $yin - $Y0);
my ($i1, $j1) = $x0 > $y0 ? (1, 0) : (0, 1);
my ($x1, $y1) = ($x0 - $i1 + G2, $y0 - $j1 + G2);
my ($x2, $y2) = ($x0 - 1 + 2 * G2, $y0 - 1 + 2 * G2);
my ($ii, $jj) = ($i & 255, $j & 255);
my ($gi0, $gi1, $gi2) = (permMod12)[
$ii + (perm)[$jj],
$ii + $i1 + (perm)[$jj + $j1],
$ii + 1 + (perm)[$jj + 1]
];
my $t0 = 0.5 - $x0 * $x0 - $y0 * $y0;
if ($t0 < 0) { $n0 = 0 }
else {
$t0 *= $t0;
$n0 = $t0 * $t0 * dot($grad3[$gi0], $x0, $y0);
}
my $t1 = 0.5 - $x1 * $x1 - $y1 * $y1;
if ($t1 < 0) { $n1 = 0 }
else {
$t1 *= $t1;
$n1 = $t1 * $t1 * dot($grad3[$gi1], $x1, $y1);
}
my $t2 = 0.5 - $x2 * $x2 - $y2 * $y2;
if ($t2 < 0) { $n2 = 0 }
else {
$t2 *= $t2;
$n2 = $t2 * $t2 * dot($grad3[$gi2], $x2, $y2);
}
return 70 * ($n0 + $n1 + $n2);
} elsif (@_ == 3) {
# 3D noise
...
} elsif (@_ == 4) {
# 4D noise
...
} else {...}
}
my $N = 256;
print "P2\n";
print "$N $N\n";
print "255\n";
for my $i (1 .. $N) {
my $x = $i / 10;
for my $j (1 .. $N) {
my $y = $j / 10;
my $noise = noise $x, $y;
print int(($noise + 1) / 2 * 256);
print $j == $N ? "\n" : ' ';
}
}
__END__
=pod
=begin java
/*
* A speed-improved simplex noise algorithm for 2D, 3D and 4D in J
+ava.
*
* Based on example code by Stefan Gustavson (stegu@itn.liu.se).
* Optimisations by Peter Eastman (peastman@drizzle.stanford.edu).
* Better rank ordering method by Stefan Gustavson in 2012.
*
* This could be speeded up even further, but it's useful as it is
+.
*
* Version 2012-03-09
*
* This code was placed in the public domain by its original autho
+r,
* Stefan Gustavson. You may use it as you see fit, but
* attribution is appreciated.
*
*/
public class SimplexNoise { // Simplex noise in 2D, 3D and 4D
private static Grad grad3[] = {new Grad(1,1,0),new Grad(-1,1,0),
+new Grad(1,-1,0),new Grad(-1,-1,0),
new Grad(1,0,1),new Grad(-1,0,1),new Grad(1,0,-1)
+,new Grad(-1,0,-1),
new Grad(0,1,1),new Grad(0,-1,1),new Grad(0,1,-1)
+,new Grad(0,-1,-1)};
private static Grad grad4[]= {new Grad(0,1,1,1),new Grad(0,1,1,-
+1),new Grad(0,1,-1,1),new Grad(0,1,-1,-1),
new Grad(0,-1,1,1),new Grad(0,-1,1,-1),new Grad(0,-1,-1
+,1),new Grad(0,-1,-1,-1),
new Grad(1,0,1,1),new Grad(1,0,1,-1),new Grad(1,0,-1,1)
+,new Grad(1,0,-1,-1),
new Grad(-1,0,1,1),new Grad(-1,0,1,-1),new Grad(-1,0,-1
+,1),new Grad(-1,0,-1,-1),
new Grad(1,1,0,1),new Grad(1,1,0,-1),new Grad(1,-1,0,1)
+,new Grad(1,-1,0,-1),
new Grad(-1,1,0,1),new Grad(-1,1,0,-1),new Grad(-1,-1,0
+,1),new Grad(-1,-1,0,-1),
new Grad(1,1,1,0),new Grad(1,1,-1,0),new Grad(1,-1,1,0)
+,new Grad(1,-1,-1,0),
new Grad(-1,1,1,0),new Grad(-1,1,-1,0),new Grad(-1,-1,1
+,0),new Grad(-1,-1,-1,0)};
private static short p[] = {151,160,137,91,90,15,
131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,2
+40,21,10,23,
190, 6,148,247,120,234,75,0,26,197,62,94,252,219,203,117,35,11,3
+2,57,177,33,
88,237,149,56,87,174,20,125,136,171,168, 68,175,74,165,71,134,13
+9,48,27,166,
77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46
+,245,40,244,
102,143,54, 65,25,63,161, 1,216,80,73,209,76,132,187,208, 89,18,
+169,200,196,
135,130,116,188,159,86,164,100,109,198,173,186, 3,64,52,217,226,
+250,124,123,
5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,18
+2,189,28,42,
223,183,170,213,119,248,152, 2,44,154,163, 70,221,153,101,155,16
+7, 43,172,9,
129,22,39,253, 19,98,108,110,79,113,224,232,178,185, 112,104,218
+,246,97,228,
251,34,242,193,238,210,144,12,191,179,162,241, 81,51,145,235,249
+,14,239,107,
49,192,214, 31,181,199,106,157,184, 84,204,176,115,121,50,45,127
+, 4,150,254,
138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,
+156,180};
// To remove the need for index wrapping, double the permutation
+ table length
private static short perm[] = new short[512];
private static short permMod12[] = new short[512];
static {
for(int i=0; i<512; i++)
{
perm[i]=p[i & 255];
permMod12[i] = (short)(perm[i] % 12);
}
}
// Skewing and unskewing factors for 2, 3, and 4 dimensions
private static final double F2 = 0.5*(Math.sqrt(3.0)-1.0);
private static final double G2 = (3.0-Math.sqrt(3.0))/6.0;
private static final double F3 = 1.0/3.0;
private static final double G3 = 1.0/6.0;
private static final double F4 = (Math.sqrt(5.0)-1.0)/4.0;
private static final double G4 = (5.0-Math.sqrt(5.0))/20.0;
// This method is a *lot* faster than using (int)Math.floor(x)
private static int fastfloor(double x) {
int xi = (int)x;
return x<xi ? xi-1 : xi;
}
private static double dot(Grad g, double x, double y) {
return g.x*x + g.y*y; }
private static double dot(Grad g, double x, double y, double z)
+{
return g.x*x + g.y*y + g.z*z; }
private static double dot(Grad g, double x, double y, double z,
+double w) {
return g.x*x + g.y*y + g.z*z + g.w*w; }
// 2D simplex noise
public static double noise(double xin, double yin) {
double n0, n1, n2; // Noise contributions from the three corners
// Skew the input space to determine which simplex cell we're in
double s = (xin+yin)*F2; // Hairy factor for 2D
int i = fastfloor(xin+s);
int j = fastfloor(yin+s);
double t = (i+j)*G2;
double X0 = i-t; // Unskew the cell origin back to (x,y) space
double Y0 = j-t;
double x0 = xin-X0; // The x,y distances from the cell origin
double y0 = yin-Y0;
// For the 2D case, the simplex shape is an equilateral triangle.
// Determine which simplex we are in.
int i1, j1; // Offsets for second (middle) corner of simplex in (i
+,j) coords
if(x0>y0) {i1=1; j1=0;} // lower triangle, XY order: (0,0)->(1,0)-
+>(1,1)
else {i1=0; j1=1;} // upper triangle, YX order: (0,0)->(0,1)-
+>(1,1)
// A step of (1,0) in (i,j) means a step of (1-c,-c) in (x,y), and
// a step of (0,1) in (i,j) means a step of (-c,1-c) in (x,y), whe
+re
// c = (3-sqrt(3))/6
double x1 = x0 - i1 + G2; // Offsets for middle corner in (x,y) un
+skewed coords
double y1 = y0 - j1 + G2;
double x2 = x0 - 1.0 + 2.0 * G2; // Offsets for last corner in (x,
+y) unskewed coords
double y2 = y0 - 1.0 + 2.0 * G2;
// Work out the hashed gradient indices of the three simplex corne
+rs
int ii = i & 255;
int jj = j & 255;
int gi0 = permMod12[ii+perm[jj]];
int gi1 = permMod12[ii+i1+perm[jj+j1]];
int gi2 = permMod12[ii+1+perm[jj+1]];
// Calculate the contribution from the three corners
double t0 = 0.5 - x0*x0-y0*y0;
if(t0<0) n0 = 0.0;
else {
t0 *= t0;
n0 = t0 * t0 * dot(grad3[gi0], x0, y0); // (x,y) of grad3 used
+for 2D gradient
}
double t1 = 0.5 - x1*x1-y1*y1;
if(t1<0) n1 = 0.0;
else {
t1 *= t1;
n1 = t1 * t1 * dot(grad3[gi1], x1, y1);
}
double t2 = 0.5 - x2*x2-y2*y2;
if(t2<0) n2 = 0.0;
else {
t2 *= t2;
n2 = t2 * t2 * dot(grad3[gi2], x2, y2);
}
// Add contributions from each corner to get the final noise value
+.
// The result is scaled to return values in the interval [-1,1].
return 70.0 * (n0 + n1 + n2);
}
// 3D simplex noise
public static double noise(double xin, double yin, double zin) {
double n0, n1, n2, n3; // Noise contributions from the four corner
+s
// Skew the input space to determine which simplex cell we're in
double s = (xin+yin+zin)*F3; // Very nice and simple skew factor f
+or 3D
int i = fastfloor(xin+s);
int j = fastfloor(yin+s);
int k = fastfloor(zin+s);
double t = (i+j+k)*G3;
double X0 = i-t; // Unskew the cell origin back to (x,y,z) space
double Y0 = j-t;
double Z0 = k-t;
double x0 = xin-X0; // The x,y,z distances from the cell origin
double y0 = yin-Y0;
double z0 = zin-Z0;
// For the 3D case, the simplex shape is a slightly irregular tetr
+ahedron.
// Determine which simplex we are in.
int i1, j1, k1; // Offsets for second corner of simplex in (i,j,k)
+ coords
int i2, j2, k2; // Offsets for third corner of simplex in (i,j,k)
+coords
if(x0>=y0) {
if(y0>=z0)
{ i1=1; j1=0; k1=0; i2=1; j2=1; k2=0; } // X Y Z order
else if(x0>=z0) { i1=1; j1=0; k1=0; i2=1; j2=0; k2=1; } // X Z
+ Y order
else { i1=0; j1=0; k1=1; i2=1; j2=0; k2=1; } // Z X Y order
}
else { // x0<y0
if(y0<z0) { i1=0; j1=0; k1=1; i2=0; j2=1; k2=1; } // Z Y X order
else if(x0<z0) { i1=0; j1=1; k1=0; i2=0; j2=1; k2=1; } // Y Z X
+order
else { i1=0; j1=1; k1=0; i2=1; j2=1; k2=0; } // Y X Z order
}
// A step of (1,0,0) in (i,j,k) means a step of (1-c,-c,-c) in (x,
+y,z),
// a step of (0,1,0) in (i,j,k) means a step of (-c,1-c,-c) in (x,
+y,z), and
// a step of (0,0,1) in (i,j,k) means a step of (-c,-c,1-c) in (x,
+y,z), where
// c = 1/6.
double x1 = x0 - i1 + G3; // Offsets for second corner in (x,y,z)
+coords
double y1 = y0 - j1 + G3;
double z1 = z0 - k1 + G3;
double x2 = x0 - i2 + 2.0*G3; // Offsets for third corner in (x,y,
+z) coords
double y2 = y0 - j2 + 2.0*G3;
double z2 = z0 - k2 + 2.0*G3;
double x3 = x0 - 1.0 + 3.0*G3; // Offsets for last corner in (x,y,
+z) coords
double y3 = y0 - 1.0 + 3.0*G3;
double z3 = z0 - 1.0 + 3.0*G3;
// Work out the hashed gradient indices of the four simplex corner
+s
int ii = i & 255;
int jj = j & 255;
int kk = k & 255;
int gi0 = permMod12[ii+perm[jj+perm[kk]]];
int gi1 = permMod12[ii+i1+perm[jj+j1+perm[kk+k1]]];
int gi2 = permMod12[ii+i2+perm[jj+j2+perm[kk+k2]]];
int gi3 = permMod12[ii+1+perm[jj+1+perm[kk+1]]];
// Calculate the contribution from the four corners
double t0 = 0.6 - x0*x0 - y0*y0 - z0*z0;
if(t0<0) n0 = 0.0;
else {
t0 *= t0;
n0 = t0 * t0 * dot(grad3[gi0], x0, y0, z0);
}
double t1 = 0.6 - x1*x1 - y1*y1 - z1*z1;
if(t1<0) n1 = 0.0;
else {
t1 *= t1;
n1 = t1 * t1 * dot(grad3[gi1], x1, y1, z1);
}
double t2 = 0.6 - x2*x2 - y2*y2 - z2*z2;
if(t2<0) n2 = 0.0;
else {
t2 *= t2;
n2 = t2 * t2 * dot(grad3[gi2], x2, y2, z2);
}
double t3 = 0.6 - x3*x3 - y3*y3 - z3*z3;
if(t3<0) n3 = 0.0;
else {
t3 *= t3;
n3 = t3 * t3 * dot(grad3[gi3], x3, y3, z3);
}
// Add contributions from each corner to get the final noise value
+.
// The result is scaled to stay just inside [-1,1]
return 32.0*(n0 + n1 + n2 + n3);
}
// 4D simplex noise, better simplex rank ordering method 2012-03
+-09
public static double noise(double x, double y, double z, double
+w) {
double n0, n1, n2, n3, n4; // Noise contributions from the five co
+rners
// Skew the (x,y,z,w) space to determine which cell of 24 simplice
+s we're in
double s = (x + y + z + w) * F4; // Factor for 4D skewing
int i = fastfloor(x + s);
int j = fastfloor(y + s);
int k = fastfloor(z + s);
int l = fastfloor(w + s);
double t = (i + j + k + l) * G4; // Factor for 4D unskewing
double X0 = i - t; // Unskew the cell origin back to (x,y,z,w) spa
+ce
double Y0 = j - t;
double Z0 = k - t;
double W0 = l - t;
double x0 = x - X0; // The x,y,z,w distances from the cell origin
double y0 = y - Y0;
double z0 = z - Z0;
double w0 = w - W0;
// For the 4D case, the simplex is a 4D shape I won't even try to
+describe.
// To find out which of the 24 possible simplices we're in, we nee
+d to
// determine the magnitude ordering of x0, y0, z0 and w0.
// Six pair-wise comparisons are performed between each possible p
+air
// of the four coordinates, and the results are used to rank the n
+umbers.
int rankx = 0;
int ranky = 0;
int rankz = 0;
int rankw = 0;
if(x0 > y0) rankx++; else ranky++;
if(x0 > z0) rankx++; else rankz++;
if(x0 > w0) rankx++; else rankw++;
if(y0 > z0) ranky++; else rankz++;
if(y0 > w0) ranky++; else rankw++;
if(z0 > w0) rankz++; else rankw++;
int i1, j1, k1, l1; // The integer offsets for the second simplex
+corner
int i2, j2, k2, l2; // The integer offsets for the third simplex c
+orner
int i3, j3, k3, l3; // The integer offsets for the fourth simplex
+corner
// simplex[c] is a 4-vector with the numbers 0, 1, 2 and 3 in some
+ order.
// Many values of c will never occur, since e.g. x>y>z>w makes x<z
+, y<w and x<w
// impossible. Only the 24 indices which have non-zero entries mak
+e any sense.
// We use a thresholding to set the coordinates in turn from the l
+argest magnitude.
// Rank 3 denotes the largest coordinate.
i1 = rankx >= 3 ? 1 : 0;
j1 = ranky >= 3 ? 1 : 0;
k1 = rankz >= 3 ? 1 : 0;
l1 = rankw >= 3 ? 1 : 0;
// Rank 2 denotes the second largest coordinate.
i2 = rankx >= 2 ? 1 : 0;
j2 = ranky >= 2 ? 1 : 0;
k2 = rankz >= 2 ? 1 : 0;
l2 = rankw >= 2 ? 1 : 0;
// Rank 1 denotes the second smallest coordinate.
i3 = rankx >= 1 ? 1 : 0;
j3 = ranky >= 1 ? 1 : 0;
k3 = rankz >= 1 ? 1 : 0;
l3 = rankw >= 1 ? 1 : 0;
// The fifth corner has all coordinate offsets = 1, so no need to
+compute that.
double x1 = x0 - i1 + G4; // Offsets for second corner in (x,y,z,w
+) coords
double y1 = y0 - j1 + G4;
double z1 = z0 - k1 + G4;
double w1 = w0 - l1 + G4;
double x2 = x0 - i2 + 2.0*G4; // Offsets for third corner in (x,y,
+z,w) coords
double y2 = y0 - j2 + 2.0*G4;
double z2 = z0 - k2 + 2.0*G4;
double w2 = w0 - l2 + 2.0*G4;
double x3 = x0 - i3 + 3.0*G4; // Offsets for fourth corner in (x,y
+,z,w) coords
double y3 = y0 - j3 + 3.0*G4;
double z3 = z0 - k3 + 3.0*G4;
double w3 = w0 - l3 + 3.0*G4;
double x4 = x0 - 1.0 + 4.0*G4; // Offsets for last corner in (x,y,
+z,w) coords
double y4 = y0 - 1.0 + 4.0*G4;
double z4 = z0 - 1.0 + 4.0*G4;
double w4 = w0 - 1.0 + 4.0*G4;
// Work out the hashed gradient indices of the five simplex corner
+s
int ii = i & 255;
int jj = j & 255;
int kk = k & 255;
int ll = l & 255;
int gi0 = perm[ii+perm[jj+perm[kk+perm[ll]]]] % 32;
int gi1 = perm[ii+i1+perm[jj+j1+perm[kk+k1+perm[ll+l1]]]] % 32;
int gi2 = perm[ii+i2+perm[jj+j2+perm[kk+k2+perm[ll+l2]]]] % 32;
int gi3 = perm[ii+i3+perm[jj+j3+perm[kk+k3+perm[ll+l3]]]] % 32;
int gi4 = perm[ii+1+perm[jj+1+perm[kk+1+perm[ll+1]]]] % 32;
// Calculate the contribution from the five corners
double t0 = 0.6 - x0*x0 - y0*y0 - z0*z0 - w0*w0;
if(t0<0) n0 = 0.0;
else {
t0 *= t0;
n0 = t0 * t0 * dot(grad4[gi0], x0, y0, z0, w0);
}
double t1 = 0.6 - x1*x1 - y1*y1 - z1*z1 - w1*w1;
if(t1<0) n1 = 0.0;
else {
t1 *= t1;
n1 = t1 * t1 * dot(grad4[gi1], x1, y1, z1, w1);
}
double t2 = 0.6 - x2*x2 - y2*y2 - z2*z2 - w2*w2;
if(t2<0) n2 = 0.0;
else {
t2 *= t2;
n2 = t2 * t2 * dot(grad4[gi2], x2, y2, z2, w2);
}
double t3 = 0.6 - x3*x3 - y3*y3 - z3*z3 - w3*w3;
if(t3<0) n3 = 0.0;
else {
t3 *= t3;
n3 = t3 * t3 * dot(grad4[gi3], x3, y3, z3, w3);
}
double t4 = 0.6 - x4*x4 - y4*y4 - z4*z4 - w4*w4;
if(t4<0) n4 = 0.0;
else {
t4 *= t4;
n4 = t4 * t4 * dot(grad4[gi4], x4, y4, z4, w4);
}
// Sum up and scale the result to cover the range [-1,1]
return 27.0 * (n0 + n1 + n2 + n3 + n4);
}
// Inner class to speed upp gradient computations
// (array access is a lot slower than member access)
private static class Grad
{
double x, y, z, w;
Grad(double x, double y, double z)
{
this.x = x;
this.y = y;
this.z = z;
}
Grad(double x, double y, double z, double w)
{
this.x = x;
this.y = y;
this.z = z;
this.w = w;
}
}
}
=end java
=cut
|
Re: Translating simplex noise code from java to perl
by zentara (Archbishop) on Mar 04, 2014 at 11:54 UTC
|
Wow, all I can say is that is as beautiful as the Mona Lisa. You said you had an few lines of code, which outputs the graphic? Can you post it, please?I am interested in background noise, as it supposedly clears the mind as you sleep. :-)
My quarters sounds like a rocket flying thru deep space ... always in the background. :-) Full cruising speed ahead!!
| [reply] |
|
|
The code which outputs the graphics is in what I posted (the part which begins with print "P2\n"). Just run it and you'll get a noise image on stdout in ASCII.
To display it, you can use Image magick for instance.
$ perl SimplexNoise.pm |display -
| [reply]
[d/l] |
Re: Translating simplex noise code from java to perl
by SuicideJunkie (Vicar) on Mar 13, 2014 at 20:59 UTC
|
I've looked at this a bit, with an eye to making it handle higher dimensions, and one of the easy changes is that the F and G constants can be simplified and extended:
Playing around with 2D noise, stacking noise on multiple scales makes for really interesting pictures. I've tacked on a BMP output function to keep it all self-contained.
Example picture: http://imgur.com/aD6cQZ9
Image generation and BMP saving code below:
| [reply]
[d/l]
[select] |
|
|
Finally got it all working the same as the original!
It works at multiple dimensions, although I don't know what the magic scaling factors should be for 1 dimension or 5+
| [reply]
[d/l] |
|
|
Here's the code I wrote (as a result of the discussion in my thread: Randomly biased, random numbers.), to implement the Improved Perlin Noise algorithm. It also runs it with various scales to produce finer and finer detail:
#! perl -slw
use strict;
use Data::Dump qw[ pp ]; $Data::Dump::WIDTH = 1e3;
use List::Util qw[ min max ];
use GD;
use constant { X => 0, Y=> 1, R => 2 };
use constant P => [
151,160,137,91,90,15,131,13,201,95,96,53,194,233,7,225,140,36,103,30,6
+9,142,
8,99,37,240,21,10,23,190,6,148,247,120,234,75,0,26,197,62,94,252,219,2
+03,117,
35,11,32,57,177,33,88,237,149,56,87,174,20,125,136,171,168,68,175,74,1
+65,71,
134,139,48,27,166,77,146,158,231,83,111,229,122,60,211,133,230,220,105
+,92,41,
55,46,245,40,244,102,143,54,65,25,63,161,1,216,80,73,209,76,132,187,20
+8,89,
18,169,200,196,135,130,116,188,159,86,164,100,109,198,173,186,3,64,52,
+217,
226,250,124,123,5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,1
+6,58,17,
182,189,28,42,223,183,170,213,119,248,152,2,44,154,163,70,221,153,101,
+155,167,
43,172,9,129,22,39,253,19,98,108,110,79,113,224,232,178,185,112,104,21
+8,246,
97,228,251,34,242,193,238,210,144,12,191,179,162,241,81,51,145,235,249
+,14,239,
107,49,192,214,31,181,199,106,157,184,84,204,176,115,121,50,45,127,4,1
+50,254,
138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,18
+0,
151,160,137,91,90,15,131,13,201,95,96,53,194,233,7,225,140,36,103,30,6
+9,142,
8,99,37,240,21,10,23,190,6,148,247,120,234,75,0,26,197,62,94,252,219,2
+03,117,
35,11,32,57,177,33,88,237,149,56,87,174,20,125,136,171,168,68,175,74,1
+65,71,
134,139,48,27,166,77,146,158,231,83,111,229,122,60,211,133,230,220,105
+,92,41,
55,46,245,40,244,102,143,54,65,25,63,161,1,216,80,73,209,76,132,187,20
+8,89,
18,169,200,196,135,130,116,188,159,86,164,100,109,198,173,186,3,64,52,
+217,
226,250,124,123,5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,1
+6,58,17,
182,189,28,42,223,183,170,213,119,248,152,2,44,154,163,70,221,153,101,
+155,167,
43,172,9,129,22,39,253,19,98,108,110,79,113,224,232,178,185,112,104,21
+8,246,
97,228,251,34,242,193,238,210,144,12,191,179,162,241,81,51,145,235,249
+,14,239,
107,49,192,214,31,181,199,106,157,184,84,204,176,115,121,50,45,127,4,1
+50,254,
138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,18
+0,
];
sub rgb2n{ local $^W; unpack 'N', pack 'CCCC', 0, @_ }
my $RED = rgb2n( 255, 0, 0 );
my $GREEN = rgb2n( 0, 255, 0 );
my $BLUE = rgb2n( 0, 0, 255 );
my $YELLOW = rgb2n( 255, 255, 0 );
my $MAGENTA = rgb2n( 255, 0, 255 );
my $CYAN = rgb2n( 0, 255, 255 );
my $WHITE = rgb2n( 255,255,255 );
sub r2pd {
my( $x, $y, $cx, $cy ) = @_;
return sqrt( ( $x - $cx )**2 + ( $y - $cy )**2 );
}
sub fade{ $_[0]**3 * ( $_[0] * ($_[0] * 6 - 15) + 10 ) }
sub lerp{ $_[1] + $_[0] * ($_[2] - $_[1]) }
sub grad{
my( $hash, $x, $y, $z ) = @_;
my $h = $hash & 15;
my $u = $h < 8 ? $x : $y;
my $v = $h < 4 ? $y : $h == 12 || $h ==14 ? $x : $z;
return (( $h & 1 ) == 0 ? $u : -$u ) + (( $h & 2 ) == 0 ? $v : -$v
+ );
}
sub noise {
my( $x, $y, $z ) = @_;
my $X = int( $x ) & 255; $x -= int $x; my $u = fade( $x );
my $Y = int( $y ) & 255; $y -= int $y; my $v = fade( $y );
my $Z = int( $z ) & 255; $z -= int $z; my $w = fade( $z );
my $A = P->[$X ]+$Y;
my $AA = P->[$A ]+$Z;
my $AB = P->[$A+1]+$Z;
my $B = P->[$X+1]+$Y;
my $BA = P->[$B ]+$Z;
my $BB = P->[$B+1]+$Z;
return lerp( $w,
lerp( $v,
lerp( $u, grad( P->[$AA ], $x, $y , $z ), grad( P->[$B
+A ], $x-1, $y , $z ) ),
lerp( $u, grad( P->[$AB ], $x, $y-1, $z ), grad( P->[$B
+B ], $x-1, $y-1, $z ) )
),
lerp( $v,
lerp( $u, grad( P->[$AA+1], $x, $y , $z-1 ), grad( P->[$B
+A+1], $x-1, $y , $z-1 ) ),
lerp( $u, grad( P->[$AB+1], $x, $y-1, $z-1 ), grad( P->[$B
+B+1], $x-1, $y-1, $z-1 ) )
)
);
}
our $F //= 5;
our $X //= 1024; our $Y //= 512;
my @pix = map[ (0) x $X ], 1 .. $Y;
for my $f ( 2,3,5,7,11,13,17,19 ) {
my $yoff = 0;
for my $y ( 0 .. $Y-1 ) {
my $xoff = 0;
for my $x ( 0 .. $X-1 ) {
( $pix[$y][$x] += ( (1+noise( $xoff, $yoff, 1 )) /2 ) ) /=
+ 2;
$xoff += 0.01 * $f;
}
$yoff += 0.01 * $f;
}
my $im = GD::Image->new( $X, $Y, 1 );
for my $y ( 0 .. $Y-1 ) {
for my $x ( 0 .. $X-1 ) {
$im->setPixel( $x, $y, rgb2n( ( $pix[$y][$x] * ( 512 / $f
+) ) x 3 ) );
}
}
open PNG, '>:raw', "$0.png" or die $!;
print PNG $im->png;
close PNG;
system "$0.png";
}
print min( map min( @$_ ), @pix );
print max( map max( @$_ ), @pix );
The next step to producing good texture maps is to pick sets of scales and combine them to produce variable textures across the surface. I never got around to that as it wasn't my goal for the code.
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
| [reply]
[d/l] |
|
|
