RosettaCodeData/Task/Perlin-noise/Mathematica/perlin-noise.math
2026-04-30 12:34:36 -04:00

71 lines
2.4 KiB
Text

(* Fade function *)
fade[t_] := t^3 (t (t 6 - 15) + 10)
(* Linear interpolation *)
lerp[t_, a_, b_] := a + t (b - a)
(* Gradient function *)
grad[hash_, x_, y_, z_] :=
Module[{h, u, v},
h = BitAnd[hash, 15];
u = If[h < 8, x, y];
v = If[h < 4, y, If[MemberQ[{12, 14}, h], x, z]];
(If[BitAnd[h, 1] == 0, u, -u]) + (If[BitAnd[h, 2] == 0, v, -v])
]
(* Permutation table *)
permutation = {
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,26,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,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,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,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
};
(* Double the permutation to avoid wrap-around *)
p = Join[permutation, permutation];
(* Perlin noise function *)
perlinNoise[x_, y_, z_] :=
Module[{X, Y, Z, u, v, w, A, AA, AB, B, BA, BB, xf, yf, zf},
X = BitAnd[Floor[x], 255];
Y = BitAnd[Floor[y], 255];
Z = BitAnd[Floor[z], 255];
xf = x - Floor[x];
yf = y - Floor[y];
zf = z - Floor[z];
u = fade[xf];
v = fade[yf];
w = fade[zf];
A = p[[X + 1]] + Y;
AA = p[[A + 1]] + Z;
AB = p[[A + 2]] + Z;
B = p[[X + 2]] + Y;
BA = p[[B + 1]] + Z;
BB = p[[B + 2]] + Z;
lerp[w,
lerp[v,
lerp[u, grad[p[[AA + 1]], xf, yf, zf],
grad[p[[BA + 1]], xf - 1, yf, zf]],
lerp[u, grad[p[[AB + 1]], xf, yf - 1, zf],
grad[p[[BB + 1]], xf - 1, yf - 1, zf]]
],
lerp[v,
lerp[u, grad[p[[AA + 2]], xf, yf, zf - 1],
grad[p[[BA + 2]], xf - 1, yf, zf - 1]],
lerp[u, grad[p[[AB + 2]], xf, yf - 1, zf - 1],
grad[p[[BB + 2]], xf - 1, yf - 1, zf - 1]]
]
]
]
(* Example usage *)
perlinNoise[3.14, 42, 7] // N[#, 17] & //Print