#!/usr/bin/perl -w
############################################################
#
# $Id: display-graph,v 1.13 2008/04/30 10:59:08 rsat Exp $
#
############################################################

## use strict;

=pod

=head1 NAME

display-graph

=head1 DESCRIPTION

Produces the figure of a graph 

=head1 AUTHORS

Sylvain Brohée <sylvain@bigre.ulb.ac.be>

Jacques van Helden <jvanheld@bigre.ulb.ac.be>

=head1 CATEGORY

Graph utils

=head1 USAGE

display-graph -i graph_input_file -o picture_output_file [-v #] [-layout] [-in_format tab/gml/adj_matrix] -out_format [jpeg|jpg|png|ps]

=head1 INPUT FORMAT

See convert-graph for a description of the allowed input graph formats. 

=head1 OUTPUT FORMAT

A graphical representation of the graph in the required output format.

=cut


BEGIN {
    if ($0 =~ /([^(\/)]+)$/) {
	push (@INC, "$`lib/");
    }
}
require "RSA.lib";
require RSAT::Graph2;
require PostScript::Simple;
use GD;


################################################################
## Main package
package main;
{

    ################################################################
    ## Initialise parameters
    my $start_time = &AlphaDate();


    %main::infile = ();
    %main::outfile = ();

    $main::verbose = 0;

    ## Input formats
    local $input_format = "tab";
    %supported_input_format =(
	tab=>1,
	gml=>1,
	adj_matrix=>1
    );
    $supported_input_formats = join (",", keys %supported_input_format);
    local $source_col = 1;
    local $target_col = 2;
    local $weight_col = 0;
    local $source_color_col = 0;
    local $target_color_col = 0;
    local $color_col = 0;
    local $edge_width = 0;
    ## Output formats
    local $output_format = "png";
    %supported_output_format =(
    				ps=>1,
    				png=>1,
    				jpg=>1,
    				jpeg=>1
    			      );			      
			       
    $supported_output_formats = join (",", keys %supported_output_format);
    ## layout
    $layout = 0;
    ################################################################
    ## Read argument values
    &ReadArguments();

    ################################################################
    ## Check argument values
    if (!$layout && $input_format ne 'gml') {
      &RSAT::error::FatalError("You must specify use the -layout option with this format", $input_format);
    }
    if (!$main::outfile{output}) {
      &RSAT::error::FatalError("You must specify an output file with the -o option");
    }
    if (!$main::infile{input}) {
      &RSAT::error::FatalError("You must specify an input file with the -i option");
    }


    ################################################################
    ## Initialize the graph
    my $graph = new RSAT::Graph2();
    $graph->set_attribute("label", "graph");
    
    ################################################################
    ##### read input
    $graph->graph_from_text($input_format, $main::infile{input}, $source_col, $target_col, $weight_col, $source_color_col, $target_color_col,$color_col, 1);
    ## Calculates the layout 
    if ($layout) {
      $graph->get_position();
      
    }
    ## Calculate the minimum and maximum values of the weight on the edges
    my ($edge_mean, $edge_sd, $edge_min, $edge_max);
    if ($edge_width) {
      my $real = $graph->get_attribute("real");
      if ($real eq "null") {
         ($edge_mean, $edge_sd, $edge_min, $edge_max) = $graph->weight_properties();
         $real = $graph->get_attribute("real");
         ## If one weight at least is not a real number, the weights cannot be computed
      }
      
      if ($real == 0) {
        (&RSAT::message::Warning("Cannot compute the mean and standard deviation of the edges : edge weights contain\n\tat least one non real value"."\n")) if ($main::verbose >= 5);
        $edge_width = 0;
      }
      
    }
    ################################################################
    ## Print verbose
    &Verbose() if ($main::verbose);
    ################################################################
    ## Execute the command
    ## get nodes id
    my %nodes_id_name = $graph->get_attribute("nodes_id_name");
    ## get nodes color
    my %nodes_color = $graph->get_attribute("nodes_color");
    ## get edges color
    my @out_colors = $graph->get_attribute("out_color");
    ## get nodes neighbours
    my @out_neighbours = $graph->get_attribute("out_neighbours");
    ## get the nodes position
    my %nodes_id_xpos = $graph->get_attribute("nodes_id_xpos");
    my %nodes_id_ypos = $graph->get_attribute("nodes_id_ypos");
    ## get the labels
    my @out_labels = $graph->get_attribute("out_label");
    
    ## get the total size of the picture
    my $max = 0;
    while (my ($node, $pos) = each (%nodes_id_xpos)) {
      if ($pos > $max) {
        $max = $pos;
      }
    }
    while (my ($node, $pos) = each (%nodes_id_ypos)) {
      if ($pos > $max) {
        $max = $pos;
      }
    } 
    $max += 600;
    ## for postscript figures : use of postscript simple library
    if ($output_format eq "ps" || $output_format eq "eps") {
      # computes the maximal coordinates of x and y
      # create the picture
      $p = new PostScript::Simple(xsize=>$max, ysize=>$max, colour => 1, eps => 0, units => "pt");
      # create a new page
      $p->newpage;
      # display the edges
      for (my $i = 0; $i < scalar(@out_neighbours); $i++) {
        if (defined $out_neighbours[$i]) {
          my @neighbours = @{$out_neighbours[$i]};
          my @colors = @{$out_colors[$i]};
          my @weights = @{$out_labels[$i]};
          my $source_xpos = $nodes_id_xpos{$i}+150;
          my $source_ypos = $nodes_id_ypos{$i}+150;
          for (my $j = 0; $j < scalar(@neighbours); $j++) {
            if (defined $neighbours[$j]) {
              my $target_xpos = $nodes_id_xpos{$neighbours[$j]}+150;
              my $target_ypos = $nodes_id_ypos{$neighbours[$j]}+150;
              my $edge_color = $colors[$j];
              my $weight = $weights[$j];
              # get the color of the edge
              my $r = hex(substr($edge_color, 1,2));
              my $g = hex(substr($edge_color, 3,2));
              my $b = hex(substr($edge_color, 5,2));
              $p->setlinewidth(2);
              if ($edge_width) {
                $width = ((($weight-$edge_min)/($edge_max-$edge_min))*6.5)+0.5;
                $p->setlinewidth($width);
              }
              $p->line($source_xpos,$source_ypos, $target_xpos, $target_ypos, $r, $g, $b);
            }
          }
        }
      }

      
      # display the nodes
      $p->setfont("Arial", 12);
      my $not_connected_nodes = 30;
      while (my ($id, $name) = each (%nodes_id_name)) {
        my $length_name = length($name)*10;
        my $xpos = $nodes_id_xpos{$id};
        my $ypos = $nodes_id_ypos{$id} || 155;
        if (!defined($xpos)) {
          ## In case there is no location found for this node (orphan)
          ## For orphan nodes, fr_layout does not return the location!
          ## We place the orphan nodes side by side at the extremity of 
          ## the graphic.
          $xpos = ($not_connected_nodes+$length_name*10) + 150;
          $not_connected_nodes += $length_name+10;
        } else {
          $xpos = $nodes_id_xpos{$id} + 150;
          $ypos = $nodes_id_ypos{$id} + 150;
        }
        # get the color of the node
        my $node_color = $nodes_color{$id};
        my $r = hex(substr($node_color, 1, 2));
        my $g = hex(substr($node_color, 3, 2));
        my $b = hex(substr($node_color, 5, 2));
        $p->setcolour($r,$g,$b);
        $p->box({filled=>1},$xpos-($length_name/2), $ypos-5, $xpos-($length_name/2) +length($name)*10, $ypos+12);
        $p->setcolour("white");
        $p->box({filled=>1},($xpos-($length_name/2)+2), $ypos-5+1, $xpos-($length_name/2)-1 +length($name)*10-1, $ypos+12-1);
        $p->setcolour("black");
        $p->text($xpos-($length_name/2)+3,$ypos-3, $name);
      }
      $p->output($main::outfile{output});
      ## for jpg / png output : use of gd library
    } elsif ($output_format eq "jpg" || $output_format eq "jpeg" || $output_format eq "png") {
      # create the picture
      my $p  = new GD::Image ( $max , $max ) ;
      my $white = $p->colorAllocate(255,255,255);
      my $black = $p->colorAllocate(0,0,0);
      my %colors = ();
      $colors{"255255255"} = $white;
      $colors{"000000000"} = $black;
      
      # make the background transparent and interlaced
      $p->transparent($white);
      $p->interlaced('false');
      # display the edges
      for (my $i = 0; $i < scalar(@out_neighbours); $i++) {
        if (defined $out_neighbours[$i]) {
          my @neighbours = @{$out_neighbours[$i]};
          my @colors = @{$out_colors[$i]};
          my $source_xpos = $nodes_id_xpos{$i}+150;
          my $source_ypos = $nodes_id_ypos{$i}+150;
          my @weights = @{$out_labels[$i]};
          
          for (my $j = 0; $j < scalar(@neighbours); $j++) {
            if (defined $neighbours[$j]) {
              my $target_xpos = $nodes_id_xpos{$neighbours[$j]}+150;
              my $target_ypos = $nodes_id_ypos{$neighbours[$j]}+150;
              my $edge_color = $colors[$j];
              my $weight = $weights[$j];
              # get the color of the edge
              my $r = hex(substr($edge_color, 1,2));
              my $g = hex(substr($edge_color, 3,2));
              my $b = hex(substr($edge_color, 5,2));
              my $idcol = join("","$r","$g","$b");
              my $current_col = $colors{$idcol};
              if (!defined($current_col)) {
                $current_col = $p->colorAllocate($r, $g, $b);
                $colors{"$idcol"} = $current_col;
              } 
              
#               print "$r, $g, $b\n";
              $p->setThickness(1);
              if ($edge_width) {
                $width = ((($weight-$edge_min)/($edge_max-$edge_min))*6.5)+0.5;
                $p->setThickness($width);
              }
#               print "$current_col\n";
              $p->line($source_xpos, $source_ypos, $target_xpos, $target_ypos, $current_col);
            }
          }
        }
      }
      $p->setThickness(1);
      my $small_font = gdSmallFont;
      my $not_connected_nodes = 30;
      while (my ($id, $name) = each (%nodes_id_name)) {
        my $length_name = length($name)*10;
        my $xpos = $nodes_id_xpos{$id};
        my $ypos = $nodes_id_ypos{$id} || 155;
        if (!defined($xpos)) {
          ## In case there is no location found for this node (orphan)
          $xpos = $not_connected_nodes+length($name)*10+150;
          $not_connected_nodes+=(length($name)*10)+10;
        } else {
          $xpos = $nodes_id_xpos{$id}+150;
          $ypos = $nodes_id_ypos{$id}+150;
        }
        
        # get the color of the node
        my $node_color = $nodes_color{$id};
        my $r = hex(substr($node_color, 1, 2));
        my $g = hex(substr($node_color, 3, 2));
        my $b = hex(substr($node_color, 5, 2));
        my $current_col = $p->colorAllocate($r, $g, $b);
        $p->filledRectangle($xpos-($length_name/2), $ypos-5, $xpos-($length_name/2) +length($name)*10, $ypos+12, $white);
        $p->rectangle($xpos-($length_name/2), $ypos-5, $xpos-($length_name/2) + length($name)*10, $ypos+12, $current_col);
        $p->string(gdSmallFont, $xpos-($length_name/2)+3,$ypos-3, $name, $black);
        
        
      }      
      binmode STDOUT;
      my $output_fhandle = &OpenOutputFile($main::outfile{output});
      if ($output_format eq "jpg" || $output_format eq "jpeg") {
        print $output_fhandle $p->jpeg();
      } elsif ($output_format eq "png") {
        print $output_fhandle $p->png();
      } 
      close $output_fhandle;
    }
    
    ################################################################
    ## Finish verbose
    if ($main::verbose >= 1) {
	my $done_time = &AlphaDate();
	print STDOUT "; Job started $start_time\n";
	print STDOUT "; Job done    $done_time\n";
    }



    exit(0);
}

################################################################
################### SUBROUTINE DEFINITION ######################
################################################################


################################################################
## Display full help message 
sub PrintHelp {
    system "pod2text -c $0";
    exit()
}

################################################################
## Display short help message
sub PrintOptions {
    &PrintHelp();
}

################################################################
## Read arguments 
sub ReadArguments {
    my $arg;
    my @arguments = @ARGV; ## create a copy to shift, because we need ARGV to report command line in &Verbose()
    while (scalar(@arguments) >= 1) {
      $arg = shift (@arguments);
	## Verbosity
=pod

=head1 OPTIONS

=over 4

=item B<-v #>

Level of verbosity (detail in the warning messages during execution)

=cut
	if ($arg eq "-v") {
	    if (&IsNatural($arguments[0])) {
		$main::verbose = shift(@arguments);
	    } else {
		$main::verbose = 1;
	    }

	    ## Help message
=pod

=item B<-h>

Display full help message

=cut
	} elsif ($arg eq "-h") {
	    &PrintHelp();

	    ## List of options
=pod

=item B<-help>

Same as -h

=cut
	} elsif ($arg eq "-help") {
	    &PrintOptions();

	    ## Input file
=pod

=item B<-i inputfile>

Specification of the input graph file

=cut
	} elsif ($arg eq "-i") {
	    $main::infile{input} = shift(@arguments);
=pod

=item B<-in_format input_format>

Input format. Supported: tab, gml, adj_matrix

=cut
	} elsif ($arg eq "-in_format") {
	    $input_format = shift(@arguments);
	    &RSAT::error::FatalError("$input_format\tInvalid input format. Supported: $supported_input_formats")
		unless ($supported_input_format{$input_format});
=item B<-layout>

Calculates the layout (provided you have the fr_layout program in $RSAT/bin) according to the Fruchterman and Reingold algorithm.
This option must be provided if the input graph is not GML.

=cut
	} elsif ($arg eq "-layout") {
	    $layout = 1;
	    
	    
	    ## Source column
=pod

=item B<-scol>

Source column. Column containing the source nodes for the tab-delimited format. (default 1)

=cut
	} elsif ($arg eq "-scol") {
	    $source_col = shift (@arguments);
	    unless (&IsNatural($source_col) && ($source_col > 0)) {
		&RSAT::error::FatalError(join("\t", $source_col, "Invalid value for the source column. Must be a strictly positive natural number"));
	    }

	    ## Target column
=pod

=item B<-tcol>

Target column. Column containing the target nodes for the tab-delimited format.(default 2)

=cut
	} elsif ($arg eq "-tcol") {
	    $target_col = shift (@arguments);
	    unless (&IsNatural($target_col) && ($target_col > 0)) {
		&RSAT::error::FatalError(join("\t", $target_col, "Invalid value for the target column. Must be a strictly positive natural number"));
	    }
	    
=item B<-wcol>

Weight column. Column containing the weight nodes. (no default)

=cut
	} elsif ($arg eq "-wcol") {
	    $weight_col = shift (@arguments);
	    unless (&IsNatural($weight_col) && ($weight_col > 0)) {
		&RSAT::error::FatalError(join("\t", $weight_col, "Invalid value for the weight column. Must be a strictly positive natural number"));
	    }
=pod

=item B<-eccol>

Edge color column. Column containing the color of the edges (RGB) for the tab-delimited format. (no default)

=cut
	} elsif ($arg eq "-eccol") {
	    $color_col = shift (@arguments);
	    unless (&IsNatural($color_col) && ($color_col > 0)) {
		&RSAT::error::FatalError(join("\t", $color_col, "Invalid value for the color column. Must be a strictly positive natural number"));
	    }
=pod

=item B<-sccol>

Source node color colum. Column containing the color of the node (RGB) for the tab-delimited format. (no default)

A node can only have one color. If in the file, the color of the node changes, only the first defined color 
will be taken into account.

=cut
	} elsif ($arg eq "-sccol") {
	    $source_color_col = shift (@arguments);
	    unless (&IsNatural($source_color_col) && ($source_color_col > 0)) {
		&RSAT::error::FatalError(join("\t", $source_color_col, "Invalid value for the color column. Must be a strictly positive natural number"));
	    }
=pod

=item B<-ewidth>

Calculate the edge width for the GML output. The width is proportional to the 
weight of the edge.
All weights in the column indicated by the -wcol argument (or in the label field of the GML file) must thus be real values.

=cut
	} elsif ($arg eq "-ewidth") {
	    $edge_width = 1;
	    	    
	    ### Output format  

=item B<-out_format output_format>

Output format. Supported: ps, png, jpeg

=cut 
	} elsif ($arg eq "-out_format") {
	    $output_format = shift(@arguments);
	    &RSAT::error::FatalError("$output_format\tInvalid output format. Supported: $supported_output_formats")
		unless ($supported_output_format{$output_format});
	    ## Output file
=pod

=item	B<-o outputfile>

Specification of the graphic output file

=cut
	} elsif ($arg eq "-o") {
	    $main::outfile{output} = shift(@arguments);

	} else {
	    &FatalError(join("\t", "Invalid option", $arg));

	}
    }


=pod

=back

=cut

}

################################################################
#### verbose message
sub Verbose {
    print STDOUT "; display-graph ";
    &PrintArguments(STDOUT);
    if (defined(%main::infile)) {
	print STDOUT "; Input files\n";
	while (my ($key,$value) = each %main::infile) {
	    print STDOUT ";\t$key\t$value\n";
	}
    }
    if (defined(%main::outfile)) {
	print STDOUT "; Output files\n";
	while (my ($key,$value) = each %main::outfile) {
	    print STDOUT ";\t$key\t$value\n";
	}
    }
}


__END__

=pod

=head1 SEE ALSO

=over

=item I<convert-graph>

=item I<graph-get-clusters>

=item I<graph-node-degree>

=item I<graph-neighbours>

=item I<random-graph>

=back

=cut
