# 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: