package JgoughPhylo;
use strict;
use Exporter;
my @ISA;
my @EXPORT;
use GD;
# ISA = This package get functionalities from qw() content.
@ISA         = qw(Exporter);

##This written by Julian Gough 11.3.03

# Export methods you want:
@EXPORT = qw( List ReadTree DrawTree );

sub ReadTree{
#ARGS: ReadTree($treefile)
#read-in-tree-----------------------------------------
my $leaf='';
my @tree;
my $next=-1;
my $gen;
my $i;
my $flag=1;
my %nodeup;
my %distances;
my $treefile=$_[1];
my $node;
my ($one,$two,$three);
my @middles;
my $middle;
my $end;

open TREE,("$treefile");
while (<TREE>){
  if (/\S/){
$leaf=$leaf.$_;
chomp $leaf;
}
}
close TREE;
$leaf =~ s/\;//g;
@tree=split /,/,$leaf;
until ($flag == 0){
$flag=0;
$next=-1;
foreach $i (0 .. scalar(@tree)-1){
$leaf = $tree[$i];
unless ($leaf eq ':'){
unless ($next == -1){
  if ($leaf =~ /^([\w:]+):(-?\d+\.?\d*)\)(\S*)$/){
$distances{$1}=$2;
$end="$1$3";
$node=$gen;
$one=$1;
    foreach $middle (@middles){
$middle =~ /^(\S+):(-?\d+\.?\d*),(\d+)$/;
$node=$node.':'.$1;
$tree[$3]=':';
    }
$tree[$i]=':';
$node="$node:$end";
$tree[$next]=$node;
$node =~ s/:-?\d+\.?\d*\)//g;$node =~ s/:-?\d+\.?\d*$//g;$node =~ s/\)//g;$node =~ s/\(//g;
$gen =~ s/\)//g;$gen =~ s/\(//g;
$one =~ s/\)//g;$one =~ s/\(//g;
$nodeup{$gen}=$node;
$nodeup{$one}=$node;
    foreach $middle (@middles){
$middle =~ /^([\w\:]+):(-?\d+\.?\d*),(\d+)$/;
$distances{$1}=$2;
$nodeup{$1}=$node;
    }
$flag=1;
$next=-1;
  }
elsif ($leaf =~ /\)/ or $leaf =~ /\(/){
$next=-1;
  }
else{
push @middles,"$leaf,$i";
}
}
if($leaf =~ /^(\S*)\(([\w:]+):(-?\d+\.?\d*)$/){
$distances{$2}=$3;
@middles=();
$next=$i;
$gen="$1$2";
}
}
}
}
$distances{$node}=0;
return(\%nodeup,\%distances);
#-----------------------------------------------------
}


