package Urb::Boundary;
use strict;
use warnings;
use 5.010;
use Math::Trig qw /:radial :pi/;
use Urb::Math qw /distance_2d angle_2d/;
use Scalar::Util qw/ weaken /;

=head1 NAME

Urb::Boundary - A division within a quadrilateral space

=head1 SYNOPSIS

Models a division within an Urb::Quad object and child quads that share this boundary

=head1 DESCRIPTION

A boundary is a division of a quad or the edge of the root quad, it is always a
straight line.  It has various leafnode quads attached to it.  The boundary
object is a list of references to these leafnodes in no particular order.

=head1 USAGE

=over

=item new

Create a new boundary object:

  $boundary = new Urb::Boundary;

=cut

sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $self = [];
    bless $self, $class;
    return $self;
}

sub DESTROY
{
    my $self = shift;
    for (@{$self})
    {
        undef $_->{quad};
    }
    $self = [];
    return;
}

=item Add_Edge

Attach a quad to this boundary, indicate which edge of the quad (0,1,2 or 3) is attached:

  $boundary->Add_Edge ($quad, 2);

=cut

# FIXME test needed
sub Add_Edge
{
    my ($self, $quad, $id_edge) = @_;
    push @{$self}, {quad => $quad, id_edge => $id_edge};
    weaken $self->[-1]->{quad};
    return;
}

=item Id

Query the Id of the quad of which this boundary is a division:

  $boundary->Id;

=cut

sub Id
{
    my $self = shift;
    return unless defined $self->[0];
    return $self->[0]->{quad}->Boundary_Id ($self->[0]->{id_edge});
}

=item Length_Total

Query the total length of this boundary:

  $boundary->Length_Total;

=cut

sub Length_Total
{
    my $self = shift;
    my $quad_parent = $self->[0]->{quad}->By_Id ($self->Id);
    return distance_2d ($quad_parent->Coordinate_a, $quad_parent->Coordinate_b);
}

=item Validate_Ids

Check some internal consistency:

  $boolean = $boundary->Validate_Ids;

=cut

sub Validate_Ids
{
    my $self = shift;
    my $id = $self->Id;
    for my $item (@{$self})
    {
        return 0 unless $id eq $item->{quad}->Boundary_Id ($item->{id_edge});
    }
    return 1;
}

=item Overlap

Given two quads, find out how much they overlap on this boundary, if at all:

  $distance = $boundary->Overlap ($quad_a, $quad_b);

=cut

sub Overlap
{
    my ($self, $quad_a, $quad_b) = @_;
    my ($edge_a, $edge_b);
    for my $item (@{$self})
    {
        $edge_a = $item->{id_edge} if $item->{quad} == $quad_a;
        $edge_b = $item->{id_edge} if $item->{quad} == $quad_b;
    }
    return 0.0 unless (defined $edge_a and defined $edge_b);
    return 0.0 if ($self->Id =~ /^[abcd]$/x);
    return 0.0 unless $quad_a->Boundary_Id ($edge_a) eq $self->Id;
    return 0.0 unless $quad_b->Boundary_Id ($edge_b) eq $self->Id;

    my $length_a = $quad_a->Length ($edge_a);
    my $length_b = $quad_b->Length ($edge_b);

    my $length = 0;
    my $d;
    $d = distance_2d ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b));
    $length = $d if $d > $length;
    $d = distance_2d ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b +1));
    $length = $d if $d > $length;
    $d = distance_2d ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b));
    $length = $d if $d > $length;
    $d = distance_2d ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b +1));
    $length = $d if $d > $length;

    return $length_a if $length <= $length_b;
    return $length_b if $length <= $length_a;

    return $length_a + $length_b - $length;
}

=item Coordinates

Query coordinates of the segment shared by two overlapping quads:

  ($xy1, $xy2) = $boundary->Coordinates ($quad_a, $quad_b);

=cut

