package Urb::Dom::Output;

use strict;
use warnings;
use 5.010;

use Urb::Dom;
use Urb::Math qw /subtract_2d/;
use SVG;

use base qw /Urb::Dom/;

=head1 NAME

Urb::Dom::Output - Various output file formats

=head1 SYNOPSIS

Graphic output for a domestic building subclass of L<Urb::Quad>

=head1 DESCRIPTION

=head1 USAGE

Create a new Urb::Dom::Output object:

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

=over

=item Dot_Tree

Dump the quad binary tree as a GraphViz .gv/.dot file:

  print STDOUT $quad->Dot_Tree;

=cut

sub Dot_Tree
{
    my $self = shift;
    my $label = shift;
    my $string = '';
    my $fill = '#666666';
    if ($self->Is_Outside) {$fill = '#ddddff'}
    elsif ($self->Type =~ /^b/xi) {$fill = '#ff9999'}
    elsif ($self->Type =~ /^l/xi) {$fill = '#99ff99'}
    elsif ($self->Type =~ /^k/xi) {$fill = '#9999ff'}
    elsif ($self->Type =~ /^c/xi) {$fill = '#ffff99'}
    elsif ($self->Type =~ /^t/xi) {$fill = '#ff99ff'}

    $string .= '"'. $self->Level .'/'. $self->Id .' '. $self->Type .'" [color="'. $fill .'",style=filled];'. "\n" unless $self->Divided;
    return $string unless $self->Divided;
    $string .= "digraph G {\n" if ((!defined $self->Parent) and (!defined $self->Below));
    $string .= "label=\"$label\"\n" if (defined $label and not defined $self->Parent);
    $string .= '"'. $self->Level .'/'. $self->Id .' '. $self->Type .'"->"'. $self->Left->Level .'/'. $self->Left->Id .' '. $self->Left->Type .'";'. "\n";
    $string .= '"'. $self->Level .'/'. $self->Id .' '. $self->Type .'"->"'. $self->Right->Level .'/'. $self->Right->Id .' '. $self->Right->Type .'";'. "\n";
    $string .= $self->Left->Dot_Tree;
    $string .= $self->Right->Dot_Tree;
    $string .= $self->Above->Dot_Tree if ((!$self->Parent) and defined $self->Above);
    $string .= '}' if ((!defined $self->Parent) and (!defined $self->Below));
    return $string;
}

=item Dot_Net

Dump the quad graph as an undirected GraphViz .gv/.dot file:

  print STDOUT $quad->Dot_Net;

=cut

sub Dot_Net
{
    my $self = shift;
    my $label = shift;
    my $string = "strict graph G {\n";
    $string .= "label=\"$label\";\n" if defined $label;
    $string .= "graph [overlap=false];\n";

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

    for my $level ($self, $self->Levels_Above)
    {
        my $graph = $level->Graph (1.2);
        $level->Has_Circulation ($graph);
        for my $vertex ($graph->vertices)
        {
            my $fill = '#666666';
            if ($vertex->Is_Outside) {$fill = '#ddddff'}
            elsif ($vertex->Type =~ /^c/xi) {$fill = '#ffff99'}
            elsif ($vertex->Type =~ /^b/xi) {$fill = '#ff9999'}
            elsif ($vertex->Type =~ /^l/xi) {$fill = '#99ff99'}
            elsif ($vertex->Type =~ /^k/xi) {$fill = '#9999ff'}
            elsif ($vertex->Type =~ /^t/xi) {$fill = '#ff99ff'}
            $string .= '"'. $level->Level .'/'. $vertex->Id .'\n'. $vertex->Usage .'" [color="'. $fill .'",style=filled];'. "\n";

            # connect stair stacks
            if ($vertex->Level == 0)
            {
                my @corners_in_use = $vertex->Stack_Corners_In_Use (@graph_circ);

                my $entrances = $level->Entrances($graph);
                # does this leaf have an entrance door?
                if (defined $entrances->{$vertex->Id})
                {
                    my @entrance_corners;
                    for (0 .. 3)
                    {
                         # this will only catch external abcd boundaries
                         push (@entrance_corners, $_, $_+1) if ($vertex->Boundary_Id($_) eq $entrances->{$vertex->Id})
                    }
                    for my $entrance_corner (@entrance_corners)
                    {
                         push (@corners_in_use, $entrance_corner) unless grep /$entrance_corner/, @corners_in_use;
                    }
                }

                if (scalar @corners_in_use and $vertex->Is_Covered)
                {
                    my $stair_fit = $vertex->Stair_Fit ($vertex->Stair_Riser, $vertex->Stair_Width, @corners_in_use);
                    if ($stair_fit)
                    {
                        for my $quad ($vertex, $vertex->Levels_Above)
                        {
                            next unless scalar $quad->Levels_Above;
                            $string .= '"'. $quad->Level .'/'. $quad->Id .'\n'. $quad->Usage .'"--"'.
                            $quad->Above->Level .'/'. $quad->Above->Id .'\n'. $quad->Above->Usage .'" [label="Stair",style=dashed];'. "\n";
                        }
                    }
                }
            }
        }
        for my $edge ($graph->edges)
        {
            $string .= '"'. $level->Level .'/'. $edge->[0]->Id .'\n'. $edge->[0]->Usage .'"--"'. $level->Level .'/'. $edge->[1]->Id .'\n'. $edge->[1]->Usage .'"'
                .' [label="'. sprintf ("%.1f", $graph->get_edge_attribute (@{$edge}, 'width')) .'"];' ."\n";
        }

        my $entrances = $level->Entrances ($graph);
        for my $in (keys %{$entrances})
        {
            my $out = $entrances->{$in};

            if ($out =~ /^[abcd]/xi)
            {
                $string .= '"'. $level->Level .'/'. $in .'\n'. $level->By_Id($in)->Usage .'"--"'. $level->Level .'/'. $out .'\n'. 'Street' .'"'
                .' [label="Entry"];'. "\n";
            }
            else
            {
                $string .= '"'. $level->Level .'/'. $in .'\n'. $level->By_Id($in)->Usage .'"--"'. $level->Level .'/'. $out .'\n'. $level->By_Id($out)->Usage .'"'
                .' [label="Entry"];'. "\n";
            }
        }
    }
    $string .= '}';
    return $string;
}

