[
[[177, 518], [205, 353]],
[[259, 614], [177, 518]],
[[205, 353], [383, 489]],
[[259, 614], [380, 498]],
[[367, 274], [415, 456]],
[[464, 246], [367, 274]],
[[380, 498], [486, 622]],
[[383, 489], [415, 456]],
[[452, 160], [464, 246]],
[[490, 135], [452, 160]],
[[486, 622], [579, 606]],
[[490, 135], [586, 244]],
[[579, 606], [632, 643]],
[[586, 244], [717, 227]],
[[632, 643], [719, 549]],
[[717, 227], [746, 269]],
[[719, 549], [775, 555]],
[[746, 269], [856, 312]],
[[775, 555], [856, 312]],
]
####
sub edges2poly {
my $edges = shift; ## Ref to the AoAoA above.
## For each edge in the list (which is reordered as this loop progresses)
for my $i ( 0 .. $#$edges - 1 ) {
## Stringyfy the end-point
my $target = "@{ $edges->[ $i ][ 1 ] }";
## And scan the remain edges
for my $j ( $i + 1 .. $#$edges ) {
## Comparing the target,
## first against the start
if( $target eq "@{ $edges->[ $j ][ 0 ] }" ) {
## found the next edge correctly oriented.
last if $j == $i + 1; ## nowt to do if its already the next edge
}
## and then the end of each
elsif( $target eq "@{ $edges->[ $j ][ 1 ] }" ) {
## Found it, but its ends need swapping
@{ $edges->[ $j ] } = reverse @{ $edges->[ $j ] };
last if $j == $i + 1; ## nowt more to do if its the next edge
}
else {
next; ## try the next edge
}
## If we got here, we found it (and possible swapped then ends,
## But it is in the wrong place in the list, so swap the edges.
@{ $edges }[ $i+1, $j ] = @{ $edges }[ $j, $i+1 ];
last; ## And skip to the next target
}
}
## return an AoA of just the required points for the bounding polygon.
return( $edges->[ 0 ][ 0 ], map{ $_->[ 1 ] } @$edges );
}
##
##
#! perl -slw
use strict;
use Data::Dump qw[ pp ]; $Data::Dump::MAX_WIDTH = 200;
use List::Util qw[ reduce ];
use Math::Geometry::Voronoi;
use GD;
use constant { X => 1000, Y => 800 };
$|++;
our $N ||= 20;
our $PAT ||= 'random';
my @points;
if( $PAT eq 'diamond' ) {
@points = map{
my $y = $_; map [ $_, $y ], map{ ( ($y=~m[^[13579]] ? 0 : 0.5) + $_ )* 200 } 0 .. 7;
} map $_ * 100, 1 .. 7;
}
elsif( $PAT eq 'hex' ) {
@points = map{
my $y = $_; map [ $_, $y ], map{ ( ($y=~m[^.5] ? 0 : 0.5) + $_ )* 50 } 2 .. 18;
} map $_ * 50, 2 .. 14;
}
elsif( $PAT eq 'hex2' ) {
@points = map{
my $y = $_; map [ $_, $y ], map{ ( ($y=~m[^.5] ? 0 : 0.5) + $_ )* 25 } 4 .. 34;
} map $_ * 25, 4 .. 28;
}
elsif( $PAT eq 'square' ) {
@points = map{
my $y = $_; map [ $_, $y ], map $_ * 100, 1 .. 9;
} map $_ * 100, 1 .. 7;
}
else { # 'random' -N=nnn
@points = map [
int( 100 + rand X - 200 ), int( 100 + rand Y- 200 ),
], 1 .. $N;
}
#pp \@points; <>;
my $geo = Math::Geometry::Voronoi->new( points => \@points );
$geo->compute;
my $img = GD::Image->new( X, Y, 1 );
$img->filledRectangle( 100, 100, X-100, Y-100, 0x00ffffff );
my @geoPolys = $geo->polygons;
#pp \@geoPolys; <>;
my @gdUnfilteredPolys = map {
gdPolyFromPoints( @{ $_ }[ 1 .. $#$_ ] );
} @geoPolys;
$img->openPolygon( $_, rgb2n( 128, 128, 128 ) ) for @gdUnfilteredPolys;
my @filteredPolys = map {
my $ref = [ filterPoly( 100, 100, 900, 700, @{ $_ }[ 1 .. $#$_ ] ) ];
@$ref ? $ref : ()
} @geoPolys;
#pp \@filteredPolys; <>;
my @gdPolys = map { gdPolyFromPoints( @$_ ); } @filteredPolys;
#pp \@gdPolys; <>;
$img->openPolygon( $_, rgb2n( 0, 255, 0 ) ) for @gdPolys;
$img->filledEllipse( @$_, 3, 3, rgb2n( 255, 0, 0 ) ) for @points;
my %countedEdges;
for my $poly ( @filteredPolys ) {
reduce{
my( $sa, $sb ) = sort( "@$a", "@$b" );
$countedEdges{ "$sa, $sb" }++;
$b
} @{ $poly }, $poly->[ 0 ];
}
#pp \%countedEdges;
## rebuild the stringified edges
my @coverageEdges = map {
[ map [ split ], split ', ' ]
} grep $countedEdges{ $_ } == 1, keys %countedEdges;
#pp \@coverageEdges;
my @coveragePoly = edges2poly( \@coverageEdges );
my $gdCoveragePoly = gdPolyFromPoints( @coveragePoly );
$img->openPolygon( $gdCoveragePoly, rgb2n( 0, 0, 255 ) );
open IMG, '>:raw', 'voronoi.png' or die $!;
print IMG $img->png;
close IMG;
system 'voronoi.png';
sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ }
sub n2rgb{ unpack 'xCCC', pack 'N', $_[0] }
sub gdPolyFromPoints {
# pp \@_;
return unless @_;
my $p = new GD::Polygon;
$p->addPt( @$_ ) for @_;
return $p;
}
sub filterPoly {
my( $xmin, $ymin, $xmax, $ymax ) = map shift, 1 .. 4;
my @rv;
my $last = [-1,-1];
for( @_ ) {
$_ = int( $_ ) for @$_;
## reject the entire poly if one or more points is out of bounds.
# warn( "rejecting @{[ map{ qq[@$_] } @_ ]} completely" ),
return if $_->[ 0 ] < $xmin or $_->[ 0 ] > $xmax
or $_->[ 1 ] < $ymin or $_->[ 1 ] > $ymax;
## Reject this point if it is the same as the previous point
# warn( "rejecting point [ @$_ ]" ),
next if $_->[ 0 ] == $last->[ 0 ] and $_->[ 1 ] == $last->[ 1 ];
push @rv, $_;
$last = $_;
}
return @rv;
}
sub edges2poly {
my $edges = shift;
for my $i ( 0 .. $#$edges - 1 ) {
my $target = "@{ $edges->[ $i ][ 1 ] }";
# warn "looking for ($i) $target\n";
for my $j ( $i + 1 .. $#$edges ) {
# warn "in ($j)" . pp $edges->[ $j ];
if( $target eq "@{ $edges->[ $j ][ 0 ] }" ) {
## found the next point correctly oriented.
# warn "Found it the right way around\n";
last if $j == $i + 1; ## nothing to do
}
elsif( $target eq "@{ $edges->[ $j ][ 1 ] }" ) {
## Found it, but it needs reversing
# warn "Found it the reversed\n";
@{ $edges->[ $j ] } = reverse @{ $edges->[ $j ] };
last if $j == $i + 1; ## nothing more to do
}
else {
next; ## try the next
}
# warn "swapping " . pp( $edges->[ $i+1 ] )
# . " and " . pp( $edges->[ $j ] );
@{ $edges }[ $i+1, $j ] = @{ $edges }[ $j, $i+1 ];
last;
}
# pp $edges; <>;
}
return( $edges->[ 0 ][ 0 ], map{ $_->[ 1 ] } @$edges );
}