|
=={{header|Perl 6}}==
{{trans|Java}}
<lang perl6>moduleconstant ImprovedNoise;@permutation = map {:36($_)}, <
47 4G 3T 2J 2I F 3N D 5L 2N 2O 1H 5E 6H 7 69 3W 10 2V U 1X 3Y 8 2R 11 6O L A N
5A 6 44 6V 3C 6I 23 0 Q 5H 1Q 2M 70 63 5N 39 Z B W 1L 4X X 2G 6L 45 1K 2F 4U K
constant @permutation = map {:16($_)}, <
973H a03S 894R 5b4O 5a1W f4V 8322 d4L c91Z 5f3Q 603V 351C c2R e94M 725 e142 8c4E 246F 672B 1e33 456D 8e3E 81O 63 255V f03P 156E a64
172X be2K 615 941J f71A 786T ea14 4b6S 02U 1a3Z c51I 3e1T 5eP fc1R db4H cb1 7560 2328 b21 205T 3924 b13O 2157 585S ed2H 95I 384P
575K ae5G 143R 7d3M 8838 ab58 a84F 442E af4K 4a2S a531 475I 864T 8b56 303 1b1S a61G 4d61 926A 9e6Y e73G 533F 6f5 e55M 7a12 3c43 3A
d33I 8573 e62A dc2D 695W 5c5R 295Q 371N 2e6B f51B 28G f41M 66H 8f52 3659 41S 1916 3f67 a153 14Q d85X 503B 496W d148 4c2 8418 bb4A 4J
d01Y 5965 1249 a92T c84B c44N 8717 824S 749 bc3L 9fM 5613 a471 64J 6d2Q c630 ad32 ba27 335 4068 346G d94Y e255 fa34 7c2W 7b62 56U
ca2P 266C 936Z 76Y 7e6Q ff5D 526M 555U d440 cfC ce5B 3b4Z e34I 2f6P 1029 3a1F 1141 b66J bd6X 1cE 2a6N df2Z b71D aa5C d55Y 77V 51 5J
f82Y 984D 254 2c2C 9a5O a34W 4637 dd3D 991E 6519 9b3J a74 2b46 ac72 93U 816K 165P 272L fd66 1336 621V 6cT 6eO 4f20 716R e03X e83K
5F 26 1U 5Z 1P 4C 50
b2 b9 70 68 da f6 61 e4 fb 22 f2 c1 ee d2 90 c bf b3 a2 f1 51 33 91 eb f9 e ef
6b 31 c0 d6 1f b5 c7 6a 9d b8 54 cc b0 73 79 32 2d 7f 4 96 fe 8a ec cd 5d de 72
43 1d 18 48 f3 8d 80 c3 4e 42 d7 3d 9c b4
>;
constant @p = @permutation, @permutation;
my ($X, $Y, $Z) = ($x, $y, $z)».floor »+&» 255;
my ($u, $v, $w) = map &fade, $x -= $X, $y -= $Y, $z -= $Z;
my $\A = @p[$X] + $Y;
my ($\AA, $AB) = ( @p[$A] + $Z, my \AB = @p[$A + 1] + $Z );
my $\B = @p[$X + 1] + $Y;
my ($\BA, $BB) = ( @p[$B] + $Z,; my \BB = @p[$B + 1] + $Z );
lerp($w, lerp($v, lerp($u, grad(@p[AA ], $x , $y , $z ),
grad( @p[$AA],BA ], $x - 1, $y , $z )),
grad lerp($u, grad(@p[$BAAB ], $x - 1 , $y - 1, $z ),
grad(@p[ $BB + 1 ], $x - 1, $y - 1, $z - 1 )) ),▼ ),
lerp($v, lerp($u, grad(@p[ $AA + 1], $x , $y , $z - 1 ), ▼ lerp($u,
grad( @p[$ABBA + 1], $x - 1, $y - 1 , $z - 1 )),
grad lerp($u, grad(@p[$BBAB + 1], $x - 1 , $y - 1, $z - 1 ),
lerp($u, grad(@p[ $ABBB + 1], $x - 1, $y - 1, $z - 1 ) ,)));▼ )
),
▲ lerp($v, lerp($u, grad(@p[$AA + 1], $x, $y, $z - 1 ),
grad(@p[$BA + 1], $x - 1, $y, $z - 1 )),
▲ lerp($u, grad(@p[$AB + 1], $x, $y - 1, $z - 1 ),
▲ grad(@p[$BB + 1], $x - 1, $y - 1, $z - 1 ))
)
);
}
|