=item SVG

Create an L<SVG> object representing the current quad and children:

  $svg = $quad->SVG;

..or append the quad and children to an existing SVG object:

  $svg = $quad->SVG ($svg, $min, $max);

$min and $max are the crop window to retrieve from the quad.

=cut

sub SVG
{
    my $self = shift;
    my $scale = 20;
    my $svg = shift || SVG->new (width => (($self->Max->[0] - $self->Min->[0] + $self->Levels_Above) * $scale),
                               height => (($self->Max->[1] - $self->Min->[1] + 1 + $self->Levels_Above) * $scale));
    my $min = shift || $self->Min;
    my $max = shift || $self->Max;
    my $height_c = $max->[1] - $min->[1];
    my $coor0 = subtract_2d ($self->Coordinate (0), $min);
    my $coor1 = subtract_2d ($self->Coordinate (1), $min);
    my $coor2 = subtract_2d ($self->Coordinate (2), $min);
    my $coor3 = subtract_2d ($self->Coordinate (3), $min);
    my $coor4 = subtract_2d ($self->Centroid, $min);
    my $points = $svg->get_path (-type => 'path', -closed => 'true',
        x => [$coor0->[0] * $scale, $coor1->[0] * $scale, $coor2->[0] * $scale, $coor3->[0] * $scale],
        y => [($height_c - $coor0->[1]) * $scale, ($height_c - $coor1->[1]) * $scale,
              ($height_c - $coor2->[1]) * $scale, ($height_c - $coor3->[1]) * $scale]); 

    my $opacity = 0.5;
    my $width = 0.2 * $scale;
    my $fill = "rgb(0,0,64)";
    if ($self->Is_Outside)
    {
        $opacity = 0.3;
        $width = 0.0;
    }
    elsif ($self->Type =~ /^b/xi)
    {
        $fill = "rgb(255,0,0)";
    }
    elsif ($self->Type =~ /^l/xi)
    {
        $fill = "rgb(0,255,0)";
    }
    elsif ($self->Type =~ /^k/xi)
    {
        $fill = "rgb(0,0,255)";
    }
    elsif ($self->Type =~ /^c/xi)
    {
        $fill = "rgb(255,255,0)";
    }
    elsif ($self->Type =~ /^t/xi)
    {
        $fill = "rgb(255,0,255)";
    }

    $svg->path (%$points,
                style => { 'fill-opacity' => $opacity,
                           'fill' => $fill,
                           'stroke-width' => $width,
                           'stroke' => "rgb(0,0,0)" })
        unless $self->Divided;

    $width = 0.2 * $scale;

    unless ($self->Parent)
    {
        for my $id (0 .. 3)
        {
            my $external = $self->Boundary_Id ($id);
            next unless (defined $self->Perimeter->{$external} and $self->Perimeter->{$external} =~ /^private$/xi);
            my $a = subtract_2d ($self->Coordinate (0 + $id), $min);
            my $b = subtract_2d ($self->Coordinate (1 + $id), $min);
            my $p = $svg->get_path (-type => 'path',
                x => [$a->[0] * $scale, $b->[0] * $scale],
                y => [($height_c - $a->[1]) * $scale, ($height_c - $b->[1]) * $scale]); 

                $svg->path (%$p,
                style => { 'stroke-width' => 0.12 * $scale,
                           'stroke' => "rgb(0,0,0)" })
        }
        $svg->text (x => $coor4->[0] * $scale, y => (($max->[1] - $min->[1] + 0.6) * $scale), 'text-anchor' => 'middle' )->text (-type=>'span',
                style => { 'font-family' => 'serif',
                           'font-size' => $width * 2.5,
                           'fill' => "rgb(0,0,64)" })->cdata ($self->Hash) unless $self->Below;
        $svg = $self->Above->SVG ($svg, subtract_2d ($min, [1,1]), subtract_2d ($max, [1,1])) if defined $self->Above;
    }

    $svg->text (x => $coor4->[0] * $scale, y => ($height_c - $coor4->[1]) * $scale, 'text-anchor' => 'middle' )->text (-type=>'span',
                style => { 'font-family' => 'serif',
                           'font-size' => $width * 2,
                           'fill' => "rgb(0,0,64)" })->cdata (join ' ', $self->Level .'/'. $self->Id, $self->Type)
        unless $self->Divided;

    for my $child (@{$self->{child}})
    {
        $svg = $child->SVG ($svg, $min, $max);
    }

    return $svg;
}

