#! 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 );
}