# Copyright (c) 1997-2006
# Ewgenij Gawrilow, Michael Joswig (Technische Universitaet Berlin, Germany)
# http://www.math.tu-berlin.de/polymake, mailto:polymake@math.tu-berlin.de
#
# This program 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 2, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# This program 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.
#-----------------------------------------------------------------------------
# $Project: polymake $$Id: PostscriptGraph.pm 7287 2006-03-24 14:34:44Z gawrilow $
no integer;
package Graphviz::File;
use Struct (
[ new => '$;$' ],
[ '$workfile' => '#1' ],
[ '$title' => '#2' ],
'$Graph',
'$ArrowStyle',
'$reverse',
'$type',
'$edge_symbol',
'$options',
'$command',
);
sub process_node_color {
my ($attrs, $color)=@_;
if (my @color=Visual::parse_color($color)) {
$color='"'.RGB2hex(@color[2..4]).'"';
if ($color[0]) {
$attrs->{color}=$color;
$attrs->{fontcolor}=$color;
} else {
push @{$attrs->{style}}, "filled";
$attrs->{fillcolor}=$color;
}
}
}
sub process_edge_color {
my ($attrs, $color)=@_;
if (my @color=Visual::parse_color($color)) {
$attrs->{color}='"'.RGB2hex(@color[2..4]).'"';
}
}
sub process_style {
my ($attrs, $style)=@_;
if ($style =~ $Visual::hidden_re) {
$attrs->{style}=[ "invis" ];
} elsif ($style =~ $Visual::thickness_re) {
push @{$attrs->{style}}, "\"setlinewidth($1)\"";
}
}
sub process_dir {
my ($attrs, $dir)=@_;
$attrs->{dir}= $dir>0 ? "forward" : $dir<0 ? "back" : "none";
}
sub attrs2text {
my $attrs=shift;
join(", ", map {
"$_=" . do {
my $val=$attrs->{$_};
is_ARRAY($val) ? '"'.join(",", @$val).'"' : $val
}
} keys %$attrs)
}
sub print_it {
my ($self)=@_;
open my $file, ">".$self->workfile
or croak( "can't create working file ", $self->workfile, ": $!\n" );
my %node_attrs=( shape=>"box", height=>0.1, width=>0.1 );
my %edge_attrs;
my $node_color=$self->Graph->NodeColor;
if (!ref($node_color)) {
process_node_color(\%node_attrs, $node_color);
undef $node_color;
}
my $node_style=$self->Graph->NodeStyle;
if (!ref($node_style)) {
process_style(\%node_attrs, $node_style);
undef $node_style;
}
my $edge_color=$self->Graph->EdgeColor;
if (!ref($edge_color)) {
process_edge_color(\%edge_attrs, $edge_color);
undef $edge_color;
}
my $edge_style=$self->Graph->EdgeStyle;
if (!ref($edge_style)) {
process_style(\%edge_attrs, $edge_style);
undef $edge_style;
}
if (!ref($self->ArrowStyle)) {
process_dir(\%edge_attrs, $self->ArrowStyle);
undef $self->ArrowStyle;
}
print $file $self->type, ' "', $self->title, "\" {\n",
" fontsize=$Postscript::fontsize; fontname=\"$Postscript::fontname\"; ", $self->options, ";\n",
" node [", attrs2text(\%node_attrs), "];\n";
if (keys %edge_attrs) {
print $file " edge [", attrs2text(\%edge_attrs), "];\n";
}
my $get_labels=$self->Graph->NodeLabels;
for (my ($n, $end)=(0, $self->Graph->get_number_nodes); $n<$end; ++$n) {
%node_attrs=();
if ($get_labels) {
$node_attrs{label}='"'.$get_labels->($n).'"';
}
if ($node_color) {
process_node_color(\%node_attrs, $node_color->($n));
}
if ($node_style) {
process_style(\%node_attrs, $node_style->($n));
}
print $file " n$n",
keys %node_attrs ? (" [", attrs2text(\%node_attrs), "];\n") : (";\n");
}
my ($from, $to)= $self->reverse ? (1,0) : (0,1);
for (my $e=$self->Graph->edges; $e; ++$e) {
%edge_attrs=();
if ($edge_color) {
process_edge_color(\%edge_attrs, $edge_color->($e));
}
if ($edge_style) {
process_style(\%edge_attrs, $edge_style->($e));
}
if ($self->ArrowStyle) {
process_dir(\%edge_attrs, $self->ArrowStyle->($e));
}
my @nodes=$e->incident_nodes;
print $file " n$nodes[$from] ", $self->edge_symbol, " n$nodes[$to]",
keys %edge_attrs ? (" [", attrs2text(\%edge_attrs), "];\n") : (";\n");
}
print $file "}\n";
}
sub extract_seed {
my $Graph=shift;
if (defined(detect_dynamic(my $emb=$Graph->Coord))) {
for (my $i=2; $i<$#$emb; $i+=2) {
if ($emb->[$i] eq "seed") {
return "; start=".$emb->[$i+1];
}
}
}
"";
}
sub addGraph {
my ($self, $Graph)=@_;
$self->Graph=$Graph;
$self->ArrowStyle=$Graph->Directed;
$self->type= $Graph->Directed ? "digraph" : "graph";
$self->edge_symbol= $Graph->Directed ? "->" : "--";
$self->options="overlap=scale; nodesep=1" . extract_seed($Graph);
$self->command=$neato;
}
sub addLattice {
my ($self, $Lattice)=@_;
$self->Graph=$Lattice;
$self->reverse=$Lattice->Mode eq "primal";
$self->ArrowStyle=$Lattice->ArrowStyle;
$self->type="digraph";
$self->edge_symbol="->";
$self->options="ranksep=2.5";
$self->command=$dot;
}
1
# Local Variables:
# c-basic-offset:3
# End:
syntax highlighted by Code2HTML, v. 0.9.1