Perlin noise: Difference between revisions

Line 128:

=={{header|Perl 6}}==

<lang perl6>~~module~~ ~~ImprovedNoise;~~

<lang perl6>constant @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($_)}, <

97 a0 89 5b 5a f 83 d c9 5f 60 35 c2 e9 7 e1 8c 24 67 1e 45 8e 8 ~~63 25~~ f0 15 a

3H 3S 4R 4O 1W 4V 22 4L 1Z 3Q 3V 1C R 4M 25 42 4E 6F 2B 33 6D 3E 1O 5V 3P 6E 64

17 be 6 94 f7 78 ea 4b 0 1a c5 3e 5e fc db cb 75 23 b 20 39 b1 21 58 ed 95 38

2X 2K 15 1J 1A 6T 14 6S 2U 3Z 1I 1T P 1R 4H 1 60 28 21 5T 24 3O 57 5S 2H I 4P

57 ae 14 7d 88 ab a8 44 af 4a a5 47 86 8b 30 1b a6 4d 92 9e e7 53 6f e5 7a 3c

5K 5G 3R 3M 38 58 4F 2E 4K 2S 31 5I 4T 56 3 1S 1G 61 6A 6Y 3G 3F 5 5M 12 43 3A

d3 85 e6 dc 69 5c 29 37 2e f5 28 f4 66 8f 36 41 19 3f a1 1 d8 50 49 d1 4c 84 bb

3I 73 2A 2D 5W 5R 5Q 1N 6B 1B G 1M H 52 59 S 16 67 53 4Q 5X 3B 6W 48 2 18 4A 4J

d0 59 12 a9 c8 c4 87 82 74 bc 9f 56 a4 64 6d c6 ad ba 3 40 34 d9 e2 fa 7c 7b 5

1Y 65 49 2T 4B 4N 17 4S 9 3L M 13 71 J 2Q 30 32 27 35 68 6G 4Y 55 34 2W 62 6U

ca 26 93 76 7e ff 52 55 d4 cf ce 3b e3 2f 10 3a 11 b6 bd 1c 2a df b7 aa d5 77

2P 6C 6Z Y 6Q 5D 6M 5U 40 C 5B 4Z 4I 6P 29 1F 41 6J 6X E 6N 2Z 1D 5C 5Y V 51 5J

f8 98 2 2c 9a a3 46 dd 99 65 9b a7 2b ac 9 81 16 27 fd 13 62 6c 6e 4f 71 e0 e8

2Y 4D 54 2C 5O 4W 37 3D 1E 19 3J 4 46 72 3U 6K 5P 2L 66 36 1V T O 20 6R 3X 3K

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;

Line 156:

Line 154:

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 \A = @p[$X] + $Y;

my ($AA~~, $AB)~~ = ( @p[$A] + $Z, @p[$A + 1] + $Z );

my \AA = @p[A] + $Z, my \AB = @p[A + 1] + $Z;

my $B = @p[$X + 1] + $Y;

my \B = @p[$X + 1] + $Y;

my ($BA~~, $BB)~~ = ( @p[$B] + $Z, @p[$B + 1] + $Z );

my \BA = @p[B] + $Z; my \BB = @p[B + 1] + $Z;

lerp($w, lerp($v, lerp($u,

lerp($w, lerp($v, lerp($u, grad(@p[AA ], $x , $y , $z ),

grad( @p[~~$AA],~~ $x, $y, $z ),

grad(@p[BA ], $x - 1, $y , $z )),

~~grad~~( @p[~~$BA~~], $x - 1, $y, $z )

lerp($u, grad(@p[AB ], $x , $y - 1, $z ),

⚫

grad(@p[BB ], $x - 1, $y - 1, $z ))),

),

⚫

lerp($v, lerp($u, grad(@p[AA + 1], $x , $y , $z - 1 ),

lerp($u,

grad( @p[~~$AB~~], $x, $y - 1, $z ),

grad(@p[BA + 1], $x - 1, $y , $z - 1 )),

~~grad~~( @p[~~$BB~~], $x - 1, $y - 1, $z )

lerp($u, grad(@p[AB + 1], $x , $y - 1, $z - 1 ),

⚫

grad(@p[BB + 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 ))

)

);

}