Here's the code I wrote (as a result of the discussion in my thread: Randomly biased, random numbers.), to implement the Improved Perlin Noise algorithm. It also runs it with various scales to produce finer and finer detail:

#! perl -slw use strict; use Data::Dump qw[ pp ]; $Data::Dump::WIDTH = 1e3; use List::Util qw[ min max ]; use GD; use constant { X => 0, Y=> 1, R => 2 }; use constant P => [ 151,160,137,91,90,15,131,13,201,95,96,53,194,233,7,225,140,36,103,30,6 +9,142, 8,99,37,240,21,10,23,190,6,148,247,120,234,75,0,26,197,62,94,252,219,2 +03,117, 35,11,32,57,177,33,88,237,149,56,87,174,20,125,136,171,168,68,175,74,1 +65,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,20 +8,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,1 +6,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,21 +8,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,1 +50,254, 138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,18 +0, 151,160,137,91,90,15,131,13,201,95,96,53,194,233,7,225,140,36,103,30,6 +9,142, 8,99,37,240,21,10,23,190,6,148,247,120,234,75,0,26,197,62,94,252,219,2 +03,117, 35,11,32,57,177,33,88,237,149,56,87,174,20,125,136,171,168,68,175,74,1 +65,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,20 +8,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,1 +6,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,21 +8,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,1 +50,254, 138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,18 +0, ]; sub rgb2n{ local $^W; unpack 'N', pack 'CCCC', 0, @_ } my $RED = rgb2n( 255, 0, 0 ); my $GREEN = rgb2n( 0, 255, 0 ); my $BLUE = rgb2n( 0, 0, 255 ); my $YELLOW = rgb2n( 255, 255, 0 ); my $MAGENTA = rgb2n( 255, 0, 255 ); my $CYAN = rgb2n( 0, 255, 255 ); my $WHITE = rgb2n( 255,255,255 ); sub r2pd { my( $x, $y, $cx, $cy ) = @_; return sqrt( ( $x - $cx )**2 + ( $y - $cy )**2 ); } sub fade{ $_[0]**3 * ( $_[0] * ($_[0] * 6 - 15) + 10 ) } sub lerp{ $_[1] + $_[0] * ($_[2] - $_[1]) } sub grad{ my( $hash, $x, $y, $z ) = @_; my $h = $hash & 15; my $u = $h < 8 ? $x : $y; my $v = $h < 4 ? $y : $h == 12 || $h ==14 ? $x : $z; return (( $h & 1 ) == 0 ? $u : -$u ) + (( $h & 2 ) == 0 ? $v : -$v + ); } sub noise { my( $x, $y, $z ) = @_; my $X = int( $x ) & 255; $x -= int $x; my $u = fade( $x ); my $Y = int( $y ) & 255; $y -= int $y; my $v = fade( $y ); my $Z = int( $z ) & 255; $z -= int $z; my $w = fade( $z ); my $A = P->[$X ]+$Y; my $AA = P->[$A ]+$Z; my $AB = P->[$A+1]+$Z; my $B = P->[$X+1]+$Y; my $BA = P->[$B ]+$Z; my $BB = P->[$B+1]+$Z; return lerp( $w, lerp( $v, lerp( $u, grad( P->[$AA ], $x, $y , $z ), grad( P->[$B +A ], $x-1, $y , $z ) ), lerp( $u, grad( P->[$AB ], $x, $y-1, $z ), grad( P->[$B +B ], $x-1, $y-1, $z ) ) ), lerp( $v, lerp( $u, grad( P->[$AA+1], $x, $y , $z-1 ), grad( P->[$B +A+1], $x-1, $y , $z-1 ) ), lerp( $u, grad( P->[$AB+1], $x, $y-1, $z-1 ), grad( P->[$B +B+1], $x-1, $y-1, $z-1 ) ) ) ); } our $F //= 5; our $X //= 1024; our $Y //= 512; my @pix = map[ (0) x $X ], 1 .. $Y; for my $f ( 2,3,5,7,11,13,17,19 ) { my $yoff = 0; for my $y ( 0 .. $Y-1 ) { my $xoff = 0; for my $x ( 0 .. $X-1 ) { ( $pix[$y][$x] += ( (1+noise( $xoff, $yoff, 1 )) /2 ) ) /= + 2; $xoff += 0.01 * $f; } $yoff += 0.01 * $f; } my $im = GD::Image->new( $X, $Y, 1 ); for my $y ( 0 .. $Y-1 ) { for my $x ( 0 .. $X-1 ) { $im->setPixel( $x, $y, rgb2n( ( $pix[$y][$x] * ( 512 / $f +) ) x 3 ) ); } } open PNG, '>:raw', "$0.png" or die $!; print PNG $im->png; close PNG; system "$0.png"; } print min( map min( @$_ ), @pix ); print max( map max( @$_ ), @pix );

The next step to producing good texture maps is to pick sets of scales and combine them to produce variable textures across the surface. I never got around to that as it wasn't my goal for the code.


With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

In reply to Re^3: Translating simplex noise code from java to perl by BrowserUk
in thread Translating simplex noise code from java to perl by grondilu

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.