package Urb::Dom;

use strict;
use warnings;
use 5.010;

use Urb::Quad;
use Urb::Field::Occlusion;
use Urb::Misc::Stairs qw /three_turn two_turn one_turn zero_turn risers_number ideal_going/;
use Urb::Math qw /gaussian/;

use base qw /Urb::Quad/;

=head1 NAME

Urb::Dom - Unit of Domestic architectural space

=head1 SYNOPSIS

A Domestic building subclass of L<Urb::Quad>

=head1 DESCRIPTION

Adds various methods appropriate to domestic buildings rather than generic architectural space.

=head1 USAGE

Create a new Urb::Dom object:

  $dom = Urb::Dom->new;
  $child = Urb::Quad->new ($dom);

=head2 Methods that operate on leaf nodes

=over

=item Type

What is the 'type' of the quad (a string not a class name):
This overrides the Urb::Quad->Type() method so we can default to 'Outside'

  $string = $quad->Type;

=cut

sub Type
{
    my $self = shift;
    my $type = shift || undef;
    $self->{type} = $type if defined $type;
    $self->{type} = 'O' unless ($self->Divided or (defined $self->{type} and $self->{type} =~ /./x));
    return $self->{type} if defined $self->{type};
    return '';
}

=item Perpendicular

Get a score for the perpendicularness of the corners of this quad:

  $score = $dom->Perpendicular (0.3);

parameter is sigma variation in radians from pi/2
set to 0.01 for very right-angle corners
set to 10 if you don't care

=cut

sub Perpendicular
{
    my $self = shift;
    my $sigma = shift;
    my @radian = map {$self->Angle ($_)} (0,1,2,3);
    my @score = map {gaussian ($_, 1.0, 1.570796, $sigma)} @radian;
    return $score[0] * $score[1] * $score[2] * $score[3];
}

=item Proportion

Get a score for the plan proportion of this quad:

  score = $dom->Proportion (1.5, 0.5);

Parameters are preferred aspect and sigma variation, i.e. 1 is a square, 2 is a
double square etc...

=cut

sub Proportion
{
    my ($self, $aspect, $sigma) = @_;
    my $self_aspect = $self->Aspect;
    return 1.0 if $self_aspect < $aspect;
    return gaussian ($self_aspect, 1.0, $aspect, $sigma);
}

=item Size

Get a score for the plan area of this quad:

  score = $dom->Size (12.0, 3.0);

Parameters are preferred area and sigma variation.

=cut

sub Size
{
    my ($self, $area, $sigma) = @_;
    return gaussian ($self->Area, 1.0, $area, $sigma);
}

=item Width

Get a score for the width of this quad:

  $score = $dom->Width (2.5, 0.2);

Parameters are preferred minimum width and sigma variation.

=cut

sub Width
{
    my ($self, $width, $sigma) = @_;
    my $self_width = $self->Length_Narrowest;
    return 1.0 if $self_width > $width;
    return gaussian ($self_width, 1.0, $width, $sigma);
}

=item Uncrinkliness

Get a score for the Uncrinkliness (Area/External wall):

  $score = $dom->Uncrinkliness ($graph, $occlusion, 0.9, 1);

Parameters are a Graph object, preferred uncrinkliness and sigma variation.

(uncrinkliness = 1 / crinkliness)

=cut

sub Uncrinkliness
{
    my ($self, $graph, $occlusion, $distance, $sigma) = @_;
    my $crinkliness = $self->Crinkliness ($graph, $occlusion);
    return 0 unless $crinkliness;
    return gaussian (1 / $crinkliness, 1.0, $distance, $sigma);
}

=item Is_Outside Is_Circulation

Query if the quad is 'Outdoors':

  $boolean = $dom->Is_Outside;

..or 'Circulation':

  $boolean = $dom->Is_Circulation;

=cut

sub Is_Outside
{
    my $self = shift;
    return 1 if $self->Type =~ /^[os]/xi;
    return 0;
}

sub Is_Circulation
{
    my $self = shift;
    return 0 unless $self->Is_Usable;
    return 1 if $self->Type =~ /^[cs]/xi;
    return 0;
}

=item Usage

Query an English string describing the use (Outside, Kitchen, Toilet, etc...), undef if not a leaf node:

  $text = $dom->Usage;

=cut

sub Usage
{
    my $self = shift;
    return if               $self->Divided;
    return unless           $self->Is_Usable;
    return 'Kitchen'     if $self->Type =~ /^k/xi;
    return 'Living'      if $self->Type =~ /^l/xi;
    return 'Bedroom'     if $self->Type =~ /^b/xi;
    return 'Toilet'      if $self->Type =~ /^t/xi;
    return 'Circulation' if $self->Type =~ /^c/xi;
    return 'Sahn'        if $self->Type =~ /^s/xi;
    return 'Outside'     if $self->Type =~ /^o/xi;
    return;
}

