view release on metacpan or  search on metacpan

lib/Dist/Zilla/Plugin/MapMetro/MakeGraphViz/Map.pm  view on Meta::CPAN

    is => 'rw',
    isa => Str,
    required => 1,
);

has settings => (
    is => 'rw',
    isa => HashRef,
    traits => ['Hash'],
    init_arg => undef,
    default => sub { { } },
    handles => {
        set_setting => 'set',
        get_setting => 'get',
    },
);
has hidden_positions => (
    is => 'rw',
    isa => ArrayRef,
    traits => ['Array'],
    init_arg => undef,
    default => sub { [] },
    handles => {
        add_hidden => 'push',
        all_hiddens => 'elements',
    },
);
has generated_file => (
    is => 'rw',
    isa => Path,
    predicate => 1,
    init_arg => undef,
);

sub BUILD {
    my $self = shift;

    my $decamelized_map = decamelize($self->map);

    my @possible_graphvizfiles = (
        path('share', 'graphviz.conf'),
        path('share', $decamelized_map, "graphviz-$decamelized_map.conf")
    );
    my $graphvizfile = (grep { $_->exists } @possible_graphvizfiles)[0];

    my @possible_mapfiles = (
        path('share', "map-$decamelized_map.metro"),
        path('share', $decamelized_map, "map-$decamelized_map.metro")
    );
    my $mapfile = (grep { $_->exists } @possible_mapfiles)[0];
    return if !defined $mapfile;

    my $graph = Map::Metro::Shim->new(filepath => $mapfile)->parse;

    my $customconnections = {};
    if($graphvizfile) {
        my $settings = $graphvizfile->slurp;
        $settings =~  s{^#.*$}{}g;
        $settings =~ s{\n}{ }g;

        for my $custom (split m/ +/ => $settings) {
            if($custom =~ m{^(\d+)-(\d+):([\d\.]+)$}) {
                my $origin_station_id = $1;
                my $destination_station_id = $2;
                my $len = $3;

                $self->set_setting(sprintf ('len-%s-%s', $origin_station_id, $destination_station_id), $len);
                $self->set_setting(sprintf ('len-%s-%s', $destination_station_id, $origin_station_id), $len);
            }
            elsif($custom =~ m{^\*(\d+):(-?[\d\.]+,-?[\d\.]+)}) {
                my $station_id = $1;
                my $hidden_station_pos = $2;

                $self->add_hidden({ station_id => $station_id, pos => $hidden_station_pos });
            }
            elsif($custom =~ m{^(\d+):(-?\d+,-?\d+!?)$}) {
                my $station_id = $1;
                my $pos = $2;

                $self->set_setting(sprintf ('pos-%s', $station_id) => $pos);
            }
            elsif($custom =~ m{^!(\d+)-(\d+):(\d+)\^([\d\.]+)$}) {
                my $origin_station_id = $1;
                my $destination_station_id = $2;
                my $connections = $3;
                my $len = $4;

                $customconnections->{ $origin_station_id }{ $destination_station_id } = { connections => $connections, len => $len };
            }
        }
    }

    my $viz = GraphViz2->new(
        global => { directed => 0 },
        graph => { epsilon => 0.00001, fontname => 'sans-serif', fontsize => 100, label => $self->map, labelloc => 'top' },
        node => { shape => 'circle', fixedsize => 'true', width => 0.8, height => 0.8, penwidth => 3, fontname => 'sans-serif', fontsize => 20 },
        edge => { penwidth => 5, len => 1.2 },
    );
    for my $station ($graph->all_stations) {
        my %pos = $self->get_pos_for($station->id);
        my %node = (name => $station->id, label => $station->id, %pos);
        $viz->add_node(%node);
    }

    for my $transfer ($graph->all_transfers) {
        my %len = $self->get_len_for($transfer->origin_station->id, $transfer->destination_station->id);
        $viz->add_edge(from => $transfer->origin_station->id, to => $transfer->destination_station->id, color => '#888888', style => 'dashed', %len);
    }
    for my $segment ($graph->all_segments) {
        for my $line_id ($segment->all_line_ids) {
            my $color = $graph->get_line_by_id($line_id)->color;
            my $width = $graph->get_line_by_id($line_id)->width;
            my %len = $self->get_len_for($segment->origin_station->id, $segment->destination_station->id);

            $viz->add_edge(from => $segment->origin_station->id,
                           to => $segment->destination_station->id,
                           color => $color,
                           penwidth => $width,
                           %len,
            );
        }