sub DrawTree{
#ARGS: DrawTree($outfile,$linesize,$textborder,$imageheight,$imagewidth,$bordersize,\%nodeup,\%nodex,\%labels,\%nodedata,\%linesizes,\%backlinesizes)
#ASSIGN-VARIABLES------------------------------------
#parameters
my $linesize=$_[2];
my $textborder=$_[3];
my $imageheight=$_[4];
my $imagewidth=$_[5];
my $bordersize=$_[6];
#----------
my $usage;
my $outfile=$_[1];
my @temp;
my @members;
my $node;
my $root='';
my %nodeup;
my (%nodex,%nodey,%labely,%ymin,%ymax,%labels,%nodedata,%linesizes,%backlinesizes);
my ($i,$j,$x,$y);
my $max=0;
my $min=999999;
my ($black,$image,$white,$grey);
my $labelheight=0;
my $labelwidth=0;
my (@len,@order,@nodes);
my ($line,$lineup);
my $databoxheight=0;
my $databoxwidth=0;
my $extraheight;
my %yminno;
#----------------------------------------------------

#READ-TREE--------------------------------------------
$i=$_[7];
if (defined($i)){
%nodeup=%$i;
}
$i=$_[8];
if (defined($i)){
%nodex=%$i;
}
$i=$_[9];
if (defined($i)){
%labels=%$i;
}
$i=$_[10];
if (defined($i)){
%nodedata=%$i;
}
$i=$_[11];
if (defined($i)){
%linesizes=%$i;
}
$i=$_[12];
if (defined($i)){
%backlinesizes=%$i;
}
#-----------------------------------------------------

#PROCESS-TREE-----------------------------------------
#labelsizes
foreach $node(keys(%nodex)){
chomp($nodedata{$node});
@temp=split /\n/,$nodedata{$node};
$i=scalar(@temp);
foreach $line (@temp){
  if ($databoxwidth < length($line)*5+2*$textborder){
$databoxwidth = length($line)*5+2*$textborder;
  }
}
  if ($databoxheight < $i*7+2*$textborder){
$databoxheight = $i*7+2*$textborder;
  }
unless (exists($labels{$node})){
  unless ($node =~ /:/){
$labels{$node}=$node;
  }
}
if (exists($labels{$node})){
chomp($labels{$node});
@temp=split /\n/,$labels{$node};
$i=scalar(@temp);
foreach $line (@temp){
  if ($labelwidth < length($line)*9+2*$textborder){
$labelwidth = length($line)*9+2*$textborder;
  }
}
  if ($labelheight < $i*12+2*$textborder){
$labelheight = $i*12+2*$textborder;
  }
}
}
if ($labelheight-$databoxheight < $linesize){
$labelheight=$databoxheight+$linesize;
}
#----------
#get-order---
@nodes=keys(%nodex);
for $i (0 .. scalar(@nodes)-1){
$len[$i]=length($nodes[$i]);
}
@order=JgoughPhylo->OrderArray(@len);
#------------
#X-COORDINATES--------------
#find-coordintes----
foreach $i (0 .. scalar(@order)-1){
  $node=$nodes[$order[scalar(@order)-1-$i]];
unless ($nodex{$node} >= 0){
$nodex{$node}=-$nodex{$node};
}
  if (exists($nodeup{$node})){
$nodex{$node}=$nodex{$node}+$nodex{$nodeup{$node}};
}
}
#-------------------
foreach $node (keys(%nodex)){
  if (length($node) > length($root)){
$root=$node;
  }
  if ($max < $nodex{$node}){
$max=$nodex{$node};
  }
  if ($min > $nodex{$node} or $min == 999999){
$min=$nodex{$node};
  }
}
@members = split /:/,$root;
#imagesize-
$extraheight=$imageheight - (($databoxheight-1)*scalar(@members)+$labelheight*scalar(@members)+2*$bordersize);
if ($extraheight < 0){
$imageheight=$databoxheight*(scalar(@members)-1)+$labelheight*scalar(@members)+2*$bordersize;
$extraheight=0;
}
if ($imagewidth < 2*$bordersize+$linesize+$labelwidth+$databoxwidth){
$imagewidth=2*$bordersize+$linesize+$labelwidth+$databoxwidth;
}
#----------
foreach $node (keys(%nodex)){
$nodex{$node}=$bordersize+($nodex{$node})*(($imagewidth-($bordersize*2)-$databoxwidth-$labelwidth)/($max-$min))+$linesize/2;
}
#---------------------------
#Y-COORDINATES--------------
$y=$bordersize-$labelheight/2-$databoxheight-$extraheight/(scalar(@members)-1)-1;
foreach $node (@members){
$y=$y+$databoxheight+$labelheight+$extraheight/(scalar(@members)-1);
$nodey{$node}=$y;
$labely{$node}=$y;
unless (exists($ymax{$nodeup{$node}})){
$ymax{$nodeup{$node}}=$y;
}
elsif ($ymax{$nodeup{$node}} < $y){
$ymax{$nodeup{$node}}=$y;
}
unless (exists($ymin{$nodeup{$node}})){
$ymin{$nodeup{$node}}=$y;
$yminno{$nodeup{$node}}=$node;
}
elsif ( $ymin{$nodeup{$node}} > $y){
$ymin{$nodeup{$node}}=$y;
$yminno{$nodeup{$node}}=$node;
}
}
foreach $i (@order){
$node=$nodes[$i];
unless (exists($nodey{$node})){
$nodey{$node}=($ymax{$node}-$ymin{$node})/2+$ymin{$node};
@temp=split /:/,$yminno{$node};
$min=0;
foreach $j (@temp){
  if ($min < $nodey{$j}){
$min=$nodey{$j};
  }
}
$labely{$node}=$min+($databoxheight+$labelheight)/2+$extraheight/(2*(scalar(@members)-1));
if (exists($nodeup{$node})){
unless (exists($ymax{$nodeup{$node}})){
$ymax{$nodeup{$node}}=$nodey{$node};
}
elsif ($ymax{$nodeup{$node}} < $nodey{$node}){
$ymax{$nodeup{$node}}=$nodey{$node};
}
unless (exists($ymin{$nodeup{$node}})){
$ymin{$nodeup{$node}}=$nodey{$node};
$yminno{$nodeup{$node}}=$node;
}
elsif ( $ymin{$nodeup{$node}} > $nodey{$node}){
$ymin{$nodeup{$node}}=$nodey{$node};
$yminno{$nodeup{$node}}=$node;
}
}
}
}
#---------------------------
#-----------------------------------------------------

#GD-START---------------------------------------------
#start a new image
$image = new GD::Image($imagewidth,$imageheight);
# allocate some colours
$white = $image->colorAllocate(255,255,255);
$black = $image->colorAllocate(0,0,0);
$grey = $image->colorAllocate(160,160,160);
# make the background transparent and interlaced
$image->transparent($white);
$image->interlaced('true');
#-----------------------------------------------------

#DRAW-TREE--------------------------------------------
#backlines-
if (scalar(keys(%backlinesizes)) > 0){
foreach $i (@order){
$node=$nodes[$i];
  if (exists($backlinesizes{$node})){
$line=$backlinesizes{$node};
  }
else{
$line=$linesize;
print STDERR "WARNING: missing width definition for grey lines, node: $node\n-using default-\n";
}
if (exists($nodeup{$node})){
  if (exists($backlinesizes{$nodeup{$node}})){
$lineup=$backlinesizes{$nodeup{$node}};
  }
else{
$lineup=$linesize;
print STDERR "WARNING: missing width definition for grey lines, node: $nodeup{$node}\n-using default-\n";
}
$image->arc(($nodex{$nodeup{$node}}-($lineup-$line)/2),$nodey{$node},$line,$line,0,360,$grey);
$image->fillToBorder(($nodex{$nodeup{$node}}-($lineup-$line)/2),$nodey{$node},$grey,$grey);
  unless ($node =~ /:/){
$image->arc($nodex{$node}-($line/2),$nodey{$node},$line,$line,0,360,$grey);
$image->fillToBorder($nodex{$node}-($line/2),$nodey{$node},$grey,$grey);
}
$image->filledRectangle(($nodex{$nodeup{$node}}-($lineup-$line)/2),($nodey{$node}-($line/2)),$nodex{$node}-($line/2),($nodey{$node}+($line/2)),$grey);
}
if (exists($ymax{$node})){
$image->filledRectangle(($nodex{$node}-($line/2)),$ymin{$node},$nodex{$node}+($line/2),($ymax{$node}),$grey);
}
}
}
#----------
#lines-
foreach $i (@order){
$node=$nodes[$i];
  if (exists($linesizes{$node})){
$line=$linesizes{$node};
}
else{
$line=$linesize;
if (scalar(keys(%linesizes)) > 0){
print STDERR "WARNING: missing width definition for lines, node: $node\n-using default-\n";
}
}
  if (exists($nodeup{$node})){
  if (exists($linesizes{$nodeup{$node}})){
$lineup=$linesizes{$nodeup{$node}};
  }
else{
$lineup=$linesize;
if (scalar(keys(%linesizes)) > 0){
print STDERR "WARNING: missing width definition for lines, node: $nodeup{$node}\n-using default-\n";
}
}
$image->arc(($nodex{$nodeup{$node}}-($lineup-$line)/2),$nodey{$node},$line,$line,0,360,$black);
$image->fillToBorder(($nodex{$nodeup{$node}}-($lineup-$line)/2),$nodey{$node},$black,$black);
  unless ($node =~ /:/){
$image->arc($nodex{$node}-($line/2),$nodey{$node},$line,$line,0,360,$black);
$image->fillToBorder($nodex{$node}-3,$nodey{$node},$black,$black);
}
$image->filledRectangle(($nodex{$nodeup{$node}}-($lineup-$line)/2),($nodey{$node}-($line/2)),$nodex{$node}-($line/2),($nodey{$node}+($line/2)),$black);
}
if (exists($ymax{$node})){
$image->filledRectangle(($nodex{$node}-($line/2)),$ymin{$node},$nodex{$node}+($line/2),($ymax{$node}),$black);
}
}
#------
#labels
foreach $node (@members){
@temp=split /\n/,$labels{$node};
$i=0;
foreach $line (@temp){
$y=$labely{$node}-12*scalar(@temp)/2+12*$i-2;
$image->string(gdGiantFont,$nodex{$node}+$textborder,$y,$line,$black);
$i++;
}
}
#------
#data--
foreach $i (@order){
$node=$nodes[$i];
if (exists($nodedata{$node})){
@temp=split /\n/,$nodedata{$node};
$j=0;
foreach $line (@temp){
$y=$labely{$node}-7*scalar(@temp)/2+7*$j;
if ($node =~ /:/){
if (exists($linesizes{$node})){
$x=$nodex{$node}+$textborder+$linesizes{$node}/2;
}
else{
$x=$nodex{$node}+$textborder+$linesize/2;
}
if (exists($backlinesizes{$node})){
  if ($nodex{$node}+$textborder+$backlinesizes{$node}/2 > $x){
$x=$nodex{$node}+$textborder+$backlinesizes{$node}/2;
}
}
}
else{
$x=$nodex{$node}+$textborder+$labelwidth;
}
$image->string(gdTinyFont,$x,$y,$line,$black);
$j++;
}
}
}
#------
#-----------------------------------------------------

#PRINT-PNG-FILE---------------------------------------
    # make sure we are writing to a binary stream
    binmode STDOUT;
open OUTPNG,(">$outfile.png");
    print OUTPNG $image->png;
close OUTPNG;
#-----------------------------------------------------

}
#-----------------------------------------------------

#SUB-ROUTINE-----------------------------------------------
sub OrderArray{
#  This reads in an array of values and orders them 
#returning the list of the order

my @values=@_;
shift (@values);
my %map;
my $i;
my @sorted;
my @listout;
my @temp;
my $flag;
my $j=0;
my $old='rumplestiltsin';

for $i(0..scalar(@values)-1){
 if (exists($map{$values[$i]})){
$map{$values[$i]}=join ',',$map{$values[$i]},$i;
     }
else{
$map{$values[$i]}=$i;
}
}
@sorted= sort NumericallySort @values;
for $i (0..scalar(@sorted)-1){
 if ($map{$sorted[$i]} =~ /,/){
   unless ($old eq $map{$sorted[$i]}){
$j=0;
$old=$map{$sorted[$i]};
   }
@temp=split /,/ , $map{$sorted[$i]};
$listout[$i]=$temp[$j];
$j++;
  }
else{
$j=0;
$listout[$i]=$map{$sorted[$i]};
}
}
return @listout;
}
#----------------------------------------------------------

#SUB-ROUTINE-----------------------------------------
sub NumericallySort {$a <=> $b;}
#----------------------------------------------------


1;