=item Is_Covered

Query if the quad is 'Covered', returns 1 if any leafs above are 'indoors', return 0 if all leafs above are 'outdoors':

  $boolean = $dom->Is_Covered;

=cut

# TODO tests
sub Is_Covered
{
    my $self = shift;
    my @above = $self->Above_Leafs;
    return 0 unless scalar @above;
    for my $above (@above)
    {
        return 1 if !$above->Is_Outside;
    }
    return 0;
}

=item Is_Supported Is_Unsupported

Query if the quad is 'supported', returns 1 if all leafs below are 'indoors':

  $boolean = $dom->Is_Supported;

..alternatively this returns 1 if no leafs below are 'indoors':

  $boolean = $dom->Is_Unsupported;

Other possibilities are that this quad is partially supported or that it is on the ground floor.

=cut

# TODO tests
sub Is_Supported
{
    my $self = shift;
    my @below = $self->Below_Leafs;
    return 0 unless scalar @below;
    for my $below (@below)
    {
        return 0 if $below->Is_Outside;
    }
    return 1;
}

sub Is_Unsupported
{
    my $self = shift;
    my @below = $self->Below_Leafs;
    return 0 unless scalar @below;
    for my $below (@below)
    {
        return 0 unless $below->Is_Outside;
    }
    return 1;
}

=item Is_Usable

Query if the quad is 'usable' i.e. is it indoors or on the ground floor or has building below

  $boolean = $dom->Is_Usable;

=cut

sub Is_Usable
{
    my $self = shift;
    return 1 unless $self->Is_Outside;
    return 1 unless scalar $self->Level;
    return 1 if $self->Is_Supported;
    return 0;
}

=item Stair_Fit

Given a max riser height, the stair width, and a list of corners that must be clear, can we fit the stair?

  $score = $dom->Stair_Fit (0.21, 1.25, 2, 3);

score is 1 if perfect fit, less than one for not enough space, and more than one for more than enough.

=cut

# FIXME assumes right-angled room, should offset perimeter by width and use for base/length

sub Stair_Fit
{
    my ($self, $max_riser, $width, @corners) = @_;

    my $risers = risers_number ($self->Height, $max_riser);
    my $going = ideal_going ($self->Height / $risers);
    my $base = $self->Length ($corners[0]);
    my $length = $self->Length ($corners[0] +1);

    my $going_a = int (($base - (2*$width)) / $going);
    my $going_b = 999;

    if (scalar @corners == 1)
    {
        $going_b = three_turn ($risers, $going_a);
    }
    elsif (scalar @corners == 2)
    {
        $going_b = two_turn ($risers, $going_a);
    }
    elsif (scalar @corners == 3)
    {
        $going_b = one_turn ($risers, $going_a);
    }
    elsif (scalar @corners == 4)
    {
        $going_b = zero_turn ($risers, $going_a);
    }
    return $length / (($width*2) + ($going*$going_b));
}

=item Plot_Ratio

Calculate the 'plot ratio', i.e an empty plot is 0.0, a single storey building
that fills the plot is 1.0, a four storey building that occupies half of the
plot is 2.0.

This is the gross internal floor area divided by the plot area.

  my $ratio = $dom->Plot_Ratio;

=cut

sub Plot_Ratio
{
    my $self = shift;
    return $self->Area_Internal / $self->Root->Lowest->Area;
}

=item Area_Internal

Calculate the gross internal floor area, i.e. add up the area of all rooms on
all floors.

  my $area = $dom->Area_Internal;

=cut

sub Area_Internal
{
    my $self = shift;
    my $base = $self->Root->Lowest;
    my $area = 0.0;
    for my $leaf (map {$_->Leafs} ($base, $base->Levels_Above))
    {  
        $area += $leaf->Area unless $leaf->Is_Outside;
    }
    return $area;
}

=item Stair_Riser Stair_Width

Access the maximum stair riser height allowed, and the width of stairs/landings

    my $max_riser = $dom->Stair_Riser;
    my $width = $dom->Stair_Width;

=cut

sub Stair_Riser
{
    my $self = shift;
    return 0.21 unless defined $self->Root->Lowest->{stair_riser};
    return $self->Root->Lowest->{stair_riser};
}

sub Stair_Width
{
    my $self = shift;
    return 1.25 unless defined $self->Root->Lowest->{stair_width};
    return $self->Root->Lowest->{stair_width};
}

=item Wall_Inner Wall_Outer Ceiling Floor Style

Access the interior offset for all walls, i.e. interior walls are twice this thickness:

    my $offset = $dom->Wall_Inner;

Access the exterior offset for walls:

    my $exterior_thickness = $dom->Wall_Inner + $dom->Wall_Outer;