=item DXF

Assemble the quad and children as a DXF fragment, if the quad is the root then
add a DXF header too:

  $string = $quad->DXF;

=cut

sub DXF
{
    my $self = shift;
    my $width = 0.1;
    my $thickness = 2.4;
    my $id = $self->Id;
    my $coor0 = $self->Coordinate (0);
    my $coor1 = $self->Coordinate (1);
    my $coor2 = $self->Coordinate (2);
    my $coor3 = $self->Coordinate (3);
    my $coor4 = $self->Centroid;

    my $string;

    unless (defined $self->Parent)
    {
        $string .= _dxf (0, 'SECTION');
        $string .= _dxf (2, 'HEADER');
        $string .= _dxf (9, '$ACADVER');
        $string .= _dxf (1, 'AC1009');
        $string .= _dxf (0, 'ENDSEC');
        $string .= _dxf (0, 'SECTION');
        $string .= _dxf (2, 'ENTITIES');
    }

    unless ($self->Divided)
    {
        $string .= _dxf (0, 'POLYLINE');
        $string .= _dxf (8, 0);
        $string .= _dxf (66, 1);
        $string .= _dxf (10, 0.0);
        $string .= _dxf (20, 0.0);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (39, $thickness);
        $string .= _dxf (70, 1);
        $string .= _dxf (40, $width);
        $string .= _dxf (41, $width);
        $string .= _dxf (0, 'VERTEX');
        $string .= _dxf (8, 0);
        $string .= _dxf (10, $coor0->[0]);
        $string .= _dxf (20, $coor0->[1]);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (0, 'VERTEX');
        $string .= _dxf (8, 0);
        $string .= _dxf (10, $coor1->[0]);
        $string .= _dxf (20, $coor1->[1]);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (0, 'VERTEX');
        $string .= _dxf (8, 0);
        $string .= _dxf (10, $coor2->[0]);
        $string .= _dxf (20, $coor2->[1]);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (0, 'VERTEX');
        $string .= _dxf (8, 0);
        $string .= _dxf (10, $coor3->[0]);
        $string .= _dxf (20, $coor3->[1]);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (0, 'SEQEND');
        $string .= _dxf (0, 'TEXT');
        $string .= _dxf (8, 0);
        $string .= _dxf (10, $coor4->[0]);
        $string .= _dxf (20, $coor4->[1]);
        $string .= _dxf (30, 0.0);
        $string .= _dxf (40, 0.2);
        $string .= _dxf (1, $id);
    }

    for my $child (@{$self->{child}})
    {
        $string .= $child->DXF;
    }

    unless (defined $self->Parent)
    {
        $string .= _dxf (0, 'ENDSEC');
        $string .= _dxf (0, 'EOF');
    }

    return $string;
}

sub _dxf
{
    my ($key, $value) = @_;
    return " $key\n$value\n";
}

=item Pretty_Tree

Dump a quad binary tree in multiline format, optionally specify an indent string:

  print $quad->Pretty_Tree ('>');

=back

=cut

# FIXME test needed
sub Pretty_Tree
{
    my $self = shift;
    my $indent = shift || '';
    my $name = $self->Id;
    $name = $self->Level if $name eq '';
    my $string = $indent .'('. $name .')';
    $string .= ' '. $self->Usage if $self->Usage;
    $string .= ' Height='. $self->Height unless $self->Parent;
    $string .= ' Rotation='. $self->Rotation if $self->Divided;
    $string .= ' Area='. sprintf ("%.1f", $self->Area) unless $self->Divided;
    $string .= ' Width='. sprintf ("%.1f", $self->Length_Narrowest) unless $self->Divided;
    $string .= ' Covered' if $self->Is_Covered;
    $string .= ' Supported' if $self->Is_Supported;
    $string .= ' (LEAF)' unless $self->Divided;

    $string .= "\n";

    $string .= $self->Left->Pretty_Tree ($indent .'    ') if defined $self->Left;
    $string .= $self->Right->Pretty_Tree ($indent .'    ') if defined $self->Right;
    $string .= $self->Above->Pretty_Tree ($indent) if defined $self->Above and (!$self->Parent);
    return $string;
}

1;
