#  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