# This file is part of the graph-includes package
#
# (c) 2005 Yann Dirson <ydirson@altern.org>
# Distributed under version 2 of the GNU GPL.

package graphincludes::renderer::dot;

use warnings;
use strict;

use base qw(graphincludes::renderer);
use Hash::Util qw(lock_keys);

use graphincludes::params;

sub new {
  my $class = shift;
  my $self = {
	      DOTFLAGS  => [],
	      OUTFORMAT => undef,
	     };

  bless ($self, $class);
  lock_keys (%$self);
  return $self;
}

my %paper = (
	     a4     => '11.6,8.2',
	     a3     => '16.5,11.6',
	     letter => '11,8.5',
	    );

#FIXME: also set arrow head
my @paperparams = ('-Gnodesep=0.1', '-Granksep=0.1', '-Nfontsize=5', '-Efontsize=5');

sub set_multipage {
  my $self = shift;
  my ($papersize) = @_;

  die "Unkown paper size \`$papersize'" unless defined $paper{$papersize};
  # paper output format is postscript on stdout unless otherwise specified
  $self->set_outputformat ('ps');

  push @{$self->{DOTFLAGS}}, @paperparams, '-Gpage=' . $paper{$papersize};
}

sub set_outputformat {
  my $self = shift;
  $self->{OUTFORMAT} = shift;
}

sub set_outputfile {
  my $self = shift;
  my ($outfile) = @_;

  push @{$self->{DOTFLAGS}}, '-o', $outfile;

  $outfile =~ m/.*\.([^.]+)$/ or die "cannot guess output format";
  $self->set_outputformat ($1);
}

sub printgraph {
  my $self = shift;
  my ($project, $colors, $colorstyles) = @_;

  push @{$self->{DOTFLAGS}}, "-T$self->{OUTFORMAT}" if defined $self->{OUTFORMAT};

  if (scalar(@{$self->{DOTFLAGS}}) > 0) {
    my $flags = join ' ', @{$self->{DOTFLAGS}};
    print STDERR "Running through \`dot $flags'\n" if $graphincludes::params::verbose;
    open STDOUT, "| dot $flags";
  }

  print "strict digraph dependencies {\nrankdir=LR;\n";

  sub sprintnode {
    my ($file, $min, $max) = @_;
    my $node = $project->filelabel($file,$max);
    if ($max > $min) {
      if (defined $node) {
	# this node is part of a larger group
	return "subgraph \"cluster $node\" {" . sprintnode($file, $min, $max-1) . '}';
      } else {
	return sprintnode($file, $min, $max-1);
      }
    } else { # ($min == $max)
      my $style='';
      my $idx;

      # maybe use a background
      if (defined ($idx = $colorstyles->{bg}) and defined $colors->[$idx] and
	  defined $project->filelabel($file,$idx) and
	  defined $colors->[$idx]->{$project->filelabel($file,$idx)}) {
	$style .= ",style=filled,fillcolor=" . $colors->[$idx]->{$project->filelabel($file,$idx)};
      }

      # maybe use an outline
      if (defined ($idx = $colorstyles->{border}) and defined $colors->[$idx] and
	  defined $project->filelabel($file,$idx) and
	  defined $colors->[$idx]->{$project->filelabel($file,$idx)}) {
	$style .= ",color=" . $colors->[$idx]->{$project->filelabel($file,$idx)};
      }

      return "\"$node\" [label=\"$node\"" . $style . "];";
    }
  }

  # FIXME...
  my $graph = $project->{GRAPHS}[0];

  foreach my $file (map {$_->{LABEL}} $graph->get_nodes) {
    print sprintnode($file, $graphincludes::params::minshow, $graphincludes::params::maxshow), "\n";
  }

  foreach my $file ($graph->get_edge_origins) {
    foreach my $dest ($graph->get_edges($file)) {
      print "\"$file\" -> \"$dest\"";
      my $special = $project->special_edge($file, $dest);
      # special handling for label, as array
      push @{$special->{label}}, '[' . $graph->get_edge_weight($file, $dest) . ']';
      $special->{label} = join '\n', @{$special->{label}};
      #
      print " [", join (',', map {$_ . '="' . $special->{$_} . '"'} keys %$special), "]" if defined $special;
      print ";\n";
    }
  }

  print "}\n";
}

sub wait {
  my $self = shift;

  if (scalar(@{$self->{DOTFLAGS}}) > 0) {
    close STDOUT;
    wait;
  }
}

1;
