Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

Re: Perl Spots

by hossman (Prior)
on Aug 14, 2002 at 07:00 UTC ( #190000=note: print w/ replies, xml ) Need Help??


in reply to Perl Spots

very cool.

A few alterations to use GD, a bit of randomness in the number of points, and it makes a sweet Eterm background generator.

It takes a little while of course, since it's plotting a pixel at a time, but the good news is: it's perfectly tile-able

#!/usr/bin/perl use strict; use GD; my $numColors = 128; my $size = 200; my ($XMIN, $XMAX) = qw(0 1); my ($YMIN, $YMAX) = qw(0 1); my $POINTS = 3 + int(rand(6)); my $xfact = ($XMAX - $XMIN) / $size; my $yfact = ($YMAX - $YMIN) / $size; # allocate some colors my @colors; my $img = new GD::Image($size, $size); for (my $i = 0; $i < $numColors; $i++) { push @colors, $img->colorAllocate(1, 1, $i * (256 / $numColors)); } my (@xs, @ys); # Pick some random points for (1..$POINTS) { my ($xrand, $yrand) = (rand(), rand()); for my $xoffset (-1..1) { for my $yoffset (-1..1) { push (@xs, $xrand + $xoffset); push (@ys, $yrand + $yoffset); } } } # Calculate screen for (my $yi = 0; $yi < $size; $yi++) { my $y = $YMIN + $yi * $yfact; for (my $xi = 0; $xi < $size; $xi++) { my $x = $XMIN + $xi * $xfact; my ($best, $good) = closest($x, $y, \@xs, \@ys); $img->setPixel($xi, $yi, $colors[int($numColors * ($best / $good))]); } } binmode STDOUT; print $img->png(); sub closest { my ($x, $y, $xs, $ys) = @_; my ($dist, $best, $good); for (my $i = 0; $i < @$xs; $i++) { $dist = sqrt(($x - $xs->[$i])**2 + ($y - $ys->[$i])**2); if ($i == 0 || $dist < $best) { ($good, $best) = ($best, $d +ist); } elsif ($i == 1 || $dist < $good) { $good = $dist; } } return ($best, $good); }


Comment on Re: Perl Spots
Download Code
Re: Re: Perl Spots
by zakzebrowski (Curate) on Aug 14, 2002 at 12:15 UTC
    Sweet... I've never had a perl-generated background before... (Plus, it's nice example of how to use png... :-) )

    ----
    Zak
    "There is no room in this country for hyphenated Americanism" ~ Theodore Roosevelt (1915)
Re: Re: Perl Spots
by smalhotra (Scribe) on Aug 14, 2002 at 20:01 UTC
    Beautiful. Playing around with the color tables gives lots of pretty pictures. Now my destop image changes randomly thoughout the day. Oh what fun!
Re: Re: Perl Spots
by YuckFoo (Abbot) on Aug 14, 2002 at 21:35 UTC
    Thanks for the extension hossman++. This works pretty good. Only problem is, I gave you a very sub-optimal algorithm. Ok for 40 x 80, too slow for 200 x 200.

    The big kludge was adding 8 points in adjacent squares. This isn't necessary. Instead calculate the x and y distances separately. If a distance is greater than .5, adjust it to 1 - distance. If a point is .7 from a v-point, it is .3 from a corresponding v-point in an adjacent square.

    This means about 90% fewer v-points to test against, so this is many times faster.

    So here's another version based on your changes with an additional color option.

    YuckFoo

    #!/usr/bin/perl use strict; use GD; my $ROWS = 200; # number of rows my $COLS = 200; # number of columns my $POINTS = 12; # number of Voronoi points my $COLORS = 128; # number of colors my $INNER = [255, 255, 0]; # inner color (red, green, blue) my $OUTER = [ 0, 32, 0]; # outer color (red, green, blue) my $xfact = 1 / $COLS; my $yfact = 1 / $ROWS; # Allocate some colors my $img = new GD::Image($COLS, $ROWS); my $colors = makecolors($img, $COLORS, $INNER, $OUTER); my (@xs, @ys); # Pick some random points for (0..$POINTS-1) { push (@xs, rand()); push (@ys, rand()); } # Calculate screen for my $yi (0..$ROWS-1) { my $y = $yi * $yfact; for my $xi (0..$COLS-1) { my $x = $xi * $xfact; my ($best, $good) = closest($x, $y, \@xs, \@ys); $img->setPixel($xi, $yi, $colors->[$COLORS * ($best / $good)] +); } } binmode STDOUT; print $img->png(); #----------------------------------------------------------- sub closest { my ($x, $y, $xs, $ys) = @_; my ($dist, $best, $good); for (my $i = 0; $i < @$xs; $i++) { my $xdiff = abs($x - $xs->[$i]); my $ydiff = abs($y - $ys->[$i]); if ($xdiff > .5) { $xdiff = 1 - $xdiff; } if ($ydiff > .5) { $ydiff = 1 - $ydiff; } $dist = sqrt($xdiff * $xdiff + $ydiff * $ydiff); if ($i == 0 || $dist < $best) { ($good, $best) = ($best, $dis +t); } elsif ($i == 1 || $dist < $good) { $good = $dist; } } return ($best, $good); } #----------------------------------------------------------- sub makecolors { my ($img, $num, $beg, $end) = @_; my (@colors); my $red = ($end->[0] - $beg->[0]) / $num; my $green = ($end->[1] - $beg->[1]) / $num; my $blue = ($end->[2] - $beg->[2]) / $num; for (my $i = 0; $i < $num; $i++) { $beg->[0] += $red; $beg->[1] += $green; $beg->[2] += $blue; push (@colors, $img->colorAllocate(@$beg)); } return \@colors; }
      one other things you should change now that the size is a couple of orders of magnitude bigger...
      # Calculate screen for my $yi (0..$ROWS-1) { my $y = $yi * $yfact; for my $xi (0..$COLS-1) { ... } }

      Should be something like...

      # Calculate screen for (my $yi = 0; $yi < $ROWS; $yi++) { my $y = $yi * $yfact; for (my $xi = 0; $xi < $COLS; $xi++) { ... } }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://190000]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (13)
As of 2015-07-02 08:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (31 votes), past polls