package Urb::Polygon;

use strict;
use warnings;
use 5.010;

use Math::Trig;
use Math::Polygon;
use Storable qw/dclone/;
use Urb::Math qw /distance_2d scale_2d points_2line subtract_2d add_2d line_intersection/;

our $PI = atan2 (0,-1);

use base qw /Math::Polygon/;

=head1 NAME

Urb::Polygon - Class for maintaining polygon data

=head1 SYNOPSIS

Some dodgy new Math::Polygon methods

=head1 DESCRIPTION

This module contains some extra methods for L<Math::Polygon>, these methods are
not quite sane enough to be added to L<Math::Polygon> proper.

=head1 USAGE

=over

=item _gradients

Get list of line gradients in use in this polygon, may contain duplicates

  @scalars = $polygon->_gradients;

=cut

sub _gradients
{
    my $self = shift;
    return map {abs($_->{a}) > 99999999 ? 99999999 : sprintf ("%.5f", $_->{a})} $self->_lines;
}

=item _lines

Get list of lines in use in this polygon in a,b format. may contain duplicates

  @lines = $polygon->_lines;

=cut

sub _lines
{
    my $self = shift;
    my @points = $self->points;
    my @lines;
    for my $id (0 .. scalar (@points) -2)
    {
        push @lines, points_2line ($points[$id], $points[$id+1]);
    }
    return @lines;
}

=item _is_contained_by

See if all corners of this polygon are on edges of or inside another

  $polygon->_is_contained_by ($bigger_polygon);

=cut

sub _is_contained_by
{
    my $self = shift;
    my $bigger = shift;
    my @points = $self->points;
    pop @points;
    for my $point (@points)
    {
        return 0 unless ($bigger->contains ($point) || $bigger->_is_on_polygon ($point));
    }
    return 1;
}

=item _overlaps

Do two polygons overlap? crude test

  $polygon->_overlaps ($other_polygon);

=cut

sub _overlaps
{
    my $self = shift;
    my $other = shift;

    my $other_divided = $other->_divide_polygon (20);

    my @points = $other_divided->points;
    pop @points;
    for my $point (@points)
    {
       return 1 if ($self->contains ($point) && !$self->_is_on_polygon ($point));
    }

    return 0;
}

=item _is_on_polygon

Is a point on the edge of this polygon?

   $polygon->_is_on_polygon ([2.3,4.5]);

=cut

sub _is_on_polygon
{
    my $self = shift;
    my $point = shift;
    my @points = $self->points;
    pop @points;
    for my $id (0 .. scalar (@points) -1)
    {
        my $length = distance_2d ($points[$id-1], $points[$id]);
        my $length_a = distance_2d ($points[$id-1], $point);
        my $length_b = distance_2d ($points[$id], $point);
        return 1 if abs ($length - $length_a - $length_b) < 0.000001;
    }
    return 0;
}

=item _divide_polygon

Returns a new polygon with all edges subdivided

   $polygon->_divide_polygon (4);

=cut

sub _divide_polygon
{
    my $self = shift;
    my $n = shift || 2;
    my @points = $self->points;
    my @out = ($points[0]);
    for my $id (0 .. scalar (@points) -2)
    {
        my $step = scale_2d (1/$n, subtract_2d ($points[$id+1], $points[$id]));
        for my $inc (1 .. $n)
        {
            my $vector = scale_2d ($inc, $step);
            my $point = add_2d ($points[$id], $vector);
            push @out, $point;
        }
    }

    my $out = Urb::Polygon->new (points => [@out]);
    return $out;
}

=item to_quads

Deconstruct polygon into overlapping quads, supply list of 'holes' if
necessary, holes don't need to be entirely within outside polygon

   my @quads = $polygon->to_quads ($hole_polygon);

=cut