Ceiling() is the depth of slab above and Floor() is the floor covering, so the headroom = Height()-Ceiling()-FLoor()

=cut

sub Wall_Inner
{
    my $self = shift;
    return 0.08 unless defined $self->Root->Lowest->{wall_inner};
    return $self->Root->Lowest->{wall_inner};
}

sub Wall_Outer
{
    my $self = shift;
    return 0.25 unless defined $self->Root->Lowest->{wall_outer};
    return $self->Root->Lowest->{wall_outer};
}

sub Ceiling
{
    my $self = shift;
    return 0.2 unless defined $self->Root->Lowest->{ceiling};
    return $self->Root->Lowest->{ceiling};
}

sub Floor
{
    my $self = shift;
    return 0.02 unless defined $self->Root->Lowest->{floor};
    return $self->Root->Lowest->{floor};
}

sub Style
{
    my $self = shift;
    return undef unless defined $self->Root->Lowest->{style};
    return $self->Root->Lowest->{style};
}

sub _serialise
{
    my $self = shift;
    my $item = shift;
    unless ($self->Parent or $self->Below)
    {
        $item->{stair_riser} = $self->{stair_riser} if defined $self->{stair_riser};
        $item->{stair_width} = $self->{stair_width} if defined $self->{stair_width};
        $item->{style} = $self->{style} if defined $self->{style};
        $item->{wall_inner} = $self->Wall_Inner;
        $item->{wall_outer} = $self->Wall_Outer;

        my @new_node = map {$self->Coordinate_Offset ($_ - $self->Rotation, $self->Wall_Outer)} (0 .. 3);
        $item->{node} = [@new_node];
    }
    return;
}

sub _deserialise
{
    my $self = shift;
    my ($item, $quad) = @_;
    $quad->{stair_riser} = $item->{stair_riser} if defined $item->{stair_riser};
    $quad->{stair_width} = $item->{stair_width} if defined $item->{stair_width};
    $quad->{style} = $item->{style} if defined $item->{style};
    $quad->{wall_inner} = $item->{wall_inner} if defined $item->{wall_inner};
    $quad->{wall_outer} = $item->{wall_outer} if defined $item->{wall_outer};
    if ($quad->Wall_Outer and not $quad->Parent and not $quad->Below)
    {
        my @new_node = map {$quad->Coordinate_Offset ($_ - $quad->Rotation, 0-$quad->Wall_Outer)} (0 .. 3);
        @{$quad->{node}} = @new_node;
    }
    return;
}

=back

=head2 Methods that query the network graph

=over

=item Has_Circulation

Query if all usable quads are accessible:

  $boolean = $dom->Has_Circulation ($graph);

Returns true if it is possible to get everywhere from everywhere. In the
process, unneeded links are deleted from the graph (e.g. bedroom-bedroom
links), unsupported quads are deleted altogether.

Doesn't check to see if the circulation system is singular.
See Connected_Circulation(), Connected_Outside() and Is_Connected_Above().

=cut