sub Coordinates
{
    my ($self, $quad_a, $quad_b) = @_;
    my ($edge_a, $edge_b);
    for my $item (@{$self})
    {
        $edge_a = $item->{id_edge} if $item->{quad} == $quad_a;
        $edge_b = $item->{id_edge} if $item->{quad} == $quad_b;
    }
    return unless (defined $edge_a and defined $edge_b);
    return unless $quad_a->Boundary_Id ($edge_a) eq $self->Id;
    return unless $quad_b->Boundary_Id ($edge_b) eq $self->Id;
    return if $self->Overlap ($quad_a, $quad_b) <= 0;

    my $length_a = $quad_a->Length ($edge_a);
    my $length_b = $quad_b->Length ($edge_b);

    my $length = distance_2d ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b));
    my @coordinates = ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b +1));
    my $d = distance_2d ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b +1));
    if ($d > $length)
    {
        $length = $d;
        @coordinates = ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b));
    }
    $d = distance_2d ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b));
    if ($d > $length)
    {
        $length = $d;
        @coordinates = ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b +1));
    }
    $d = distance_2d ($quad_a->Coordinate ($edge_a +1), $quad_b->Coordinate ($edge_b +1));
    if ($d > $length)
    {
        $length = $d;
        @coordinates = ($quad_a->Coordinate ($edge_a), $quad_b->Coordinate ($edge_b));
    }

    # edge_a is contained entirely within edge_b
    @coordinates = ($quad_a->Coordinate ($edge_a), $quad_a->Coordinate ($edge_a +1)) if $length <= $length_b;
    # edge_b is contained entirely within edge_a
    @coordinates = ($quad_b->Coordinate ($edge_b), $quad_b->Coordinate ($edge_b +1)) if $length <= $length_a;
    # otherwise edge_a and edge_b partially overlap so we want the two inner points

    my $rad_quads = angle_2d ($quad_a->Centroid, $quad_b->Centroid);
    my $rad_edge = angle_2d ($coordinates[1], $coordinates[0]);
    my $rad = $rad_edge - $rad_quads;
    $rad += pi2 if $rad < 0;
    return @coordinates if $rad > pi;
    return reverse (@coordinates);
}

=item Bearing

Query perpendicular bearing between centre quad and boundary with other quad,
i.e. if this boundary is a wall, which direction does it face (east = 0.0,
north = 1.57):

  $radians = $boundary->Bearing ($quad_a, $quad_b);

=cut

sub Bearing
{
    my ($self, $quad_a, $quad_b) = @_;
    my ($coor_a, $coor_b) = $self->Coordinates ($quad_a, $quad_b);
    my $centroid = $quad_a->Centroid;

    my $angle_a = angle_2d ($centroid, $coor_a);
    my $angle_b = angle_2d ($centroid, $coor_b);

    my $angle = $angle_a - $angle_b;
    $angle += 2*pi while ($angle < 0.0);
    $angle -= 2*pi while ($angle > 2*pi);

    my $angle_wall = angle_2d ($coor_a, $coor_b);
    if ($angle < pi/2)
    {
        $angle_wall = angle_2d ($coor_b, $coor_a);
    }

    $angle_wall -= pi/2;
    $angle_wall += 2*pi while ($angle_wall < 0.0);

    return $angle_wall;
}

=item Middle

Query the mid point of an edge half way up:

  $coor = $boundary->Middle ($quad_a, $quad_b);

=cut

sub Middle
{
    my ($self, $quad_a, $quad_b) = @_;
    my ($coor_a, $coor_b) = $self->Coordinates ($quad_a, $quad_b);
    return [($coor_a->[0] + $coor_b->[0])/2, ($coor_a->[1] + $coor_b->[1])/2, $quad_a->Elevation + ($quad_a->Height/2)];
}

=item Pairs

Get a list of all pairs of quads that have a segment that is part of this boundary:

  $pairs = $boundary->Pairs;

=cut

sub Pairs
{
    my $self = shift;
    my $pairs = [];
    return $pairs if (defined $self->Id and $self->Id =~ /^[abcd]$/x);
    for my $index_a (0 .. scalar @{$self} -1)
    {
        for my $index_b ($index_a +1 .. scalar @{$self} -1)
        {
            my $overlap = $self->Overlap ($self->[$index_a]->{quad}, $self->[$index_b]->{quad});
            push @{$pairs}, [$self->[$index_a]->{quad}, $self->[$index_b]->{quad}]
                if $overlap > 0;
        }
    }
    return $pairs;
}

=item Pairs_By_Length

Get a list of all pairs as with Pairs(), but sorted by length of shared segment:

  $link = $boundary->Pairs_By_Length;

=back

=cut

sub Pairs_By_Length
{
    my $self = shift;
    my @list = sort {$self->Overlap ($a->[0], $a->[1]) <=> $self->Overlap ($b->[0], $b->[1])}
        @{$self->Pairs};
    return [@list];
}

1;