sub to_quads
{
    my ($polygon, @inners) = @_;

    # make a list of the line-equations of all perimeter segments
    my @lines_all = map {$_->_lines} ($polygon, @inners);

    # iterate through all combinations of four lines
    my $shapes;
    for my $A (0 .. scalar @lines_all -1)
    {
      for my $B ($A +1 .. scalar @lines_all -1)
      {
        for my $C ($B +1 .. scalar @lines_all -1)
        {
          for my $D ($C +1 .. scalar @lines_all -1)
          {
            my $line_a = $lines_all[$A];
            my $line_b = $lines_all[$B];
            my $line_c = $lines_all[$C];
            my $line_d = $lines_all[$D];

            # get all possible intersections of these four lines
            my @corners;
            push @corners, line_intersection ($line_a,$line_b) unless $line_a->{a} == $line_b->{a};
            push @corners, line_intersection ($line_a,$line_c) unless $line_a->{a} == $line_c->{a};
            push @corners, line_intersection ($line_a,$line_d) unless $line_a->{a} == $line_d->{a};
            push @corners, line_intersection ($line_c,$line_b) unless $line_c->{a} == $line_b->{a};
            push @corners, line_intersection ($line_c,$line_d) unless $line_c->{a} == $line_d->{a};
            push @corners, line_intersection ($line_b,$line_d) unless $line_b->{a} == $line_d->{a};

            # discard any points outside the perimeter
            my @shape;
            for my $corner (@corners)
            {
                next unless ($polygon->contains ($corner) || $polygon->_is_on_polygon ($corner));
                push @shape, $corner;
            }
            # skip if we can't make a quadrilateral from these points
            next unless scalar @shape == 4;
     
            # arrange the four points in a non-crossing polygon
            my $shape_a = Urb::Polygon->new
                (points => [$shape[0], $shape[1], $shape[2], $shape[3], $shape[0]]);
            my $shape_b = Urb::Polygon->new
                (points => [$shape[0], $shape[1], $shape[3], $shape[2], $shape[0]]);
            my $shape_c = Urb::Polygon->new
                (points => [$shape[0], $shape[2], $shape[1], $shape[3], $shape[0]]);

            my @biggest_first = sort {$b->area <=> $a->area} ($shape_a, $shape_b, $shape_c);        
            my $shape = shift @biggest_first;

            # normalise this shape and save for later
            $shape->counterClockwise;
            $shape = $shape->startMinXY;
            push @{$shapes}, $shape;
          }
        }
      }
    }

    my $shapes_clean = [];

    my $lookup;

    my @polygon_gradients = ($polygon->_gradients, map {$_->_gradients} @inners);

    # loop to remove some obviously bogus polygons
    for my $shape (@{$shapes})
    {
        my $okayness = 1;

        # characterise this polygon and skip if already seen
        my $key = join '-', (map {join ':', map {sprintf ("%.3f", $_)} @{$_}} $shape->points);
        next if defined $lookup->{$key};
        $lookup->{$key} = 1;

        # all edges must be parallel to a perimeter edge
        for my $gradient ($shape->_gradients)
        {
            $okayness = 0 unless grep {/^$gradient$/x} @polygon_gradients;
        }
        next unless $okayness;

        # shape can't overlap an inner perimeter
        for my $inner (@inners)
        {
            my $inner_normalised = $inner->startMinXY;
            $inner_normalised->counterClockwise;
            $inner_normalised = $inner_normalised->simplify (slope => 0.001);
            $okayness = 0 if $shape->_overlaps ($inner_normalised);
            $okayness = 0 if $inner_normalised->_overlaps ($shape);
            $okayness = 0 if $shape->same ($inner_normalised);
        }
        # shape can't contain outer perimeter
        $okayness = 0 if $shape->_overlaps ($polygon);
        next unless $okayness;

        # shape shouldn't cover an outside area
        my $centre = scale_2d (0.5, add_2d (($shape->points)[0], ($shape->points)[2]));
        $okayness = 0 unless $polygon->contains ($centre);
        next unless $okayness;

        push @{$shapes_clean}, $shape if $okayness;
    }

    @{$shapes} = sort {$b->area <=> $a->area} @{$shapes_clean};

    $shapes_clean = [];

    # remove any shapes that are contained within larger shapes
    for my $shape (@{$shapes})
    {
        my $okayness = 1;
        for my $bigger (@{$shapes_clean})
        {
            $okayness = 0 if $shape->_is_contained_by ($bigger);
        }
        push @{$shapes_clean}, $shape if $okayness;
    }

    return @{$shapes_clean};
}

=item to_triangles

Deconstruct an anticlockwise polygon into a list of non-overlapping triangles.
Each triangle is a list of four (the last is the same as the first) node ids
from the polygon.

   my $triangles = $polygon->to_triangles;

=back

=cut

sub to_triangles
{
    my ($polygon) = @_;
    return [] if $polygon->isClockwise;
    my $victim = dclone ($polygon);

    my $triangles = [];
    while ($victim->nrPoints > 3)
    {
        my $triangle = $victim->_ear_clip;
        last unless $triangle;
        push @{$triangles}, $triangle;
    }

    my $lookup = {};
    for my $id (0 .. $polygon->nrPoints -2)
    {
        $lookup->{join ':', @{$polygon->point ($id)}} = $id;
    }

    my $triangles_byid = [];
    for my $triangle (@{$triangles})
    {
        my @byid = map {$lookup->{join ':', @{$_}}} ($triangle->points);
        push @{$triangles_byid}, [@byid];
    }
    return $triangles_byid;
}

sub _ear_clip
{
    my ($polygon) = @_;
    my $ids = {};
    for my $id (0 .. $polygon->nrPoints -3)
    {
        my $triangle = Math::Polygon->new ($polygon->point ($id),
                                           $polygon->point ($id+1),
                                           $polygon->point ($id+2),
                                           $polygon->point ($id));
        next if ($triangle->isClockwise and $triangle->area > 0.0000001);
        my $contains_point = 0;
        for my $id_point (0 .. $polygon->nrPoints -2)
        {
            next if ($id_point == $id or $id_point == $id+1 or $id_point == $id+2);
            $contains_point = 1 if $triangle->contains ($polygon->point($id_point));
        }
        next if $contains_point;

        if ($polygon->nrPoints == 4)
        {
            $polygon->{MP_points} = [];
            return $triangle;
        }
        else
        {
            if ($triangle->perimeter == 0 or $triangle->area == 0)
            {
                $ids->{$id} = 0.0;
            }
            else
            {
                # prefer fatter triangles to thinner triangles
                $ids->{$id} = $triangle->area / ($triangle->perimeter **2);
            }
        }
    }
    my @ids = sort {$ids->{$a} <=> $ids->{$b}} keys %{$ids};
    unless (scalar @ids)
    {
        say STDERR 'polygon unclippable';
        return undef
    }
    my $id = pop @ids;

    my $triangle = Math::Polygon->new ($polygon->point ($id),
                                       $polygon->point ($id+1),
                                       $polygon->point ($id+2),
                                       $polygon->point ($id));
    splice (@{$polygon->{MP_points}}, $id+1, 1);
    return $triangle;
}

1;