sub Has_Circulation
{
    my $self = shift;
    my $graph = shift;

    # remove all unusable nodes, i.e. outside nodes above outside nodes
    for my $vertex ($graph->vertices)
    {
        $graph->delete_vertex ($vertex) unless ($vertex->Is_Usable);
    }

    # remove connections between rooms that would never have doors
    for my $vertex ($graph->vertices)
    {
        # delete all connection between B and LKBT
        if ($vertex->Type =~ /^b/xi)
        {
            for my $neighbour ($graph->neighbours ($vertex))
            {
                $graph->delete_edge ($vertex, $neighbour)
                    if ($neighbour->Type =~ /^[lkbt]/xi);
                # FIXME, doesn't allow 'en-suite'
            }
        }
        # delete all connection between T and OLKT
        if ($vertex->Type =~ /^t/xi)
        {
            for my $neighbour ($graph->neighbours ($vertex))
            {
                $graph->delete_edge ($vertex, $neighbour)
                    if ($neighbour->Type =~ /^[olkt]/xi);
            }
        }
    }

    # some rooms only want one connection to the circulation network
    for my $vertex ($graph->vertices)
    {
        next unless ($vertex->Type =~ /^[btlk]/xi);
        my @neighbours = $graph->neighbours ($vertex);
        @neighbours = map {$_->Is_Circulation ? $_ : ()} @neighbours;
        @neighbours = sort {($graph->average_path_length ($a, undef) || 0) <=> ($graph->average_path_length ($b, undef) || 0)} @neighbours;
        # @neighbours is a list of adjacent circulation quads sorted by 'popular' first
        while (scalar @neighbours > 1)
        {
            # only want the least 'popular' circulation connection for B and T quads
            if ($vertex->Type =~ /^[bt]/xi)
            {
                my $neighbour = shift @neighbours;
                $graph->delete_edge ($vertex, $neighbour);
            }
            # only want the most 'popular' circulation connection for L and K quads
            elsif ($vertex->Type =~ /^[lk]/xi)
            {
                my $neighbour = pop @neighbours;
                $graph->delete_edge ($vertex, $neighbour);
            }
        }
    }

    # outside_connected_components is a list of lists, but referencing a _cloned_ version of the graph
    my $outside_graph = $graph->clone;
    $self->Connected_Outside ($outside_graph);
    my @outside_connected_components = $outside_graph->connected_components;

    # some indoor rooms will want a connection to adjacent outside nodes
    for my $vertex ($graph->vertices)
    {
        next unless ($vertex->Type =~ /^[blkc]/xi);
        my @neighbours = $graph->neighbours ($vertex);
        @neighbours = map {($_->Is_Outside and $_->Is_Usable) ? $_ : ()} @neighbours;
        @neighbours = sort {($graph->average_path_length ($a, undef) || 0) <=> ($graph->average_path_length ($b, undef) || 0)} @neighbours;

        # 'connected' is a list of usable outdoor nodes that connect to each other
        # but it references a cloned version of the graph
        for my $connected (@outside_connected_components)
        {
            my @neighbours_subset;
            for my $neighbour (@neighbours)
            {
                for my $in_outside_group (@{$connected})
                {
                    push @neighbours_subset, $neighbour if ($neighbour->Id eq $in_outside_group->Id);
                }
            }
            @neighbours = @neighbours_subset;

            # @neighbours is a list of adjacent outside quads sorted by 'popular' first
            while (scalar @neighbours > 1)
            {
                # only want the least 'popular' outside connection for B quads
                if ($vertex->Type =~ /^b/xi)
                {
                    my $neighbour = shift @neighbours;
                    $graph->delete_edge ($vertex, $neighbour);
                }
                # only want the most 'popular' outside connection for C, L and K quads
                elsif ($vertex->Type =~ /^[cslk]/xi)
                {
                    my $neighbour = pop @neighbours;
                    $graph->delete_edge ($vertex, $neighbour);
                }
            }

        }
    }
    return $graph->is_connected;
}

=item Connected_Circulation

Query if the graph forms a credible circulation network:

  $boolean = $dom->Connected_Circulation ($graph);

Returns true if all /^[cs]/ nodes are connected to each other.
In the process $graph is stripped of all but /^[cs]/ nodes.

=cut

sub Connected_Circulation
{
    my $self = shift;
    my $graph = shift;
    for my $vertex ($graph->vertices)
    {
        $graph->delete_vertex ($vertex) unless $vertex->Is_Circulation;
    }
    return $graph->is_connected;
}

=item Connected_Outside

Query if the graph forms a single circulation network of outdoor quads:

  $boolean = $dom->Connected_Outside ($graph);

Returns true if all /^o/ nodes are connected to each other.
In the process $graph is stripped of all but /^o/ nodes.

=cut

sub Connected_Outside
{
    my $self = shift;
    my $graph = shift;
    for my $vertex ($graph->vertices)
    {
        $graph->delete_vertex ($vertex) unless $vertex->Is_Outside and $vertex->Is_Usable;
    }
    return $graph->is_connected;
}

=item Stack_Corners_In_Use

Is this quad and the stack above it circulation? if so which corners are in use:

  @corners = $dom->Stack_Corners_In_Use ($circulation_graph_0, $circulation_graph_1 ... );

=cut

sub Stack_Corners_In_Use
{
    my ($self, @graph) = @_;
    return () unless $self->Type =~ /^c/xi;
    my @stack = ($self, $self->Levels_Above);
    return () if scalar @stack <= scalar $self->Root->Levels_Above;
    my $level_id = 0;
    my $corners_in_use;
    for my $dom (@stack)
    {
        return () unless $dom->Type =~ /^c/xi;
        my @ids = $dom->Corners_In_Use ($graph[$level_id], $graph[$level_id]->neighbours ($dom));
        @ids = map {$_ - $dom->Rotation + $self->Rotation} @ids;
        @ids = map {$_ > 3 ? $_ - 4 : $_} @ids;
        @ids = map {$_ < 0 ? $_ + 4 : $_} @ids;
        $corners_in_use->{$_} = 1 for (@ids);
        $level_id++;
    }
    my @list = sort keys %{$corners_in_use};
    return @list;
}

=item Length_Outside

Calculate length of outside wall, not including private plot boundaries:

  $length = $dom->Length_Outside ($graph);

Adds together length of edges connected to outside quads + edges on root quad boundary that are not private.

Note: Outside quads that are covered count as _inside_.

FIXME unused 2020-02

=cut

