Map-Metro
view release on metacpan or search on metacpan
lib/Map/Metro/Cmd/Graphviz.pm view on Meta::CPAN
use Map::Metro::Elk;
use MooseX::App::Command;
extends 'Map::Metro::Cmd';
use Path::Tiny;
use Types::Standard qw/Str HashRef/;
use Module::Load qw/load/;
use Try::Tiny;
parameter cityname => (
is => 'rw',
isa => Str,
documentation => 'The name of the map',
required => 1,
);
parameter customlens => (
is => 'rw',
isa => Str,
documentation => 'Custom distances between stations (origin_station_id->destination_station_id:len)',
);
option into => (
is => 'rw',
isa => Str,
);
has lens => (
is => 'rw',
isa => HashRef,
traits => ['Hash'],
handles => {
set_len => 'set',
get_len => 'get',
},
);
command_short_description 'Make a visualization using GraphViz2';
sub run {
my $self = shift;
try {
load "GraphViz2";
}
catch {
die $_;
};
my %hooks = (hooks => ['PrettyPrinter']);
my $graph = $self->cityname !~ m{\.} ? Map::Metro->new($self->cityname, %hooks)->parse : Map::Metro::Shim->new($self->cityname, %hooks)->parse;
my $customconnections = { };
if($self->customlens) {
my $customlens = path($self->customlens)->exists ? do {
my $settings = path($self->customlens)->slurp;
$settings =~ s{^#.*$}{}g;
$settings =~ s{\n}{ }g;
$settings;
}
: $self->customlens
;
foreach my $custom (split m/ +/ => $customlens) {
if($custom =~ m{^(\d+)->(\d+):([\d\.]+)$}) {
my $origin_station_id = $1;
my $destination_station_id = $2;
my $len = $3;
$self->set_len(sprintf ('%s-%s', $origin_station_id, $destination_station_id), $len);
$self->set_len(sprintf ('%s-%s', $destination_station_id, $origin_station_id), $len);
}
elsif($custom =~ m{^!(\d+)->(\d+):([\d\.]+)$}) {
my $origin_station_id = $1;
my $destination_station_id = $2;
my $len = $3;
$customconnections->{ $origin_station_id }{ $destination_station_id } = $len;
}
}
}
my $viz = GraphViz2->new(
global => { directed => 0 },
graph => { epsilon => 0.00001 },
node => { shape => 'circle', fixedsize => 'true', width => 0.8, height => 0.8, penwidth => 3, fontname => 'sans-serif', fontsize => 20 },
edge => { penwidth => 5, len => 1.2 },
);
foreach my $station ($graph->all_stations) {
$viz->add_node(name => $station->id, label => $station->id);
}
foreach 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);
}
foreach my $segment ($graph->all_segments) {
foreach 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,
);
}
}
#* Custom connections (for better visuals)
foreach my $origin_station_id (keys %{ $customconnections }) {
foreach my $destination_station_id (keys %{ $customconnections->{ $origin_station_id }}) {
my $len = $customconnections->{ $origin_station_id }{ $destination_station_id };
$viz->add_edge(from => $origin_station_id,
to => $destination_station_id,
color => '#ffffff',
penwidth => 0,
len => $len,
);
}
}
my $output = $self->into // sprintf 'viz-%s-%s.png', $self->cityname, time;
( run in 0.654 second using v1.01-cache-2.11-cpan-71847e10f99 )