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