sub Length_Outside
{
    my $self = shift;
    my $graph = shift;
    my $length = 0;
    for my $neighbour ($graph->neighbours ($self))
    {
        next unless $neighbour->Is_Outside;
        next if $neighbour->Is_Covered;
        $length += $graph->get_edge_attribute ($self, $neighbour, 'width');
    }
    for my $id (0 .. 3)
    {
        my $external = $self->Boundary_Id ($id);
        next unless ($external =~ /^[abcd]$/x);
        my $external_type = $self->Root->Perimeter->{$external} || '';
        next if ($external_type =~ /^private$/xi);
        $length += $self->Length ($id);
    }
    return $length;
}

=item Area_Outside

Calculate illuminated area of outside wall, not including party-wall/private plot boundaries:

  $area = $dom->Area_Outside ($graph, $boundaries, $occlusion);

Adds together length of edges connected to outside quads + edges on root quad boundary that are not private.

Note: Outside quads that are covered count as _inside_.

This is equivalent to Length_Outside() multiplied by Height() multiplied by daylight factor

FIXME only used by Crinkliness() 2020-02

=cut

sub Area_Outside
{
    my $self = shift;
    my $graph = shift;
    my $boundaries = shift;
    my $occlusion = shift;
    my $length = 0;
    for my $neighbour ($graph->neighbours ($self))
    {
        next unless $neighbour->Is_Outside;
        next if $neighbour->Is_Covered;
        for my $key_boundary (keys %{$boundaries})
        {
            next if $boundaries->{$key_boundary}->Overlap ($self, $neighbour) <= 0;
            next if ($key_boundary =~ /^[abcd]$/x);

            my $coor = $boundaries->{$key_boundary}->Middle ($self, $neighbour);
            my $radians = $boundaries->{$key_boundary}->Bearing ($self, $neighbour);

            #result is illumination beteen 0.0 and 0.608335238775694
            my $illumination = $occlusion->CIEsky_vertical ($coor, $radians);
 
            $length += $graph->get_edge_attribute ($self, $neighbour, 'width') * $illumination / 0.608335238775694;
        }
    }
    for my $id (0 .. 3)
    {
        my $external = $self->Boundary_Id ($id);
        next unless ($external =~ /^[abcd]$/x);
        my $external_type = $self->Root->Perimeter->{$external} || '';
        next if ($external_type =~ /^private$/xi);
        next if ($external_type =~ /^fortified$/xi);

        my $coor = $self->Middle ($id);
        my $radians = $self->Bearing ($id);
        #result is illumination beteen 0.0 and 0.608335238775694
        my $illumination = $occlusion->CIEsky_vertical ($coor, $radians);
 
        $length += $self->Length ($id) * $illumination / 0.608335238775694;
    }
    return $length * $self->Height;
}

=item Crinkliness

Calculate crinkliness value of the quad:

  $crinkliness = $dom->Crinkliness ($graph, $occlusion);

External wall area / floor area

< 0.99, less daylight/window area
~ 1.00, external wall area = floor area
> 1.01, more daylight/window area

=cut

sub Crinkliness
{
    my $self = shift;
    my $graph = shift;
    my $occlusion = shift;
    # boundaries get calculated and cached in Walls() method when called by Occlusion() method
    my $boundaries = $self->Root->{boundaries};
    my $area_outside_wall_factored = $self->Area_Outside ($graph, $boundaries, $occlusion);
    return 9999999999 unless $self->Area;
    return $area_outside_wall_factored / $self->Area;
}

=item Neighbour_Types

Get a list of usable neighbour types for this quad:

  @list = $self->Neighbour_Types ($graph);

=cut

sub Neighbour_Types
{
    my $self = shift;
    my $graph = shift;

    my @usable_neighbours;
    for my $neighbour ($graph->neighbours ($self))
    {
        push (@usable_neighbours, $neighbour) if $neighbour->Is_Usable;
    }
    my @list = sort (map {$_->Type} @usable_neighbours);
    return @list;
}

=item Access

Get a list of useful circulation or access neighbour types:

  @list = $dom->Access ($graph);

i.e. is this quad connected to a circulation space?

=cut

sub Access
{
    my $self = shift;
    my $graph = shift;
    my @neighbour_types = $self->Neighbour_Types ($graph);
    if ($self->Type =~ /^k/xi)
    {
        return grep {/^[lcs]/xi} @neighbour_types;
    }
    elsif ($self->Is_Outside)
    {
        return @neighbour_types;
    }
    elsif ($self->Is_Circulation)
    {
        return @neighbour_types;
    }
    else
    {
        return grep {/^[cs]/xi} @neighbour_types;
    }
}

=item Access_Outside

Get a list of outdoor neighbours:

  @list = $dom->Access_Outside ($graph);

Returns useful o connections.

=cut

