#!/usr/bin/perl

use strict;
use warnings;
use lib qw/lib/;
use Urb::Dom;
use Urb::Polygon;
use YAML;
use Graph;
use Math::Trig;
use Urb::Math qw /distance_2d add_2d scale_2d is_between_2d angle_2d/;
use Urb::Misc::Stairs qw /risers_number ideal_going/;
use Molior;
use Digest::MD5;
use File::Spec::Functions qw /rel2abs splitpath splitdir/;
use 5.010;

my $dom_all = Urb::Dom->new;
$dom_all->Deserialise (YAML::LoadFile ($ARGV[0]));

$dom_all->Merge_Divided;
$dom_all->Split_Undivided_Up;
$dom_all->Highest->Split_Undivided_Down;

# colours

my $colour_wall_outside = _colour (join ':', @{$dom_all->Centroid});
my $colour_wall_inside = 51;
my $colour_floor_inside = 119;
my $colour_floor_outside = 38;
my $colour_molding = 255;
my $colour_pergola = 33;
my $colour_roof = 250;

my $guid = $dom_all->Hash_Site;

my ($vol, $dirs, $filename) = splitpath (rel2abs ($ARGV[0]));
my @split_dirs = splitdir ($dirs);
pop @split_dirs if $split_dirs[-1] eq '';
my $plot_name = pop @split_dirs;

my $yaml_id = 0;
my $path_molior = undef;
$path_molior = $ARGV[1] if defined $ARGV[1];
my @molior_all;

{
    my $molior = Molior->new ({ type => 'molior-plot', guid => $guid,
                           elevation => $dom_all->Elevation,
                                path => [map {$dom_all->Coordinate ($_)} 0 .. 3],
                                name => $plot_name,
                               style => $dom_all->Style,
                              closed => 1 });

    push(@molior_all, $molior->Serialise) if $path_molior;
    $molior->Write ("plot-$yaml_id.molior") unless $path_molior;
    $yaml_id++;
}

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

my $entrances = $dom_all->Entrances ($dom_all->Graph (1.2));

