# This file is part of the DEPS/graph-includes package
#
# (c) 2005,2006 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 _node_stylestring {
  my ($node, $style) = @_;
  my @attrs;
  my $label = ($style->{label} or $node->{LABEL});
  foreach my $key (keys %$style) {
    if ($key eq 'label') {
      next; # already handled
    } elsif ($key eq 'extralabel') {
      $label .= "\\n$style->{$key}";
    } elsif ($key eq 'bgcolor') {
      # FIXME: should validate color (use Graphics::ColorNames)
      push @attrs, 'style=filled', 'fillcolor='.$style->{$key};
    } elsif ($key eq 'bordercolor') {
      push @attrs, 'color='.$style->{$key};
    } else {
      print STDERR "Warning: graphincludes::renderer::dot does not support attribute '$key' for nodes\n";
    }
  }
  unshift @attrs, "label=\"$label\"";

  join ',', @attrs;
}

sub _edge_stylestring {
  my ($node, $style) = @_;
  my @attrs;
  foreach my $key (keys %$style) {
    if ($key eq 'label') {
      push @attrs, "label=\".$style->{$key}\"";
    } else {
      print STDERR "Warning: graphincludes::renderer::dot does not support style attribute '$key' for edges\n";
    }
  }

  join ',', @attrs;
}

# apply sequence of stylers on an object
# FIXME: move to where ?
sub style {
  my ($object, $graphnode, $stylers) = @_;
  my $style = {};
  foreach my $styler (@$stylers) {
    $styler->apply($object, $graphnode, $style);
  }
  return $style;
}

sub printgraph {
  my $self = shift;
  my ($graphnode, $nodestylers, $edgestylers) = @_;
  # $graphnode can be a node in the transform graph, or maybe a simple graph,
  # allowing to graph the transform graph itself
  my $graph = eval { defined $graphnode->{DATA} } ? $graphnode->{DATA} : $graphnode;

  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";

  foreach my $node ($graph->get_nodes) {
    print "\"$node->{LABEL}\" [", _node_stylestring($node, style($node, $graphnode, $nodestylers)), "]\n";
  }

  foreach my $file ($graph->get_edge_origins) {
    foreach my $edge ($graph->get_edges_from($file)) {
      print "\"$file\" -> \"$edge->{DST}{LABEL}\" [", _edge_stylestring($edge, style($edge, $graphnode, $edgestylers)), "]\n";
    }
  }

  print "}\n";
}

sub wait {
  my $self = shift;

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

1;