sub Access_Outside
{
    my $self = shift;
    my $graph = shift;
    return grep {/^[os]/xi} $self->Neighbour_Types ($graph);
}

=item Access_Living

Get a list of 'living' neighbours:

  @list = $dom->Access_Living ($graph);

Returns useful l connections.

=cut

sub Access_Living
{
    my $self = shift;
    my $graph = shift;
    return grep {/^l/xi} $self->Neighbour_Types ($graph);
}

=item Access_Rooms

Get a list of 'living', 'kitchen' or 'bedroom' neighbours:

  @list = $dom->Access_Rooms ($graph);

i.e. there is no point having usable outdoor space that is only accessible via a toilet

=cut

sub Access_Rooms
{
    my $self = shift;
    my $graph = shift;
    return grep {/^[lkb]/xi} $self->Neighbour_Types ($graph);
}

=item Access_External

Get a list of plot boundary edges for this quad if any:

  @list = $dom->Access_External;

Returns connections outside root quad.

=cut

sub Access_External
{
    my $self = shift;
    my @list;
    push @list, sort (grep {/^[abcd]$/x} map {$self->Boundary_Id ($_)} (0 .. 3));
    return @list;
}

=item Public_Access_Outside

Is this quad a suitable entrance transition?:

  $dom->Public_Access_Outside ($graph);

Succeeds if quad is a leafnode, is outside, has a non-private boundary edge and has an inside neighbour

=cut

sub Public_Access_Outside
{
    my $self = shift;
    my $graph = shift;
    # needs to be a leafnode
    return () if $self->Divided;
    # needs to be an 'outside' quad
    return () unless $self->Is_Outside;
    # needs to be bounded by a street
    return () unless $self->Public_Access;
    # needs a public inside quad neighbour
    return grep {/^[lck]/xi} $self->Neighbour_Types ($graph);
}

=item Public_Access

Is this quad on the street edge?:

  $dom->Public_Access;

Succeeds if quad is on ground floor, is a leafnode, and has a non-private
external boundary edge i.e. is bounded by a street

=cut

sub Public_Access
{
    my $self = shift;
    # needs to be a leafnode
    return undef if $self->Level;
    return undef if $self->Divided;
    # needs to have public boundary edge
    for my $external ($self->Access_External)
    {
        my $external_type = $self->Root->Perimeter->{$external} || '';
        next if ($external_type =~ /^private$/xi);
        return $external;
    }
    return undef;
}

=item Entrances

Query the entrance route. Can be just a room opening directly onto the street or a room opening onto a outdoor space, and the outdoor space opening onto the street:

  my $hash_ref = $root->Entrances ($graph);

(prefers a non-stair circulation space opening onto outdoor space then onto street, last best is kitchen opening directly onto street, will consider anything in-between)

=cut

sub Entrances
{
    my $self = shift;
    my $graph = shift;
    return {} if ($self->Parent or $self->Level);

    my @graph_circ;
    for my $level ($self, $self->Levels_Above)
    {
        my $graph_clone = $graph->clone;
        $level->Has_Circulation ($graph_clone);
        push @graph_circ, $graph_clone;
    }

    my $results;
    my $inc = 0.0;
    for my $leaf ($self->Leafs)
    {
        # entrance will *never* be into bedroom, toilet or sahn spaces
        next unless grep /^[lck]/xi, $leaf->Type;

        my @corners_in_use = $leaf->Stack_Corners_In_Use (@graph_circ);
        my $is_stairs = 0;
        $is_stairs = 1 if ($leaf->Type =~ /^[c]/xi and scalar (@corners_in_use) and $leaf->Is_Covered
                and $leaf->Stair_Fit ($leaf->Stair_Riser, $leaf->Stair_Width, @corners_in_use));

        # street-edge rooms are suitable for entrances
        # prefer entry via a lobby, stairs, living then kitchen
        if ($leaf->Public_Access)
        {
            if ($leaf->Type =~ /^[c]/xi and !$is_stairs)
            {
                $results->{4+$inc}->{$leaf->Id} = $leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[c]/xi and $is_stairs)
            {
                $results->{3+$inc}->{$leaf->Id} = $leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[l]/xi)
            {
                $results->{2+$inc}->{$leaf->Id} = $leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[k]/xi)
            {
                $results->{1+$inc}->{$leaf->Id} = $leaf->Public_Access;
            }
            $inc += 0.01;
        }

        # entrance would be better via a street-edge outdoor space
        # prefer entry via a lobby, stairs, living then kitchen
        my @outdoor_neighbours = map {grep (/^[o]/xi, $_->Type) and $_->Public_Access ? $_ : ()}
            $graph->neighbours ($leaf);
        for my $outdoor_leaf (@outdoor_neighbours)
        {
            next unless $outdoor_leaf;
            if ($leaf->Type =~ /^[c]/xi and !$is_stairs)
            {
                $results->{4.5+$inc}->{$leaf->Id} = $outdoor_leaf->Id;
                $results->{4.5+$inc}->{$outdoor_leaf->Id} = $outdoor_leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[c]/xi and $is_stairs)
            {
                $results->{3.5+$inc}->{$leaf->Id} = $outdoor_leaf->Id;
                $results->{3.5+$inc}->{$outdoor_leaf->Id} = $outdoor_leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[l]/xi)
            {
                $results->{2.5+$inc}->{$leaf->Id} = $outdoor_leaf->Id;
                $results->{2.5+$inc}->{$outdoor_leaf->Id} = $outdoor_leaf->Public_Access;
            }
            elsif ($leaf->Type =~ /^[k]/xi)
            {
                $results->{1.5+$inc}->{$leaf->Id} = $outdoor_leaf->Id;
                $results->{1.5+$inc}->{$outdoor_leaf->Id} = $outdoor_leaf->Public_Access;
            }
            $inc += 0.01;
        }
    }
    my @keys_sorted = sort (keys %{$results});
    return {} unless scalar @keys_sorted;
    return $results->{pop @keys_sorted};
}