for my $dom ($dom_all, $dom_all->Levels_Above)
{
    my $boundaries = $dom->Calc_Boundaries;
    my $graph = $dom->Graph();
    my $elevation = $dom->Elevation;
    my $height = $dom->Height;
    my $outer = $dom->Wall_Outer;
    my $inner = $dom->Wall_Inner;

    my $graph_envelope = Graph->new (directed => 1);
    my $graph_partywall = Graph->new (directed => 1);
    my $graph_private = Graph->new (directed => 1);
    my $graph_private_covered = Graph->new (directed => 1);
    my $graph_covered = Graph->new (directed => 1);
    my $graph_public = Graph->new (directed => 1);
    my $graph_roofline = Graph->new (directed => 1);
    my $graph_parapet = Graph->new (directed => 1);
    my $graph_parapet_internal = Graph->new (directed => 1);
    my $graph_parapet_party = Graph->new (directed => 1);
    my $graph_parapet_street = Graph->new (directed => 1);
    my $graph_pergola = Graph->new (directed => 1);
    my $graph_pergola_internal = Graph->new (directed => 1);

    my $graph_internal = Graph->new (undirected => 1);

    # hash keys are 2d line definitions:                   1.23000:2.34000-4.56000:5.78000
    # values are Urb::Dom objects of either side of line:  [$dom1, $dom2];
    my $lookup;

    # hash keys are 2d coordinates:                        1.23000:2.34000
    my $coor_doors_here;

    for my $vertex ($graph->vertices)
    {  
        # iterate through all the internal edges on this level
        for my $neighbour ($graph->neighbours ($vertex))
        {
            for my $key_boundary (keys %{$boundaries})
            {
                my $overlap = $boundaries->{$key_boundary}->Overlap ($vertex, $neighbour);
                next if $overlap <= 0;
                my @coordinates = $boundaries->{$key_boundary}->Coordinates ($vertex, $neighbour);
                next unless defined $coordinates[0];
                my $node0 = join ':', @{$coordinates[0]};
                my $node1 = join ':', @{$coordinates[1]};

                $lookup->{$node0.'-'.$node1} = [$vertex->Id, $neighbour->Id];

                # zero length links result in infinite loops
                next if $node0 eq $node1;
                # indoors facing outside
                if ((!$vertex->Is_Outside) and $neighbour->Is_Outside)
                {
                    $graph_envelope->add_edge ($node0, $node1);
                    $graph_roofline->add_edge ($node0, $node1) unless scalar $dom->Levels_Above;
                }
                # indoors bounding another room
                elsif (!$vertex->Is_Outside)
                {
                    $graph_internal->add_edge ($node0, $node1);
                }
                # upper storey outdoor space bounding a void
                if ($vertex->Is_Outside and $neighbour->Is_Outside and $vertex->Is_Supported and (!$neighbour->Is_Supported))
                {
                    $graph_parapet->add_edge ($node0, $node1);
                    $graph_parapet_internal->add_edge ($node0, $node1);
                    $graph_pergola->add_edge ($node0, $node1);
                }
                # covered outdoor space bounding uncovered outdoor space
                if ($vertex->Is_Outside and $neighbour->Is_Outside and $vertex->Is_Covered and (!$neighbour->Is_Covered))
                {
                    $graph_covered->add_edge ($node0, $node1);
                }
                # any upper storey outdoor space open above not bounding the building
                if ($vertex->Is_Outside and $vertex->Is_Supported and !$vertex->Is_Covered
                  and $neighbour->Is_Outside and $neighbour->Is_Supported and !$neighbour->Is_Covered)
                {
                    $graph_pergola_internal->add_edge ($node0, $node1);
                }
            }
        }

        # iterate through all external edges on this level
        for my $id (0 .. 3)
        {  
            my $external = $vertex->Boundary_Id ($id);
            next unless ($external =~ /^[abcd]$/x);
            my $external_type = $vertex->Root->Perimeter->{$external} || '';
            my $node0 = join ':', @{$vertex->Coordinate ($id)};
            my $node1 = join ':', @{$vertex->Coordinate ($id +1)};

            $lookup->{$node0.'-'.$node1} = [$vertex->Id, $external];

            if ($vertex->Is_Outside and $vertex->Is_Usable)
            {
                # outdoor space open above bounding another plot
                $graph_private->add_edge ($node0, $node1)
                    if ($external_type eq 'private' and (!$vertex->Is_Covered));
                # outdoor space open above facing the street
                $graph_public->add_edge  ($node0, $node1)
                    if ($external_type ne 'private' and (!$vertex->Is_Covered));

                # covered outdoor space bounding another plot
                $graph_private_covered->add_edge ($node0, $node1)
                    if ($external_type eq 'private' and $vertex->Is_Covered);
                # covered outdoor space facing the street
                $graph_covered->add_edge ($node0, $node1)
                    if ($external_type ne 'private' and $vertex->Is_Covered);

                # any upper storey outdoor space
                $graph_parapet->add_edge ($node0, $node1)
                    if ($vertex->Level);
                # upper storey outdoor space bounding another plot
                $graph_parapet_party->add_edge ($node0, $node1)
                    if ($external_type eq 'private' and $vertex->Level);
                # upper storey outdoor space facing the street
                $graph_parapet_street->add_edge ($node0, $node1)
                    if ($external_type ne 'private' and $vertex->Level);

                # any upper storey outdoor space open above bounding the plot
                $graph_pergola->add_edge ($node0, $node1)
                    if ($vertex->Level and (!$vertex->Is_Covered));
            }
            elsif ($vertex->Is_Outside) {}
            elsif ($external_type eq 'private')
            {
                $graph_partywall->add_edge ($node0, $node1);
                $graph_roofline->add_edge ($node0, $node1) unless scalar $dom->Levels_Above;
            }
            else
            {
                $graph_envelope->add_edge ($node0, $node1);
                $graph_roofline->add_edge ($node0, $node1) unless scalar $dom->Levels_Above;
            }
        }
        my $is_stair = 0;

        # is part of a stair stack?
        if ($vertex->Type =~ /^c/xi and (!$vertex->Lowest->Level))
        {{
            my @corners_in_use = $vertex->Lowest->Stack_Corners_In_Use (@graph_circ);
            next unless scalar @corners_in_use;

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

            $coor_doors_here->{join ':', @{$vertex->Coordinate ($_)}} = 1 for (@corners_in_use);

            $is_stair = 1;
            next unless $vertex->Is_Covered;
            my $stair_width = $vertex->Stair_Width;
            $stair_width = $vertex->Length_Narrowest * 0.5 if $stair_width > $vertex->Length_Narrowest * 0.5;
            my $risers = risers_number ($height, $vertex->Stair_Riser);

            my $molior = Molior->new ({type => 'molior-stair', guid => $guid, id => $vertex->Id,
                                       name => $vertex->Level,
                                      style => $vertex->Style,
                                  elevation => $elevation,
                                       path => [map {$vertex->Coordinate ($_)} 0 .. 3],
                                     height => $height,
                                    ceiling => $vertex->Ceiling,
                                      floor => $vertex->Floor,
                                      inner => $inner,
                                     closed => 1,
                                     colour => $colour_floor_inside,
                                      level => $vertex->Level,
                                       plot => $plot_name,
                                     risers => $risers,
                                      going => ideal_going ($height / $risers),
                                      width => $stair_width,
                             corners_in_use => [@corners_in_use]});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("stair-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }}

        # ceiling
        if (not $vertex->Is_Outside or ($vertex->Is_Outside and $vertex->Is_Covered))
        {{
            next if ($is_stair and $vertex->Is_Covered);
            my $molior = Molior->new ({type => 'molior-ceiling', guid => $guid, id => $vertex->Id,
                                       name => lc ($vertex->Usage),
                                      style => $vertex->Style,
                                  elevation => $elevation,
                                       path => [map {$vertex->Coordinate ($_)} 0 .. 3],
                                     height => $height,
                                    ceiling => $vertex->Ceiling,
                                      inner => $inner,
                                     closed => 1,
                                      level => $vertex->Level,
                                       plot => $plot_name,
                                     colour => $colour_wall_inside});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("ceiling-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }}

        # space
        {{
            my $usage = $vertex->Usage;
            next unless $usage;
            $usage = 'Stair' if $is_stair;
            my $molior = Molior->new ({type => 'molior-space', guid => $guid, name => $vertex->Id,
                                         id => $vertex->Id,
                                      style => $vertex->Style,
                                  elevation => $elevation,
                                       path => [map {$vertex->Coordinate ($_)} 0 .. 3],
                                     height => $height,
                                    ceiling => $vertex->Ceiling,
                                      floor => $vertex->Floor,
                                      inner => $inner,
                                     closed => 1,
                                      level => $vertex->Level,
                                       plot => $plot_name,
                                      usage => $usage});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("space-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }}

        # floor
        unless ($vertex->Is_Outside)
        {{
            next if ($is_stair and $vertex->Is_Supported);
            my $molior = Molior->new ({type => 'molior-floor', guid => $guid, id => $vertex->Id,
                                       name => lc ($vertex->Usage),
                                      style => $vertex->Style,
                                  elevation => $elevation,
                                       path => [map {$vertex->Coordinate ($_)} 0 .. 3],
                                     height => $height,
                                      floor => $vertex->Floor,
                                      inner => $inner,
                                     closed => 1,
                                      level => $vertex->Level,
                                       plot => $plot_name,
                                     colour => $colour_floor_inside});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("floor-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }}

        # pergola thing
        if ($vertex->Is_Outside and $vertex->Is_Supported and (!$vertex->Is_Covered))
        {{
            my $molior = Molior->new ({type => 'molior-ceiling', guid => $guid, id => $vertex->Id,
                                       name => 'pergola',
                                      style => $vertex->Style,
                                  elevation => $elevation,
                                       path => [map {$vertex->Coordinate ($_)} 0 .. 3],
                                     height => $height - 0.4,
                               intermittent => [0.45, 0.05],
                                    ceiling => 0.1,
                                      inner => $inner,
                                     closed => 1,
                                      level => $vertex->Level,
                                       plot => $plot_name,
                                     colour => $colour_pergola});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("ceiling-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }}
    }

    # do roof
    my @perimeters;
    my @holes;
    while ($graph_roofline->has_a_cycle)
    {
        my @chain = $graph_roofline->find_a_cycle;
        $graph_roofline->delete_vertices (@chain);

        my $chain = _unpack_chain (@chain);
        my $polygon = Urb::Polygon->new (points => [@{$chain}, $chain->[0]]);
        if ($polygon->isClockwise)
        { push @holes, $polygon }
        else
        { push @perimeters, $polygon }

        unless (scalar $dom->Levels_Above)
        {
	    my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'roofline',
                                      style => $dom->Style,
                                  elevation => $elevation,
                                       path => _unpack_chain (@chain),
                                     height => $height,
                                     closed => 1,
                                      level => $dom->Level,
                                       plot => $plot_name,
                                     colour => $colour_wall_outside});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }
    }

    my @quads;
    for my $perimeter (@perimeters)
    {
        push @quads, $perimeter->to_quads (@holes);
    }

    my @privates;
    my $id = 0 - $dom->Rotation;
    for my $edge ('a', 'b', 'c', 'd')
    {
        push @privates, [$dom->Coordinate ($id), $dom->Coordinate ($id+1)] if (defined $dom->Perimeter->{$edge} and ($dom->Perimeter->{$edge} eq 'private' or $dom->Perimeter->{$edge} eq 'fortified'));
        $id++;
    }

    my @roof_elements;
    for my $quad (@quads)
    {
        my @points = $quad->points;

        my $gable;
        for my $id (0 .. 3)
        {
            my $midpoint = scale_2d (1/2, add_2d ($points[$id],$points[$id+1]));
            my $gableness = 0;
            for my $private_edge (@privates)
            {
                $gableness = 1 if is_between_2d ($midpoint, @{$private_edge});
            }
            $gable .= $gableness;
        }

        pop @points;
        push @roof_elements, [[@points],$gable];
    }

    unless (scalar $dom->Levels_Above)
    {
        my $molior = Molior->new ({type => 'molior-roof', guid => $guid,
                                  style => $dom->Style,
                              elevation => $elevation,
                               elements => [@roof_elements],
                                 height => $height,
                                   name => 'roof',
                                  outer => $outer,
                                 closed => 1,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_roof,
                           colour_gable => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("roof-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    my @walls;
    # do looped external walls
    while ($graph_envelope->has_a_cycle)
    {
        my $looped = 1;
        my @chain = $graph_envelope->find_a_cycle;
        push @walls, [$looped, [@chain]];
        $graph_envelope->delete_vertices (@chain);
    }
    # do non-loop external walls
    for my $source_vertex ($graph_envelope->source_vertices)
    {
        my $looped = 0;
        my @chain = $graph_envelope->_chain ($source_vertex);
        push @walls, [$looped, [@chain]];
        $graph_envelope->delete_vertices (@chain);
    }

    for (@walls)
    {
        my $looped = $_->[0];
        my @chain = @{$_->[1]};

        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'exterior',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain (@chain),
                                 height => $height,
                                ceiling => $dom->Ceiling,
                                  floor => $dom->Floor,
                                  inner => $inner,
                                  outer => $outer,
                              extension => $outer,
                                 closed => $looped,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside,
                               openings => [],
                                 bounds => []});

        # size the list of openings to number of segments in path
        $molior->{openings}->[scalar @chain -2 + $looped] = [];

        my @edge_ids = (0 .. scalar @{$molior->{path}} -2);
        push (@edge_ids, -1) if $looped;
        for my $edge_id (@edge_ids)
        {
            _add_bounds ($dom, $molior, $lookup, [@chain], $edge_id);
            _insert_opening ($dom, $molior, $lookup, [@chain], $edge_id, $entrances);

            next unless defined $molior->{openings}->[$edge_id]->[0];
            # _insert_opening adds a door first then windows,
            # reverse the list if we want doors at other end of this link because of stairs
            $molior->{openings}->[$edge_id] = [reverse @{$molior->{openings}->[$edge_id]}]
                if $coor_doors_here->{$chain[$edge_id +1]};
            $molior->{openings}->[$edge_id]->[-1]->{along} = 10.0;
        }

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;

        unless (scalar $dom->Levels_Above)
        {
	    my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'eaves',
                                      style => $dom->Style,
                                  elevation => $elevation,
                                       path => _unpack_chain (@chain),
                                     height => $height,
                                  extension => $outer,
                                     closed => $looped,
                                      level => $dom->Level,
                                       plot => $plot_name,
                                     colour => $colour_wall_outside});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }
    }

    # do parapets around roof gardens
    for my $source_vertex ($graph_parapet->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_parapet->_chain ($source_vertex)),
                                 height => 0.0,
                              extension => -0.31,
                                 return => -0.10,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    while ($graph_parapet->has_a_cycle)
    {
        my @chain = $graph_parapet->find_a_cycle;
        my $path = _unpack_chain (@chain);
        $graph_parapet->delete_vertices (@chain);

	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => $path,
                                 height => 0.0,
                                 closed => 1,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    while ($graph_parapet_internal->has_a_cycle)
    {
        my @chain = $graph_parapet_internal->find_a_cycle;
        my $path = _unpack_chain (@chain);
        $graph_parapet_internal->delete_vertices (@chain);

	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet internal',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => $path,
                                 height => 0.0,
                                 closed => 1,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do parapets facing the street (may partially overlap with graph_parapet)
    for my $source_vertex ($graph_parapet_street->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet street',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_parapet_street->_chain ($source_vertex)),
                                 height => 0.0,
                              extension => 0.0,
                                 return => -0.1,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do parapets bounding other plots (may partially overlap with graph_parapet)
    for my $source_vertex ($graph_parapet_party->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet party',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_parapet_party->_chain ($source_vertex)),
                                 height => 0.0,
                              extension => 0.0,
                                 return => -0.1,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do parapets internal to our plot (may partially overlap with graph_parapet)
    for my $source_vertex ($graph_parapet_internal->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'parapet internal',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_parapet_internal->_chain ($source_vertex)),
                                 height => 0.0,
                              extension => -0.31,
                                 return => -0.10,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do pergola beam
    for my $source_vertex ($graph_pergola->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'pergola beam',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_pergola->_chain ($source_vertex)),
                                 height => $height,
                              extension => 0 - $outer,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_pergola});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do columns supporting pergola beam
    for my $source_vertex ($graph_pergola->source_vertices)
    {
        my $chain = _unpack_chain ($graph_pergola->_chain ($source_vertex));
        # corner columns
        for my $corner_id (1 .. scalar @{$chain} -2)
        {
            my $molior = Molior->new ({type => 'molior-insert', guid => $guid, name => 'pergola post',
                                      style => $dom->Style,
                                  elevation => $elevation,
                                     height => 0.0,
                                      level => $dom->Level,
                                       plot => $plot_name,
                                      space => [[-0.1,-0.1,0.0],[0.1,0.1,$height -0.7]],
                                   location => $chain->[$corner_id],
                                   rotation => rad2deg (angle_2d ($chain->[$corner_id], $chain->[$corner_id +1]))});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("insert-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }
    }

    while ($graph_pergola->has_a_cycle)
    {
        my @chain = $graph_pergola->find_a_cycle;
        my $path = _unpack_chain (@chain);
        $graph_pergola->delete_vertices (@chain);

	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'pergola beam',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => $path,
                                 height => $height,
                              extension => -0.05,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_pergola});

        $molior->{closed} = 1 if scalar @{$path} > 2;

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;

        # corner columns
        for my $corner_id (0 .. scalar @{$path} -1)
        {
            my $molior = Molior->new ({type => 'molior-insert', guid => $guid, name => 'pergola post',
                                      style => $dom->Style,
                                  elevation => $elevation,
                                     height => 0.0,
                                      level => $dom->Level,
                                       plot => $plot_name,
                                      space => [[-0.1,-0.1,0.0],[0.1,0.1,$height -0.7]],
                                   location => $path->[$corner_id -1],
                                   rotation => rad2deg (angle_2d ($path->[$corner_id -1], $path->[$corner_id]))});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("insert-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }
    }

    # all internal pergola paths must be loops
    while ($graph_pergola_internal->has_a_cycle)
    {
        my @chain = $graph_pergola_internal->find_a_cycle;
        my $path = _unpack_chain (@chain);
        $graph_pergola_internal->delete_vertices (@chain);

        if (scalar @{$path} > 2)
        {
            say 'Warning: skipping internal pergola path with more than two nodes';
            next;
        }

        my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'pergola beam',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => $path,
                                 height => $height,
                              extension => -0.05,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_pergola});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do non-loop party walls
    for my $source_vertex ($graph_partywall->source_vertices)
    {
        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'party',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => [],
                                 height => $height,
                                ceiling => $dom->Ceiling,
                                  floor => $dom->Floor,
                                  inner => $inner,
                                  outer => $outer,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside,
                                 bounds => [],
                               openings => []});

        my @chain = $graph_partywall->_chain ($source_vertex);
        $molior->{path} = _unpack_chain (@chain);
        for my $edge_id (0 .. scalar @{$molior->{path}} -2)
        {
            _add_bounds ($dom, $molior, $lookup, [@chain], $edge_id);
        }

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do internal walls
    for my $edge ($graph_internal->edges)
    {
        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'interior',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain (@{$edge}),
                                 height => $height,
                                ceiling => $dom->Ceiling,
                                  floor => $dom->Floor,
                                  inner => $inner,
                                  outer => $inner,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_inside,
                                 bounds => [],
                               openings => []});

        _add_bounds ($dom, $molior, $lookup, [@{$edge}], 0);

        # $coor_doors_here is a lookup table of corners where we find doors
        my $along = 0.18;
        $along = 10.0 if $coor_doors_here->{$edge->[1]};

        my @types = sort (map {$dom->By_Id ($_)->Type} @{$lookup->{join '-', @$edge}});
        my $door_name  = '';
        $door_name = 'kitchen inside door' if ($types[0] =~ /^c/xi and $types[1] =~ /^k/xi);
        $door_name = 'living inside door' if ($types[0] =~ /^c/xi and $types[1] =~ /^l/xi);
        $door_name = 'bedroom inside door' if ($types[0] =~ /^b/xi and $types[1] =~ /^c/xi);
        $door_name = 'toilet inside door' if ($types[0] =~ /^c/xi and $types[1] =~ /^t/xi);
        $door_name = 'circulation inside door' if ($types[0] =~ /^c/xi and $types[1] =~ /^c/xi);
        $door_name = 'kitchen living inside door' if ($types[0] =~ /^k/xi and $types[1] =~ /^l/xi);

        my $graph_level = $graph_circ[$dom->Level];
        my $ids = $lookup->{join '-', @$edge};
        my @vertices;
        for ($graph_level->vertices)
        {
            push @vertices, $_ if ($_->Id eq $ids->[0] or $_->Id eq $ids->[1]);
        }

        if (scalar @vertices != 2)
        {
            say STDERR 'warning: no space on both sides of wall';
        }
        elsif ($door_name eq '' and $graph_level->has_edge (@vertices))
        {
            say STDERR 'warning: skipping door between '. join (' and ', @types);
        }
        elsif ($graph_level->has_edge (@vertices))
        {
            push @{$molior->{openings}}, [{name => $door_name, along => $along, size => 0}];
        }

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do non-loop covered outside beam
    for my $source_vertex ($graph_covered->source_vertices)
    {
	my $molior = Molior->new ({type => 'molior-extrusion', guid => $guid, name => 'external beam',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain ($graph_covered->_chain ($source_vertex)),
                                 height => $height,
                              extension => 0 - $inner,
                                 return => -0.40,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_molding});

        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("extrusion-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }
    
    # do columns supporting outside beam
    for my $source_vertex ($graph_covered->source_vertices)
    {
        my $chain = _unpack_chain ($graph_covered->_chain ($source_vertex));
        # corner columns
        for my $corner_id (1 .. scalar @{$chain} -2)
        {
            my $rotation = rad2deg (angle_2d ($chain->[$corner_id], $chain->[$corner_id +1]));
            my $molior = Molior->new ({type => 'molior-insert', guid => $guid, name => 'beam column',
                                      style => $dom->Style,
                                  elevation => $elevation,
                                     height => 0.0,
                                      level => $dom->Level,
                                       plot => $plot_name,
                                      space => [[-0.2,-0.2,0.0],[0.2,0.2,$height -0.37]],
                                   location => $chain->[$corner_id],
                                   rotation => $rotation});

            push(@molior_all, $molior->Serialise) if $path_molior;
            $molior->Write ("insert-$yaml_id.molior") unless $path_molior;
            $yaml_id++;
        }
        # intermediate columns
        for my $corner_id (0 .. scalar @{$chain} -2)
        {
            my $rotation = rad2deg (angle_2d ($chain->[$corner_id], $chain->[$corner_id +1]));
            my $distance = distance_2d ($chain->[$corner_id], $chain->[$corner_id +1]);
            my $segments = int ($distance / 2);
            next if $segments < 2;
            for my $segment_id (1 .. $segments -1)
            {
                my $inc = $segment_id / $segments;
                my $location = add_2d (scale_2d ($inc, $chain->[$corner_id]), scale_2d (1-$inc, $chain->[$corner_id +1]));
                my $molior = Molior->new ({type => 'molior-insert', guid => $guid, name => 'beam column',
                                          style => $dom->Style,
                                      elevation => $elevation,
                                         height => 0.0,
                                          level => $dom->Level,
                                           plot => $plot_name,
                                          space => [[-0.2,-0.2,0.0],[0.2,0.2,$height -0.37]],
                                       location => $location,
                                       rotation => $rotation});

                push(@molior_all, $molior->Serialise) if $path_molior;
                $molior->Write ("insert-$yaml_id.molior") unless $path_molior;
                $yaml_id++;
            }
        }
    }

    # do non-loop covered party fence
    for my $source_vertex ($graph_private_covered->source_vertices)
    {
        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'party',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => [],
                                 height => $height,
                                ceiling => 0.0,
                                  inner => $inner,
                                  outer => $outer,
                              extension => $outer,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside,
                               openings => [],
                                 bounds => []});

        my @chain = $graph_private_covered->_chain ($source_vertex);
        $molior->{path} = _unpack_chain (@chain);
        for my $edge_id (0 .. scalar @{$molior->{path}} -2)
        {
            _add_bounds ($dom, $molior, $lookup, [@chain], $edge_id);
        }
        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # level 0 stuff only after this
    next if scalar $dom->Levels_Below;

    my $height_fence = 1.8;
    # extend height of 'fence' if there are 'fortified' boundaries anywhere.
    for (qw/a b c d/) { $height_fence = $height if (defined $dom->Perimeter->{$_} and $dom->Perimeter->{$_} eq 'fortified') }

    # do non-loop party fence
    for my $source_vertex ($graph_private->source_vertices)
    {
        my @chain = $graph_private->_chain ($source_vertex);

        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'fence',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain (@chain),
                                 height => $height_fence,
                                ceiling => 0.0,
                                  inner => -0.15,
                                  outer => $outer,
                              extension => $outer,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside,
                               openings => [],
                                 bounds => []});

        for my $edge_id (0 .. scalar @{$molior->{path}} -2)
        {
            _add_bounds ($dom, $molior, $lookup, [@chain], $edge_id);
        }
        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }

    # do fence/wall to street
    for my $source_vertex ($graph_public->source_vertices)
    {
        my @chain = $graph_public->_chain ($source_vertex);

        my $molior = Molior->new ({type => 'molior-wall', guid => $guid, name => 'fence',
                                  style => $dom->Style,
                              elevation => $elevation,
                                   path => _unpack_chain (@chain),
                                 height => $height_fence,
                                ceiling => 0.0,
                                  inner => 0.0,
                                  outer => $outer,
                              extension => $outer,
                                 closed => 0,
                                  level => $dom->Level,
                                   plot => $plot_name,
                                 colour => $colour_wall_outside,
                               openings => [[]],
                                 bounds => []});

        for my $edge_id (0 .. scalar @{$molior->{path}} -2)
        {
            my $ids = _add_bounds ($dom, $molior, $lookup, [@chain], $edge_id);

            if (defined $entrances->{$ids->[0]} and $entrances->{$ids->[0]} eq $ids->[1])
            {
                $molior->{openings}->[$edge_id]->[0] = {name => 'house entrance gate', along => '0.5', size => 0};
            }
            else
            {
                # add a small gate to the first segment in this wall
                # FIXME only do it once
                #$molior->{openings}->[0]->[0] = {name => 'gate', along => '0.5', size => 0};
            }
        }
        push(@molior_all, $molior->Serialise) if $path_molior;
        $molior->Write ("wall-$yaml_id.molior") unless $path_molior;
        $yaml_id++;
    }
}

YAML::DumpFile ($path_molior, @molior_all) if defined $path_molior;

exit 0;

sub _add_bounds
{
    my ($dom, $molior, $lookup, $chain, $edge_id) = @_;
    my $edge = [$chain->[$edge_id], $chain->[$edge_id +1]];
    my $ids = $lookup->{join '-', @$edge};
    $molior->{bounds}->[$edge_id] = $ids;
    return $ids;
}

sub _insert_opening
{
    my ($dom, $molior, $lookup, $chain, $edge_id, $entrances) = @_;

    $molior->{openings}->[$edge_id] = [] unless defined $molior->{openings}->[$edge_id];

    my $edge = [$chain->[$edge_id], $chain->[$edge_id +1]];
    my $ids = $lookup->{join '-', @$edge};
    my $type = $dom->By_Id ($ids->[0])->Type;
    my $out = $dom->By_Id ($ids->[1])->Type;

    my ($window_name, $door_name);
    if ($out =~ /^[s]/xi)
    {
        $window_name = 'kitchen sahn window' if ($type =~ /^[k]/xi);
        $window_name = 'living sahn window' if ($type =~ /^[l]/xi);
        $window_name = 'circulation sahn window' if ($type =~ /^[c]/xi);
        $window_name = 'bedroom sahn window' if ($type =~ /^[b]/xi);
        $window_name = 'toilet sahn window' if ($type =~ /^[t]/xi);
        $door_name = 'kitchen sahn door' if ($type =~ /^[k]/xi);
        $door_name = 'living sahn door' if ($type =~ /^[l]/xi);
        $door_name = 'circulation sahn door' if ($type =~ /^[c]/xi);
        $door_name = 'bedroom sahn door' if ($type =~ /^[b]/xi);
        $door_name = 'toilet sahn door' if ($type =~ /^[t]/xi);
    }
    elsif (!$dom->Level and $ids->[1] =~ /^[abcd]/xi)
    {
        $window_name = 'kitchen street window' if ($type =~ /^[k]/xi);
        $window_name = 'living street window' if ($type =~ /^[l]/xi);
        $window_name = 'circulation street window' if ($type =~ /^[c]/xi);
        $window_name = 'bedroom street window' if ($type =~ /^[b]/xi);
        $window_name = 'toilet street window' if ($type =~ /^[t]/xi);
    }
    else
    {
        $window_name = 'kitchen outside window' if ($type =~ /^[k]/xi);
        $window_name = 'living outside window' if ($type =~ /^[l]/xi);
        $window_name = 'circulation outside window' if ($type =~ /^[c]/xi);
        $window_name = 'bedroom outside window' if ($type =~ /^[b]/xi);
        $window_name = 'toilet outside window' if ($type =~ /^[t]/xi);
        $door_name = 'kitchen outside door' if ($type =~ /^[k]/xi);
        $door_name = 'living outside door' if ($type =~ /^[l]/xi);
        $door_name = 'circulation outside door' if ($type =~ /^[c]/xi);
        $door_name = 'bedroom outside door' if ($type =~ /^[b]/xi);
        $door_name = 'toilet outside door' if ($type =~ /^[t]/xi);
    }

    my $entrance_name = 'house entrance';
    if (!scalar ($dom->Levels_Above))
    {
        $entrance_name = 'house entrance single storey';
    }
    elsif ($ids->[1] =~ /^[lr]/ and $dom->By_Id ($ids->[1])->Is_Covered)
    {
        $entrance_name = 'house entrance covered';
    }

    my $graph_level = $graph_circ[$dom->Level];
    my @vertices;
    for ($graph_level->vertices)
    {
        push @vertices, $_ if ($_->Id eq $ids->[0] or $_->Id eq $ids->[1]);
    }

    # boundary wall
    if (grep {/^[abcd]$/x} @{$ids})
    {
        my @external = grep {/^[abcd]$/x} @{$ids};
        my $external_type = $dom->Root->Perimeter->{$external[0]} || '';

        if (!$dom->Level and defined $entrances->{$ids->[0]} and $entrances->{$ids->[0]} eq $ids->[1])
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $entrance_name, along => '0.5', size => 0};
        }
        if (!$dom->Level and $external_type eq 'fortified')
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
        }
        else
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
        }
    }
    # non-boundary wall
    elsif (scalar @vertices == 2 and $graph_level->has_edge (@vertices))
    {
        # circulation and front yard
        if (!$dom->Level and defined $entrances->{$ids->[0]} and $entrances->{$ids->[0]} eq $ids->[1])
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $entrance_name, along => '0.5', size => 0};
        }
        # ground floor, circulation, private outdoor
        elsif ((!$dom->Level) and $type =~ /^c/xi and !defined $entrances->{$ids->[1]})
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $door_name, along => '0.5', size => 0};
        }
        # ground floor, kitchen/living/bedroom, private outdoor
        elsif ((!$dom->Level) and $type =~ /^[klb]/xi and !defined $entrances->{$ids->[1]})
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $door_name, along => '0.5', size => 0};
        }
        # toilet to sahn
        elsif ($type =~ /^[t]/xi and $out =~ /^[s]/xi and $dom->By_Id ($ids->[1])->Is_Usable)
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $door_name, along => '0.5', size => 0};
        }
        # ground floor, kitchen/living/bedroom/circulation/toilet
        elsif ((!$dom->Level) and $type =~ /^[klcbt]/xi)
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
        }
        # upstairs, kitchen/living/circulation/bedroom, terrace
        elsif ($dom->Level and $type =~ /^[klcb]/xi and $dom->By_Id ($ids->[1])->Is_Supported)
        {
            push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
            push @{$molior->{openings}->[$edge_id]}, {name => $door_name, along => '0.5', size => 0};
        }
    }
    else
    {
        push @{$molior->{openings}->[$edge_id]}, {name => $window_name, along => '0.5', size => 0};
    }
    return;
}

