Sometimes I use Perl to generate cheesy graphics to visualize
math or geometry concepts. The latest effort was rather pleasing
despite the cheese so I offer it here.
This program calculates and displays Voronoi neighborhoods.
The neighborhoods wrap so the image (if it were one) is tileable. There are
many examples of Voronoi spots found in nature, quite an
interesting subject (search Google).
Any suggestions for a better @CHARS to use?
SpotFoo
#!/usr/bin/perl
use strict;
my @CHARS = split('', ' .,-+*$&#@');
my ($XMIN, $XMAX) = qw(0 1);
my ($YMIN, $YMAX) = qw(0 1);
my ($ROWS, $COLS) = qw(40 80);
my $POINTS = 8;
my $REPEAT = 0;
my $xfact = ($XMAX - $XMIN) / $COLS;
my $yfact = ($YMAX - $YMIN) / $ROWS;
my (@screen, @xs, @ys);
# Pick some random points
for (0..$POINTS-1) {
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..$ROWS-1) {
my $y = $YMIN + $yi * $yfact;
for my $xi (0..$COLS-1) {
my $x = $XMIN + $xi * $xfact;
my ($best, $good) = closest($x, $y, \@xs, \@ys);
$screen[$xi][$yi] = $CHARS[int(10 * ($best / $good))];
}
}
# Print screen
for (0..$REPEAT) {
for my $yi (0..$ROWS-1) {
for my $xi (0..$COLS-1) {
print "$screen[$xi][$yi]";
}
print "\n";
}
}
#-----------------------------------------------------------
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, $dis
+t); }
elsif ($i == 1 || $dist < $good) { $good = $dist; }
}
return ($best, $good);
}
Re: Perl Spots
by hossman (Prior) on Aug 14, 2002 at 07:00 UTC
|
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);
}
| [reply] [Watch: Dir/Any] [d/l] |
|
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;
}
| [reply] [Watch: Dir/Any] [d/l] |
|
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++) {
...
}
}
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
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)
| [reply] [Watch: Dir/Any] |
|
Beautiful. Playing around with the color tables gives lots of pretty pictures. Now my destop image changes randomly thoughout the day. Oh what fun!
| [reply] [Watch: Dir/Any] |
Re: Perl Spots
by YuckFoo (Abbot) on Aug 13, 2002 at 22:15 UTC
|
Some explaining:
A finite number of Voronoi points (v-points) are distributed on a plane.
Each v-point has an associated neighborhood (v-hood). The v-hood is the
set of points nearer to the v-point than any other v-point.
To shade the v-hoods, I find the distances to the nearest two v-points and
divide the smallest distance by the next smallest distance ($best / $good).
This number will always be between 0 and 1. Points in the middle of a
v-hood will be close to 0, points near the edge will be close to 1, being
nearly the same distance from both points.
Multiplying by 10 and using the integer result gives an index to the @CHARS
array.
Random v-points are added in the square with corners at (0,0) and (1,1).
To achieve wrapping additional v-points are added in the eight surrounding
squares.
So for v-point (.2, .3), these points are added:
(-.8, -.7) (-.8, .3) (-.8, 1.3)
( .2, -.7) ( .2, .3) ( .2, 1.3)
(1.2, -.7) (1.2, .3) (1.2, 1.3)
To see just the borders use:
my @CHARS = split('', ' #');
For stripes:
my @CHARS = split('', ' # # # # #');
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
Quite interesting. I've had a lot of fun playing with this (and not doing the work I'm supposed to be doing). It's fun watching what comes out when you used different values for rand() (:). Also changing @CHARS gives some interesting images. (Try '##########', for example).
Coordinate geometry is PERLfectly FUNdamental!
------
my {$two_cents = $_->food} for @thought;
$will->code for @food or $$;
| [reply] [Watch: Dir/Any] [d/l] |
Re: Perl Spots
by BrowserUk (Patriarch) on Aug 14, 2002 at 01:29 UTC
|
my @CHARS=map{chr} qw(32 46 248 249 197 206 176 177 178 219);
print "@CHARS\n";
Not the most effective way of coding it, but convenient (for me).
I doubt these values will work on a *nix system, unless there is a console font that emulates the old dos charset.
Update: The effect is especially pleasing when I set the window to a 6-point TT-Luscida font, the window size to 201x120 (Wxh) and ($ROWS,$COLS) = (120,200);. | [reply] [Watch: Dir/Any] [d/l] |
Re: Perl Spots (in ANSI color!)
by wedman (Sexton) on Aug 14, 2002 at 19:31 UTC
|
my @CHARS = (
"\033[1;30;40m ", # dark grey on black
"\033[1;30;40m@", # same thing, but prints '@' instead of ' '
"\033[1;30;47m@", # dark grey on light grey
"\033[1;30;47m ",
"\033[1;36;47m@", # light blue on light grey
"\033[0;37;46m@", # light grey on light blue
"\033[0;37;46m ",
"\033[0;34;46m@", # dark blue on light blue
"\033[0;36;44m@", # light blue on dark blue
"\033[0;36;44m "
);
Now, these are strings as opposed to characters, but it still works.
| [reply] [Watch: Dir/Any] [d/l] |
Re: Perl Spots
by bilfurd (Hermit) on Aug 14, 2002 at 00:34 UTC
|
Pretty cool, actually.
I broke out the ASCII character table and tried using some chr() codes on my work (WinXP) box. My results were underwhelming, but you might have better luck. | [reply] [Watch: Dir/Any] |
Re: Perl Spots
by mattr (Curate) on Aug 20, 2002 at 12:17 UTC
|
very cool! thanks for voronoi code.
I found setting autoflush $|=1 to be very rewarding when
used as a simple cgi (printed as text/html with PRE tag).
Just feels good.
Seems to be much the same speed even using CGI.pm to set the params x and y. I guess someone can now set up a voronoi desktop downloader service somewhere.. :0 | [reply] [Watch: Dir/Any] |
|
|