=item Public_Length Private_Length

Get the length of street boundary for this quad:

  $length = $dom->Public_Length;

Returns length of street edge on this quad

Note: only ground floor has street edge

Similarly length of non-street boundary:

  $length = $dom->Private_Length;

=cut

sub Public_Length
{
    my $self = shift;
    my $length = 0.0;
    return $length if $self->Level;
    for my $external ($self->Access_External)
    {
        my $external_type = $self->Root->Perimeter->{$external} || '';
        next if ($external_type =~ /^private$/xi);
        for my $index (0 .. 3)
        {
            next unless $self->Boundary_Id ($index) eq $external;
            $length += $self->Length ($index);
        }
    }
    return $length;
}

sub Private_Length
{
    my $self = shift;
    my $length = 0.0;
    return $length if $self->Level;
    for my $external ($self->Access_External)
    {
        my $external_type = $self->Root->Perimeter->{$external} || '';
        next if ($external_type !~ /^private$/xi);
        for my $index (0 .. 3)
        {
            next unless $self->Boundary_Id ($index) eq $external;
            $length += $self->Length ($index);
        }
    }
    return $length;
}

=item Ratios

Assemble a table of relative area ratios of different 'types':

  $ratios = $dom->Ratios;

Note, these areas add up to 1.0.

=cut

sub Ratios
{
    my $self = shift;
    my ($area_all, $areas) = $self->Areas;
    my $ratios = \%{$areas};

    for my $key (keys %{$ratios}) { $ratios->{$key} /= $area_all }
    return $ratios;
}

=item Areas

Calculate total area and assemble a table of relative areas of different 'types':

  ($area_all, $areas) = $dom->Areas;

Note, these are absolute areas in world units, outdoor area includes usable space on all levels.

=cut

sub Areas
{
    my $self = shift;
    my $areas;
    my $area_all = 0.0;
    for my $leaf (map {$_->Leafs} ($self, $self->Levels_Above))
    {
        next unless $leaf->Is_Usable;
        $area_all += $leaf->Area;
        my $type = $leaf->Type;
        $areas->{$type} = 0.0 unless defined $areas->{$type};
        $areas->{$type} += $leaf->Area;
    }
    return ($area_all, $areas);
}

=item Count

Assemble a table of the numbers of each 'type' of quad:

  $count = $dom->Count;

=cut

sub Count
{
    my $self = shift;
    my $count;
    for my $leaf (map {$_->Leafs} ($self, $self->Levels_Above))
    {
        my $type = lc ($leaf->Type);
        $type =~ s/^(.).*/$1/x;
        push @{$count->{$type}}, $leaf->Id;
    }
    return $count;
}

=item Merge_Divided

Remove superflous divisions in outdoor areas, this recurses, so it can be
applied to all quads by applying to the root quad of the lowest level:

  $dom->Merge_Divided;

=cut

sub Merge_Divided
{
    my $self = shift;
    $self->Left->Merge_Divided if ($self->Divided);
    $self->Right->Merge_Divided if ($self->Divided);
    $self->Above->Merge_Divided if ((!$self->Parent) and $self->Levels_Above);
    if ($self->Is_Supported and $self->Divided and $self->Left->Type =~ /^[o]/xi and $self->Right->Type =~ /^[o]/xi)
    {
        $self->Undivide;
        $self->Type ('O');
    }
    elsif ($self->Is_Supported and $self->Divided and $self->Left->Type =~ /^[os]/xi and $self->Right->Type =~ /^[os]/xi)
    {
        $self->Undivide;
        $self->Type ('S');
    }
    elsif ($self->Is_Unsupported and $self->Divided and $self->Left->Type =~ /^[os]/xi and $self->Right->Type =~ /^[os]/xi)
    {
        $self->Undivide;
        $self->Type ('O');
    }
    elsif (!$self->Level and $self->Divided and $self->Left->Type =~ /^[os]/xi and $self->Right->Type =~ /^[os]/xi)
    {
        $self->Undivide;
        $self->Type ('S');
    }
    return;
}

