Perlin noise
constant @p = flat { @_.sort.antipairs.Hash{@_} }(<
๐
๐๐ธ๐๐โ ๐ปโ๐ป๐๐๐๐ฒ๐คฆโบ๐ค๐ต๐๐๐๐ถ๐โ ๐๐๐คญโฃโฝโก๐ฎโน๐
๐ฅฐ๐ฃ๐คง๐ทโถ๐๐ต๐๐ผ๐ฆ๐ค๐๐๐โ
๐๐๐๐๐๐คช๐๐๐๐โ๐ฉ๐ฃ๐๐๐ต๐
๐ถ๐๐๐๐ด๐บ๐๐๐พ๐๐๐คฃ๐๐๐ค ๐ฆ๐ป๐๐ฟ๐คข๐ค๐๐ถ๐๐๐ธ๐ฅ๐๐คท๐๐ค๐
๐โญ๐๐โ๐ฉ๐๐๐๐ธ๐พ๐ซ๐๐โ๐๐น๐ด๐๐ธ๐๐ฌ๐๐๐๐๐๐ถ๐๐ชโ๐
๐๐ถ๐ค๐ฅต๐จ๐งโ ๐๐๐๐ก๐ช๐ช๐๐๐๐๐
๐บ๐ค๐นโ๐โจ๐ค๐ญ๐๐๐ค๐ฅ๐๐
๐ข๐ฅณ๐โ๐ด๐๐๐ผ๐ค๐๐๐๐๐ฑ๐โก๐ฐโค๐๐งโ๐
๐๐๐
๐๐ค๐คค๐ ๐ฉ๐๐
๐ฐ ๐ฅ๐๐ค๐ฅบ๐๐คฏ๐ฑ๐คซ๐๐ฅ โ๐ฏ๐ก๐๐คฎ๐๐ฟ๐ฃ ๐คจ๐ฅดโ๐คฌ๐๐ป๐ฐ๐๐๐ฃ๐ท๐๐
๐จ๐๐๐๐๐ฅ๐ผ๐ท๐ซโ๐๐งก๐ฅ๐คฉ๐๐ป๐ค๐๐ค๐โฌ๐๐คฒ๐บ๐ฏ๐ณ๐๐๐จ๐๐๐ข
>.join.comb) xx 2;
sub fade($_) { $_ * $_ * $_ * ($_ * ($_ * 6 - 15) + 10) }
sub lerp($t, $a, $b) { $a + $t * ($b - $a) }
sub grad($h is copy, $x, $y, $z) {
$h +&= 15;
my $u = $h < 8ย ?? $xย !! $y;
my $v = $h < 4ย ?? $yย !! $h == 12|14ย ?? $xย !! $z;
($h +& 1ย ?? -$uย !! $u) + ($h +& 2ย ?? -$vย !! $v);
}
sub noise($x is copy, $y is copy, $z is copy) {
my ($u, $v, $w) = map &fade, ($x, $y, $z)ย ยป-=ยซ
my ($X, $Y, $Z) = ($x, $y, $z)ยป.floorย ยป+&ยป 255;
my ($AA, $AB) = @p[$_] + $Z, @p[$_ + 1] + $Z given @p[$X] + $Y;
my ($BA, $BB) = @p[$_] + $Z, @p[$_ + 1] + $Z given @p[$X + 1] + $Y;
lerp($w, lerp($v, lerp($u, grad(@p[$AA ], $x , $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 ),
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 ))));
}
say noise 3.14, 42, 7;
Output:
0.13691995878
Last updated