sub _unpack_chain
{
    my @chain = @_;
    my @unpacked;
    for my $id (0 .. scalar @chain -1)
    {
         my $packed = $chain[$id];
         my $coor = [split ':', $packed];
         push @unpacked, $coor;
    }
    return [@unpacked];
}

sub Graph::_chain
{
    my ($g, @list) = @_;
    my ($successor) = $g->successors ($list[-1]);
    return @list if (defined $successor and grep {/$successor/x} @list);
    @list = $g->_chain (@list, $successor) if defined $successor;
    return @list;
}

# returns an autocad colour number in the range 15, 25, 35 ... 235, 245
sub _colour
{
    my $thing = shift;
    return (int(hex (substr (Digest::MD5::md5_hex ($thing), -4)) /256/256*24)+1) * 10 + 5;
}

__END__

=head1 NAME

urb-dom2molior - generate building parts

=head1 SYNOPSIS

urb-dom2molior.pl <dom_file> [all.molior]

=head1 DESCRIPTION

B<urb-dom2molior> takes an L<Urb::Dom> object and writes out a series of
L<Molior> format files defining building parts such as walls, roofs etc..

These files are written to the current folder and given names like
wall-1.molior, roof-2.molior etc...

optionally specify an output filename to avoid writing multiple files

Use tools from the L<Molior> module to convert these definitions to 3D geometry.

=head1 COPYRIGHT

Copyright (c) 2004-2013 Bruno Postle <bruno@postle.net>.

This file is part of Urb.

Urb is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Urb is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Urb.  If not, see <http://www.gnu.org/licenses/>.

=head1 SEE ALSO

L<Urb>

=cut