=item Split_Undivided_Up

Divide outdoor quads to match division of levels below

  $dom->Split_Undivided_Up;

=cut

sub Split_Undivided_Up
{
    my $self = shift;
    if ((!$self->Divided) and defined $self->Root->Below and defined $self->Root->Below->By_Id ($self->Id) and $self->Below->Divided and $self->Is_Outside)
    {
        #if ($self->Below->Left->Is_Outside or $self->Below->Right->Is_Outside)
        if (!$self->Is_Supported or !$self->Is_Unsupported)
        {
            $self->Divide (0.5, 0.5);
            $self->Left->Type ($self->Type);
            $self->Right->Type ($self->Type);
        }
    }
    $self->Left->Split_Undivided_Up if ($self->Divided);
    $self->Right->Split_Undivided_Up if ($self->Divided);
    $self->Above->Split_Undivided_Up if ((!$self->Parent) and $self->Levels_Above);
    return;
}

=item Split_Undivided_Down

Divide outdoor and circulation quads to match division of levels above

  $dom->Split_Undivided_Down

=cut

sub Split_Undivided_Down
{
    my $self = shift;
    if ((!$self->Divided) and defined $self->Root->Above and defined $self->Root->Above->By_Id ($self->Id) and $self->Above->Divided and $self->Is_Outside)
    {
        if ($self->Above->Left->Is_Outside or $self->Above->Right->Is_Outside)
        {
            $self->Divide (0.5, 0.5);
            $self->Left->Type ($self->Type);
            $self->Right->Type ($self->Type);
        }
    }
    $self->Left->Split_Undivided_Down if ($self->Divided);
    $self->Right->Split_Undivided_Down if ($self->Divided);
    $self->Below->Split_Undivided_Down if ((!$self->Parent) and $self->Levels_Below);
    return;
}

=item Occlusion

Build an occlusion field for this quad, overlay an optional external occlusion
field, result is an Urb::Field::Occlusion object:

  my $occlusion = $dom->Occlusion ($overlay);

=cut

sub Occlusion
{
    my $self = shift;
    my $overlay = shift;

    my $min_x = int ($self->Min->[0]);
    my $min_y = int ($self->Min->[1]);
    my $min_z = int ($self->Elevation);

    my $occlusion = Urb::Field::Occlusion->new;
    $occlusion = Urb::Field::Occlusion->new ($overlay) if defined $overlay;
    $occlusion->{origin} = [$min_x, $min_y, $min_z];

    return $occlusion;
}

=item Walls

Get a list of external wall elements [$xyz_a, $xyz_b, $type], ...;

$type is one of 'private', 'public', 'party';

  @walls = $dom->Walls;

Note: order of list is derived from Graph and will not be consistent

=back

=cut

sub Walls
{
    my $self = shift;
    my @walls;

    for my $dom ($self, $self->Levels_Above)
    {
        my $boundaries = $dom->Calc_Boundaries;
        my $graph = $dom->Graph (1.2);
        my $elevation = $dom->Elevation;
        my $height = $dom->Height;

        for my $vertex ($graph->vertices)
        {  
            for my $neighbour ($graph->neighbours ($vertex))
            {
                for my $key_boundary (keys %{$boundaries})
                {
                    next if $boundaries->{$key_boundary}->Overlap ($vertex, $neighbour) <= 0;
                    next unless ($vertex->Is_Outside); 
                    next if ($neighbour->Is_Outside);
                    my @coordinates = $boundaries->{$key_boundary}->Coordinates ($vertex, $neighbour);
                    push @walls, [[@{$coordinates[0]}, $elevation +0],
                                  [@{$coordinates[1]}, $elevation + $height],
                                  'private'];
                }
            }
            for my $id (0 .. 3)
            {  
                my $external = $vertex->Boundary_Id ($id);
                next unless ($external =~ /^[abcd]$/x);
                my $perimeter = $vertex->Root->Perimeter->{$external} || '';
                my $type = 'public';
                $type = 'party' if $perimeter =~ /private/xi;

                next if ($vertex->Is_Outside);
                push @walls, [[@{$vertex->Coordinate ($id)}, $elevation +0],
                              [@{$vertex->Coordinate ($id +1)}, $elevation + $height],
                                $type];
            }
        }
    }
    return @walls;
}

1;
