#!/usr/bin/perl
package Bio::NEXUS::Tools::NexPlotter;
######################################################################
# Derived from nexplot.pl (was plottree.pl prior to 9/15/03; the complete revision 
#   log from plottree.pl is in the initial version of nexplot.pl)
######################################################################
#
# $Author: astoltzfus $
# $Date: 2008/06/16 19:53:41 $
# $Revision: 1.2 $
# $Id: NexPlotter.pm,v 1.2 2008/06/16 19:53:41 astoltzfus Exp $

use strict;

use Pod::Usage;
use Data::Dumper;
use Bio::NEXUS::Tools::GraphicsParams;
use Bio::NEXUS; our $VERSION = $Bio::NEXUS::VERSION;


## Class variables
my $main_dir ='.';

my $runtime_options;
my $nexusG       = new Bio::NEXUS::Tools::GraphicsParams();
my $my_data_obj  = new MyData;
my $nexusObject;
my $DEBUG;
my $ppp_param;

sub new {

my $self     = shift; 
my $inp_data = $_[0];

$inp_data = {@_} if (ref($inp_data) ne 'HASH') ;


my $object_data = {
	'parameters' => {
		'input_file'		=> 'test.nex',
		'output_file'		=> 'test.ps',
		'show_content'			=> 'Tree and Data',
		'character_data_type'		=> 'Protein',
		'species_tree'			=> 'off',
		'show_bootstrap_values'		=>  'on',
		'show_inode_label'		=>  undef,
		'colorintron'			=>  undef,
		'set_type'			=>  undef,
		'kingdom'			=> {
			'vertebrate'	=> undef,
			'invertebrate'	=> undef,
			'plant'		=> undef,
			'fungi'		=> undef,
			'protist'	=> undef
		},
		'right_justify_labels'		=> undef,
		'tree_width'			=> $Bio::NEXUS::Tools::GraphicsParams::DefaultTreeWidth,
		'char_label_block_size'		=> $Bio::NEXUS::Tools::GraphicsParams::DefaultCharLabelBlockWidth ,
		'show_border'			=> undef,
		'vertical_otu_spacing'		=> $Bio::NEXUS::Tools::GraphicsParams::DefaultVerticalOtuSpacing,
		'output_type'			=> 'ps',
		'show_cladogram'		=> undef,
		'cladogrom_mode'		=> "normal",
		'color_sub_tree'		=> [],
		'select_char_range'		=> [],
		'setsbyinode'			=> [],
		'customset'			=> [],
		'highlight_otus'		=> [],
		'highlight_chars'  		=> [],
		'ppp'				=>  undef,
		'reroot_node'			=> [],
		'exclude_sub_tree'		=> [],
		'swap_children'			=> [],
		'select_sub_tree'		=> [],
	},
	'data'    => {
			'nexus_obj'   => undef,
			'my_data'     => undef, 
			'gfx'         => undef,
	}
};

foreach my $field ( keys %{ $object_data->{'parameters'} } ) {
    my @field1 = grep(/^.?$field$/,keys %{$inp_data}) ;
	if ( scalar @field1 > 0 ){
		$object_data->{'parameters'}->{$field} = $inp_data->{$field1[0]};
	} 
}

#print Dumper $object_data;
my @column_nos;
foreach my $columns (@ {$object_data->{'parameters'}->{'select_char_range'} }) {
	push(@column_nos,@{&parse_number($columns)}) if $columns;
} 
$object_data->{'parameters'}->{'select_char_range'} = \@column_nos;

$self = bless ($object_data,$self);
#print Dumper $self;
$runtime_options = $object_data->{'parameters'};
$ppp_param       = $runtime_options->{'ppp'};


##  1. print Header and the top menu for CGI  
#print Dumper $runtime_options;

$nexusObject = &__read_nexus();	# Read in the NEXUS file and extract relevant information.

die "Error in loading the Plot module : $@\n" if ($@);

$my_data_obj->set_title($nexusObject->get_filename);
if ($runtime_options->{'species_tree'} ne 'on') {
	foreach my $block (@{$nexusObject->get_blocks()} ) {
		my $input_block_type = $runtime_options->{'character_data_type'};
		if ($block->get_type =~/characters/i && $block->get_title =~/$input_block_type/i){
			$my_data_obj->set_selected_char_block($block) ;
		}
	}
	$my_data_obj->set_selected_char_block( $nexusObject->get_block("character") ) if not defined $my_data_obj->get_selected_char_block;
	if (defined $my_data_obj->get_selected_char_block) { 
		my @selectchar_params  = @{ $runtime_options->{'select_char_range'} };	
		$nexusObject = $nexusObject->select_chars(\@selectchar_params,$my_data_obj->get_selected_char_block->get_title) if (@selectchar_params);
	}
	if ($nexusObject->get_block("trees")) {
		my $tree = $nexusObject->get_block("trees")->get_tree;
		$my_data_obj->set_selected_tree( $tree );
	}

} else {

	$my_data_obj->set_selected_tree( $nexusObject->get_block );
	my $hist_dup = $nexusObject->get_block('history','duplication_speciation');
	$my_data_obj->set_selected_char_block(undef); 
	$my_data_obj->set_selected_tree( $hist_dup->get_tree('species_tree') ); 
	$my_data_obj->set_gene_tree( $hist_dup->get_tree('gene_tree') ); 
	$my_data_obj->set_species_tree( $hist_dup->get_tree('species_tree') ); 

}

#### 4. Graphics Layout and pupulating my_data object - set all  size of the canvas and the panes based on the
####    CGI options and content of the NEXUS file.

#gdSmallFont->width
$nexusG->set_fontWidth(6);
$nexusG->set_fontHeight(13);
$nexusG->set_verticalOtuSpacing($runtime_options->{'vertical_otu_spacing'});
$nexusG->set_charLabelBlockWidth($runtime_options->{'char_label_block_size'});

my $taxlabels;
if ($my_data_obj->get_selected_tree) {
	$taxlabels = $my_data_obj->get_selected_tree->get_node_names();
} else {
	$taxlabels = $nexusObject->get_block('taxa')->get_taxlabels();
}
$nexusG->set_maxTaxLabelwidth($taxlabels);
$nexusG->set_paneHeight(scalar @$taxlabels);

if ($my_data_obj->get_selected_char_block && ( $runtime_options->{'show_content'} ne "Tree only")) {
	$nexusG->set_histogramHeight if $my_data_obj->get_char_block_wts;
	my $block = $my_data_obj->get_selected_char_block;
	$nexusG->set_charactersXwidth($block);
	my @col_labels = $my_data_obj->get_char_column_labels;
	$nexusG->set_longestCharLabelLength(@col_labels) if @col_labels;
}

#print "<PRE>";
#print "</PRE>";

$nexusG->set_lowerXbound;
$nexusG->set_lowerYbound;

if ($runtime_options->{'show_content'} ne 'Data only' && defined $my_data_obj->get_selected_tree) {
	$nexusG->set_TreeWidth($runtime_options->{'tree_width'}*72);
	&__set_node_coords($my_data_obj->get_selected_tree);
}
$nexusG->set_upperXbound;
$nexusG->set_upperYbound;
$nexusG->set_xsize;
$nexusG->set_ysize;

#print "<PRE>";
#print Dumper $nexusG;
#print "</PRE>";

### 5. Open the image handlers for drawing

## 5.a load the specific module 
if ($runtime_options->{'output_type'} eq "ps") {
    eval 'use PostScript::Simple';
} elsif ($runtime_options->{'output_type'} eq "pdf") {
	eval 'use PDF::API2::Lite';
} else {
	eval 'use GD::Simple';
}


## 5.b Initialize graphics module
if ($runtime_options->{'output_type'} eq "ps" ) {
	my $p = new PostScript::Simple(
		xsize		=> $nexusG->get_xsize,
		ysize		=> $nexusG->get_ysize,
		colour		=> 1,
		eps		=> 0,
		units		=> "pt",
		coordorigin 	=> "LeftTop",
		direction 	=> "RightDown");
	$p->newpage;
	$p->setfont("Courier",10);
	$my_data_obj->set_image_handler($p);
}
elsif ( $runtime_options->{'output_type'} eq "pdf" ) {
	my $p    = new PDF::API2::Lite;
	my $font = $p->corefont("Courier");
	$p->page($nexusG->get_xsize,$nexusG->get_ysize);
	$my_data_obj->set_image_handler($p);
	$my_data_obj->set_font($font);
}
else {
	my $im = new GD::Simple($nexusG->get_xsize,$nexusG->get_ysize);
# make the background transparent and interlaced
#$im->transparent($white);
	$im->interlaced('true');
	$my_data_obj->set_image_handler($im);
	$my_data_obj->allocate_colors;
	$my_data_obj->set_font(gdSmallFont());
}


##############################

# Assgn state to nodes by taxonomy
# PRINT TREE AND OTHER ELEMENTS IF PRESENT

my $tree = $my_data_obj->get_selected_tree;
# used taxlabels before from taxa block, now getting them from tree
$taxlabels = ($tree) ? $tree->get_node_names() : $nexusObject->get_block('taxa')->get_taxlabels();

##### 7. Coloring data and tree based on the NCBI Taxonomy option

if ($runtime_options->{'set_type'} eq 'Taxonomy') {
	&__assign_ncbi_taxonomy($my_data_obj,$taxlabels);
}


##### 8.  Custom set processing for taxa label colors #######
if ($runtime_options->{'set_type'} eq 'Custom') {
	my $taxlabels = $nexusObject->get_block('taxa')->get_taxlabels();
	for my $taxlabel (@$taxlabels) {
		$my_data_obj->set_node_color($taxlabel,'black');
	}
	if ($nexusObject->get_block('sets')) {
# redundant to subsequent code
# my $taxSets = $nexusObject->get_block('sets')->get_taxsets();

		my $block = $nexusObject->get_block('sets');
		warn("Grabbing sets block from NEXUS file...\n") if $DEBUG;
		my $taxSets = $block->get_taxsets();

		my %setsColors;
		my $count = 1;
		my @customset_params = @{ $runtime_options->{'customset'} };
		foreach my $key (sort keys %{$taxSets}) {
			$setsColors{$key} = $customset_params[$count-1];
			$count++;
		}
		for my $taxSetName (sort keys %{$taxSets}) {
			for my $taxon (@{$taxSets->{$taxSetName}}) {
				my $col_name = $setsColors{$taxSetName};
				$my_data_obj->set_node_color($taxon,$col_name) if $col_name =~/\S+/;
			}
		}
	}
}
##### 9. propagating coloring options on the tree 
	my @colornode_params             = @{ $runtime_options->{'color_sub_tree'} };    		# Color a node and its children
if (defined $tree) {
	my $root = $tree->get_rootnode(); 
	my $node = $tree->find($colornode_params[$#colornode_params]) if ($colornode_params[0] ne '');

	&AssignStateToNode( $my_data_obj->get_nodes_hash,$root,'black');

	my @highlight_params = @{ $runtime_options->{'highlight_otus'} };
	foreach my $highlight_param(@highlight_params) {
		my @nodes_list;
		&AssignStateToSuperNode($my_data_obj,$root,$highlight_param,\@nodes_list,'gold') if ($highlight_param);
	}
	&AssignStateToSubNode($my_data_obj,$node,'highlighter') if ($colornode_params[0] ne '' && $node);	
}


##### 10. Drawing the tree and character matrix data.

if (($runtime_options->{'show_content'} eq 'Data only') || (not defined $tree))  {
	&__print_matrix($my_data_obj,$nexusG->get_lowerXbound, $nexusG->get_lowerYbound,$taxlabels,1);
} else {
	&__print_tree($my_data_obj,$tree->get_rootnode, $nexusG->get_lowerXbound, $nexusG->get_lowerYbound) if defined $tree;
	&__print_matrix($my_data_obj,$nexusG->get_lowerXbound, $nexusG->get_lowerYbound,$taxlabels,0) if ($runtime_options->{'show_content'} eq 'Tree and Data');
	if (defined $nexusObject->get_block("history",'intron') && $ppp_param) {
		my $otus = $nexusObject->get_block("history",'intron')->get_otuset->get_otus;
		my $otu_seq_hash;
		%{$otu_seq_hash} = map {$_->get_name  => $_->get_seq} @{$otus};
		&__print_piechart($my_data_obj,$tree->get_rootnode, $otu_seq_hash);
	}
	&__print_inode_names($my_data_obj,$tree->get_nodes) if ($runtime_options->{'show_inode_label'} eq 'on') ;
	&__print_boot_strap($my_data_obj,$tree->get_nodes) if ($runtime_options->{'show_bootstrap_values'} eq 'on') ;
}
	if ($my_data_obj->get_selected_char_block && $runtime_options->{'show_content'} ne 'Tree only') {		# Character labels, weights
		my $block = $my_data_obj->get_selected_char_block;
		 if ($my_data_obj->get_char_column_labels) {
			 &__print_char_labels($my_data_obj,$block);
			 &__highlight_char($my_data_obj,$block);	
		}
		&__plot_wts($my_data_obj,$my_data_obj->get_char_block_wts) if ( $my_data_obj->get_char_block_wts ) ;
	}

&__plot_scale_border_title($my_data_obj);
#&__save_session($session);

#print "<pre>",Dumper($nexusObject),"</pre>";
# 11. Convert the image handler output to PNG, PS and PDF format based on the output option.  

if ($runtime_options->{'output_type'} eq "ps") {
	$my_data_obj->get_image_handler->output($runtime_options->{'output_file'})
}
elsif ($runtime_options->{'output_type'} eq "pdf") {
	$my_data_obj->get_image_handler->saveas($runtime_options->{'output_file'});
}
else {
	open(PNG,">$runtime_options->{'output_file'}") || die "cannot open file\n";   
	binmode PNG;
	print PNG $my_data_obj->get_image_handler->png() || die "DIED";
	close PNG;
}
$self->set_data($nexusObject,$my_data_obj,$nexusG);
return $self;
};

#################################################################### SUBROUTINES

=head2 get_data

 Title   : get_data
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub get_data {
	my $self = shift;
	return ($self->{'data'}->{'nexus_obj'},$self->{'data'}->{'my_data'},$self->{'data'}->{'gfx'} ) ; 
}

=head2 set_data

 Title   : set_data
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub set_data {
	my $self = shift;
	my ($nexus_obj,$my_data,$gfx) 	= @_;
	$self->{'data'}->{'nexus_obj'} 	= $nexus_obj; 
	$self->{'data'}->{'my_data'} 	= $my_data; 
	$self->{'data'}->{'gfx'} 	= $gfx; 
}

=head2 rgb2hex

 Title   : rgb2hex
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub rgb2hex {
	my $rgb_hash = shift;
	return "#". join "", map {sprintf "%2.2X",$_} @{$rgb_hash};
}

sub __draw_piechart {
	my ($my_data,$x, $y, $radius, $prob) = @_;
	my $im_h = $my_data->get_image_handler;
	if ($my_data->get_image_handler_type eq 'pdf') {
		$im_h->strokecolor($my_data->get_color('silver'));
		$im_h->circle($x, $nexusG->get_ysize-$y, $radius/2);
		$im_h->strokecolor($my_data->get_color('black'));
		$im_h->circle($x,$nexusG->get_ysize-$y,$radius/2);
		$im_h->stroke;
		$im_h->fillcolor($my_data->get_color('red'));
		$im_h->arc($x,$nexusG->get_ysize - $y,$radius/2,$radius/2,0,$prob*360 + 0.1,1);
		$im_h->fill;
	}elsif ($my_data->get_image_handler_type eq 'ps') {
		$im_h->setlinewidth(1);
		$im_h->setcolour(@{$my_data->get_color('silver')});
		$im_h->circle({filled => 1},$x,$y,$radius/2);
		$im_h->setcolour(@{$my_data->get_color('black')});
		$im_h->circle($x,$y,$radius/2);
		$im_h->setcolour(@{$my_data->get_color('red')});
		my $start = 0;
		if ($prob >= 0.5) {
			$start = 180;
			$prob -= 0.5;
			$im_h->arc({filled=>1}, $x, $y, $radius/2, 180, 0);
		}
		&__draw_pieslice($my_data,$x,$y,$radius,$prob,$start);
	} else {
		$im_h->moveTo($x,$y);
		$im_h->penSize(1,1);
#$im->bgcolor(undef);
		$im_h->bgcolor($my_data->get_color('silver'));
		$im_h->arc($radius,$radius,0,360,gdArc());
		$im_h->fgcolor($my_data->get_color('black'));
		$im_h->bgcolor($my_data->get_color('red'));
		$im_h->arc($radius,$radius,0,$prob*360,gdEdged()|gdArc());

		$im_h->moveTo($x,$y);
		$im_h->bgcolor(undef);
		$im_h->fgcolor('black');
		$im_h->ellipse($radius,$radius);
	}
}

sub __draw_pieslice {
	my ($my_data,$x,$y,$radius,$prob,$start) = @_;
	my $im_h = $my_data->get_image_handler;
	my $pi = 3.14159265;
	my $start_rad = $start/180 * $pi;
	my $prob_rad = $prob * 2 * $pi;
	$im_h->arc({filled=>1},$x,$y,$radius/2,360-($start+$prob*360),$start);
	$im_h->polygon({filled=>1},$x,$y,$x+$radius/2*cos($start_rad),$y+$radius/2*sin($start_rad),$x+$radius/2*cos($prob_rad+$start_rad),$y+$radius/2*sin($prob_rad+$start_rad));
}

sub __draw_line {
	my ($my_data,$x1, $y1, $x2, $y2, $color, $size) = @_;
	my $im_h = $my_data->get_image_handler;
	my $color_val = $my_data->get_color($color);
	if ($my_data->get_image_handler_type eq 'pdf') {
		$im_h->strokecolor($color_val);
		#$im_h->linewidth(1);
		$im_h->move($x1, $nexusG->get_ysize-$y1);
		$im_h->line($x2, $nexusG->get_ysize-$y2);
		$im_h->stroke;
	}elsif ($my_data->get_image_handler_type eq 'ps') {
		if ($size == 0.5) { $im_h->setlinewidth(0.5); }
		else { $im_h->setlinewidth(1.5); }
		$im_h->setcolour(@{$color_val});
		$im_h->line($x1,$y1,$x2,$y2);
	}
	else {
		$im_h->moveTo($x1,$y1);
		$im_h->penSize($size,1);
		$im_h->fgcolor($color_val);
		$im_h->lineTo($x2,$y2);
	}
}

sub __draw_text {
	my ($my_data, $x, $y, $string, $color) = @_;
	my $font = $my_data->get_font;
	my $im_h = $my_data->get_image_handler;
	my $color_val = $my_data->get_color($color);
	if ($my_data->get_image_handler_type eq 'pdf') {
		$im_h->fillcolor($color_val);
		$im_h->print($font,10,$x,$nexusG->get_ysize-$y,0,0,$string);
		$im_h->fill;
		
	}elsif ($my_data->get_image_handler_type eq 'ps') {
		$im_h->setcolour(@{$color_val});
		$im_h->text($x, $y + ($nexusG->get_fontHeight/4),$string);
	}
	else {
#$font="Courier";
		$im_h->moveTo($x,$y+($nexusG->get_fontHeight)/2);
		$im_h->font($font);
		$im_h->fontsize(14) if ($font eq 'Times');
		$im_h->fgcolor($color_val);
		$im_h->string($string);
	}
}


sub __draw_circle {
	my ($my_data,$x, $y, $radius, $color) = @_;
	my $im_h = $my_data->get_image_handler;
	my $color_val = $my_data->get_color($color);
	if ($my_data->get_image_handler_type eq 'pdf') {
		$im_h->strokecolor($color_val);
		#$im_h->linewidth(1);
		$im_h->circle($x,$nexusG->get_ysize - $y, $radius/2);
		$im_h->stroke;
	}elsif ($my_data->get_image_handler_type eq 'ps') {
		$im_h->setlinewidth(1);
		$im_h->setcolour(@{$color_val});
		$im_h->circle($x,$y,$radius/2);
	}else {
		$im_h->moveTo($x,$y);
		$im_h->fgcolor($color_val);
		$im_h->bgcolor($color_val);
		$im_h->arc($radius,$radius,0,360,gdEdged()|gdArc());
	}
}

sub __draw_filledRect {
	my ($my_data,$x1, $y1, $x2, $y2, $color,$transparency) = @_;
	my $color_val = $my_data->get_color($color);
	my $im_h = $my_data->get_image_handler;
	if ($my_data->get_image_handler_type eq 'pdf') {
		if (ref $color_val) {
			$im_h->fillcolor(&rgb2hex($color_val));
		}else {
			$im_h->fillcolor($color_val);
		}
		$im_h->rectxy($x1,$nexusG->get_ysize - $y1,$x2,$nexusG->get_ysize-$y2);
		$im_h->fill;
	} elsif ($my_data->get_image_handler_type eq 'ps') {
		$im_h->setcolour(map {$_*1} @{$color_val});
		$im_h->box({filled=>1},$x1,$y1,$x2,$y2);
	} else {
		if (ref $color_val) {
			$im_h->bgcolor(@{$color_val});
		}else {
			$im_h->bgcolor($color_val);
		}
		$im_h->rectangle($x1,$y1,$x2,$y2);
	}
}


=head2 checkNumber

 Title   : checkNumber
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub checkNumber {
	my $arg=$_[0];
	if ($arg =~ /(\d+\.?\d*|\.\d+)/) {
		return $arg;
	} else {
		return undef;
	}
}

=head2 isNumber

 Title   : isNumber
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub isNumber {
	my $arg=$_[0];
	my $var=$_[1];
	if ($arg =~ /(\d+\.?\d*|\.\d+)/) {
		return 1;
	} else {
		return 0;
	}
}

sub __read_nexus {
	my $mydata    = shift;
	my $inputFile = $runtime_options->{'input_file'};
	my $nexusObject;
	if($nexusG->get_isVerbose) {
		$DEBUG=1;
		$nexusObject = new Bio::NEXUS($inputFile,1);
	} else {
		$nexusObject = new Bio::NEXUS($inputFile);
	}

	if ($runtime_options->{'species_tree'} eq 'on') {
		return $nexusObject;
	}
# Read in NEXUS blocks from NEXUS object

	my @selectsub_params             = @{ $runtime_options->{'select_sub_tree'} };      # Select a subtree
	my @reroot_params                = @{ $runtime_options->{'reroot_node'} };       # Reroot a subtree
	my @swap_params                  = @{ $runtime_options->{'swap_children'} };          # Swap the children of the node
	my @excludesub_params            = @{ $runtime_options->{'exclude_sub_tree'} };    # Exclude a subtree
	my @setsbyinode_params 		 = @{ $runtime_options->{'setsbyinode'} };	
	my $tree;


	if ($nexusObject->get_block('trees')) {

		$nexusObject = $nexusObject->reroot($reroot_params[$#reroot_params]) if ($reroot_params[0] ne '');
		$nexusObject = $nexusObject->select_subtree($selectsub_params[$#selectsub_params]) if ( $selectsub_params[0] ne '' );

		foreach my $excludesub_param (@excludesub_params) {
			$nexusObject = $nexusObject->exclude_subtree($excludesub_param);
		}

		$tree = $nexusObject->get_block("trees")->get_tree();
		foreach my $swapnode(@swap_params){
			last if ($swapnode eq '');
			&swap_children($tree,$swapnode) if ($tree->find($swapnode));
		}
	} else {
		$nexusObject = $nexusObject->exclude_otus(\@excludesub_params);
	}

	if ($selectsub_params[0] ne '' || $excludesub_params[0] ne '') {
		my @intron_present_cols=();
		my @taxa = @{$nexusObject->get_block("characters")->get_taxlabels()} if $nexusObject->get_block("characters");
		my %intron_seqs = %{$nexusObject->get_block("characters","intron")->get_otuset->get_seq_string_hash} if $nexusObject->get_block("characters","intron");
		for (my $c=0; $c < length($intron_seqs{$taxa[0]}); $c++) {
			foreach my $taxon (@taxa) {
				my $sequence = $intron_seqs{$taxon};
				if (substr($sequence,$c,1) ne '0') {
					push @intron_present_cols, $c;
					last;
				}
			}
		}
		$nexusObject = $nexusObject->select_chars(\@intron_present_cols) if (lc($runtime_options->{'character_data_type'}) eq 'intron');
	}

#### Set by Inode ###
	if (defined $nexusObject->get_block("Trees") && $nexusObject->get_block("trees")->get_tree) {
		my $sets;
		my $setsblock;
		for my $inodename (@setsbyinode_params) {
			my $subtree = $nexusObject->select_subtree($inodename);
			my $otus = $subtree->get_otus();
			$$sets{$inodename} = $otus;
		}
		if ($nexusObject->get_block('Sets')) {
			$nexusObject->get_block('Sets')->add_taxsets($sets);
		} else {
			$setsblock = Bio::NEXUS::SetsBlock->new('Sets',[]);
			$setsblock->set_taxsets($sets);
			$nexusObject->add_block($setsblock);
		}

	}
#########


#my @trees = @{$block->get_trees()};		##### Get names of all trees in the file
#foreach my $myTree (@trees) {
# 	$myTreeName = $myTree->{name};
#	print "Tree: $myTreeName<br>";
#}

# EXTRACT TREE DATA
#die "No tree in file $inputFile\n" unless $tree;
return $nexusObject;
}

=head2 parse_number

 Title   : parse_number
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

# parse numbers in format "1-3, 4 6 8-10"
#Taken from nextool.pl

sub parse_number {
    my $s =  shift;
    
    if (! $s =~ /^\s*(\d+(-\d+)?)([,\s]\s*\d+(-\d+)?)*\s*$/ ) { 
        die "Invalid number format.  Use 1 or 1-3 or 1, 3, 5-8 or 1 3 5 6-10.\n"; 
    } 
    $s =~ s/^\s+|\s+$//g;
    $s =~ s/,?\s+/,/g;  # use ',' as separator
    my @cols = split(/,/, $s);
    
    my @arr;
    foreach my $item (@cols) {
        if ($item =~ /-/) { # eg 1-3
            $item =~ /([0-9]+)\s*-\s*([0-9]+)/;
            for (my $i = $1; $i <= $2; $i++) { push ( @arr, $i-1 ); }
        } elsif ($item =~ /^\d+$/) { # eg 4
            push ( @arr, $item-1 );
        } elsif ($item) {
            die "non-number was used for column number\n";
        }
    }

    @arr = sort {$a<=>$b} @arr;
    return \@arr;
}

=head2 AssignStateToNode

 Title   : AssignStateToNode
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub AssignStateToNode { 
# AssignStateToNode -- propagate colors or other states up a tree
#
# Technically, what we are doing here is reconstructing ancestral states 
# based on a transition model of infinite cost (zero rate), so that no 
# transitions are allowed.  Thus, an ancestor is assigned to a state 
# _i_ if and only if all of its descendants are assigned to state _i_.  
#
# this function 
#    * probably should be put in a library and named something like 
#      "AssignAncestralStatesByConsensus"; 
#    * maps states to the *names* of nodes, not to their object refs;
#    * allows for polytomies; 
#    * does not assume all OTUs have defined states, but note that 
#       any undefined states of OTUs *will remain undefined*
#$node          # node object
#$unknownState # state to assign when no other assignment can be made 
#$map           # hash with any available states
	my ($map, $node, $unknownState) = @_;
	my $name = $node->get_name; 
	my $lastState = undef; 
	my $assignable = 1; 

# return if state already exists OR if the node is an OTU
	return if (defined($map->{$name}) || $node->is_otu() ); 

# Go through children and make sure all children are the same state
	foreach my $child (@{$node->get_children()}) {
		my $childname = $child->get_name;
		&AssignStateToNode($map, $child, $unknownState) unless $map->{$childname};
		if ( defined($lastState) && $$map{$childname} ne $lastState ) { 
			$assignable = 0; 
		}
		$lastState = $map->{$childname}; 
	}
	return( $map->{ $name } = ( $assignable ? $lastState : $unknownState ) ); 
} 

=head2 AssignStateToSuperNode

 Title   : AssignStateToSuperNode
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub AssignStateToSuperNode {
# AssignStateToSuperNode -- propogate color up a tree to highlight a sequence's branch path
	my ($my_data, $node, $OTU, $nodesListRef, $color) = @_;
	my @nodesList = @$nodesListRef;
	my $name = $node->get_name;

	return if ($node && $node->is_otu() && ($name ne $OTU));
	if ($nodesList[$#nodesList] eq $OTU) {
		foreach my $node_name (@nodesList) {
			$my_data->set_node_color($node_name, $color);
		}
		return;
	}

	foreach my $child (@{$node->get_children()}) {
		my @newNodesList = @nodesList;
		push @newNodesList,$child->get_name;
		&AssignStateToSuperNode($my_data,$child,$OTU,\@newNodesList,$color);
	}

	return;
}

=head2 AssignStateToSubNode

 Title   : AssignStateToSubNode
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub AssignStateToSubNode { 
# AssignStateToNode -- propagate colors or other states down a tree once a node is selected
	my ($my_data, $node, $color) = @_;
	my $name = $node->get_name;
	return if (!$node || $node->is_otu());

	foreach my $child (@{$node->get_children()}) {
		$my_data->set_node_color($child->get_name,$color);
		&AssignStateToSubNode($my_data, $child, $color);
	}
	return;
} 

sub __print_piechart {
	my ($my_data, $node, $otu_seq_hash)  = @_;
	my $name 		= $node->get_name();
	my $x 			= $node->_get_xcoord;
	my $y 			= $node->_get_ycoord;
	my $seq 		= $otu_seq_hash->{$name}->[$ppp_param-1];
	my $prob 		= 0;
	$prob 			= ((ref $seq) eq 'ARRAY') ? $seq->[1] : $seq;
	&__draw_piechart($my_data,$x, $y, $nexusG->get_pieChartRadius, $prob);
	foreach my $child (@{$node->get_children()}) {
		&__print_piechart($my_data,$child,$otu_seq_hash);
	}
}

sub __print_tree {
	my ($my_data,$node, $x0, $y0,$otuseqs) = @_;
	my $name = $node->get_name();
	my $x1 = int($node->_get_xcoord);
	my $y1 = 0;
	my $color;
	my $prob_val = '';
	my $treeNodeRadius = $nexusG->get_treeNodeRadius;
	my $pieChartRadius = $nexusG->get_pieChartRadius;
	$color             = (!$runtime_options->{'set_type'} || $runtime_options->{'set_type'} eq 'None') ? $my_data->get_node_color($name)||'black' : $my_data->get_node_color($name)||'gray';
#$y1               +=  $nexusG->get_fontHeight;
	if ($ppp_param && $nexusObject->get_block('history','intron')) {
		my $seq = $otuseqs->{$name}->[$ppp_param-1];
		$prob_val = (ref $seq) ? $seq->[1] : $seq;
		$prob_val = ":p(1) = ". $prob_val;
		$y1 = int($node->_get_ycoord);
		&__draw_line($my_data,$x0, $y1, $x1, $y1, $color, 2);
		if ($y1 > $y0) {
			&__draw_line($my_data,$x0, $y1, $x0, $y0 + $pieChartRadius/2, $color, 2) unless $node->get_name eq 'root' ;
		}
		else {
			&__draw_line($my_data,$x0, $y1, $x0, $y0 - $pieChartRadius / 2, $color, 2) unless $node->get_name eq 'root' ;
		}
	}
	else {
		$y1 = int($node->_get_ycoord);
		&__draw_line($my_data,$x0, $y1, $x1, $y1, $color, 2);
		&__draw_line($my_data,$x0, $y0, $x0, $y1, $color, 2) unless $node->get_name eq 'root' ;
	}

	if ($node->is_otu()) {
		&__print_label($my_data, $x1+$pieChartRadius*.75, $y1,$node->get_name,$color) ;
	}
	my $x2 = int( $x1 + $treeNodeRadius );
	my $y2 = int( $y1 + $treeNodeRadius );
	if ( not $ppp_param ) {
		&__draw_circle($my_data,$x1, $y1,$treeNodeRadius,$color) if (!$node->is_otu); 
	}
	$my_data->set_tree_map_coord( $node->get_name, [$x1,$y1,$x2,$y2] ) if $runtime_options->{'output_type'} eq 'png';
	if ($node->{name} ne "root") {
#$query->delete("session") if ($runtime_options->{'session'});
		$node->_set_xcoord($x1);
		$node->_set_ycoord($y1);
		#$areaMap .= qq(<area shape=rect onMouseOver="showtip(this,event,'$node->{name} options $prob_val')" onMouseOut="PopUpMenu2_Hide();" coords=$x1,$y1,$x2,$y2 href="javascript:PopUpMenu2_Set(getParam(\'$qs\',\'$node->{name}\',\'$file_param\',\'$colornode_params[$#colornode_params]\'),'','','','','');">\n);
	}
	else {
		#$areaMap .= qq(<area shape=rect onMouseOver="showtip(this,event,'Root node options $prob_val')" onMouseOut="PopUpMenu2_Hide();" coords=$x1,$y1,$x2,$y2 href="javascript:PopUpMenu2_Set(getParamRoot(\'$qs\',\'$node->{name}\',\'$file_param\',\'$colornode_params[$#colornode_params]\'),'','','','','');">\n);
	}
	if (not $node->is_otu) {
		my @nodes = @{$node->get_children()};
			foreach my $child (@nodes) {
				&__print_tree($my_data,$child, $x1, $y1,$otuseqs);
			}
	}
}

sub __print_matrix {
	my ($my_data, $x0, $y0,$taxlabels,$is_print_labels) = @_;
	my $seqs = $my_data->get_char_block_seq;

	foreach my $taxa (@{$taxlabels}) {
		my $color = $my_data->get_node_color($taxa);
		&__print_label($my_data,$x0,$y0,$taxa,$color) if $is_print_labels;
		my $xPos = $nexusG->get_characterStartXpos;
		$color = 'gray' if ( (defined @{ $runtime_options->{'highlight_otus'} }) and ($color eq 'black') );
		&__print_sequence($my_data, $xPos,$y0,$seqs->{$taxa},$taxa, $color) if defined $seqs;
		$y0 += $nexusG->get_verticalOtuSpacing;
	}
}

sub __print_label {
	my ($my_data, $x, $y,$taxon_name, $color) = @_;
	my ($x1,$x2,$y1,$y2);
	$color = ( defined($color) ? $color : 'black' );
	my $tip = ($color ne 'gray') ? 'OTU options' : 'Taxonomy not identified for this sequence';

# Print either left justified or right justified names
	if ($runtime_options->{'right_justify_labels'} eq 'on') {
		$x1 = $x;
		$y1 = $y;
		$x2 = $nexusG->get_characterStartXpos - (length($taxon_name) * $nexusG->get_fontWidth) - $nexusG->get_labelMatrixGapWidth;
		$y2 = $y;
		&__draw_text($my_data,$x2,$y2,$taxon_name,$color);
		$my_data->set_label_map_coord( $taxon_name, [$x2,$y2,$x2+length($taxon_name)*$nexusG->get_fontWidth,$y2+$nexusG->get_fontHeight] ) if $runtime_options->{'output_type'} eq 'png';
		$x1 += $nexusG->get_fontWidth;
		$x2 -= $nexusG->get_fontWidth;
		&__draw_line($my_data,$x1,$y1,$x2,$y1,'gray',1) if (($x1 < $x2) && ($runtime_options->{'show_content'} ne 'Data only'));
	} else {
		$x1 = $x;
		$x2 = $nexusG->get_characterStartXpos  - $nexusG->get_labelMatrixGapWidth;
		$y1 = $y;
		#$y2 = $y-( $nexusG->get_fontHeight/2);
		$y2 = $y;
		&__draw_text($my_data,$x1,$y2,$taxon_name,$color);
		$my_data->set_label_map_coord( $taxon_name, [$x1,$y2,$x1+length($taxon_name)*$nexusG->get_fontWidth,$y2+$nexusG->get_fontHeight] ) if $runtime_options->{'output_type'} eq 'png';
		#$areaMap.= sprintf "<area shape=rect onMouseOver=\"showtip(this,event,\'$tip\')\" onMouseOut=\"PopUpMenu2_Hide();\" coords=%d,%d,%d,%d href=\"javascript:PopUpMenu2_Set(getParam2(\'$qs\',\'%s\',\'$file_param\',\'$dir_param\',\'$highlight_params[$#highlight_params]\'),'','','','','');\">\n",$x1,$y2,$x1+length($taxon_name)*$nexusG->get_fontWidth,$y2+$nexusG->get_fontHeight, $taxon_name if ($runtime_options->{'output_type'} ne "ps" && $runtime_options->{'output_type'} ne "pdf");
		$x1 += length($taxon_name) * $nexusG->get_fontWidth + $nexusG->get_fontWidth;
		&__draw_line($my_data,$x1,$y1,$x2,$y1,'gray',1) if (($x1 < $x2) && ($runtime_options->{'show_content'} ne 'Tree only') && $my_data->get_char_column_labels);
	}
}

sub __print_sequence() {
	my ($my_data, $x, $y, $sequence, $taxName, $color) = @_;
	my $block = $my_data->get_selected_char_block;
	$color = ( defined($color) ? $color : 'black' );
	my $data_type     = $block->get_format()->{'datatype'} if ($block->get_format());
	my $gap_val        = $block->get_format()->{'gap'} if ($block->get_format()->{'gap'});
	my $missing_val    = $block->get_format()->{'missing'} if ($block->get_format()->{'missing'});
	my $max_val        = $block->get_format()->{'max'} if ($block->get_format()->{'max'});
	$sequence         = uc (&__processSeqForDisplay($sequence)) if ($data_type ne 'continuous');

	my $fontWidth  = $nexusG->get_fontWidth;
	my $fontHeight = $nexusG->get_fontHeight;
	my $blockWidth = $nexusG->get_charLabelBlockWidth;
	my $xnew = $x;
	if ($data_type eq 'continuous') {
		my $continuousMax;			# Largest value in a continuous data matrix
			if (not $max_val) {		##Find largest value in continuous data
				my  @array = sort { $a <=>$b } split(' ',$my_data->get_char_block_seq->{$taxName}); 
				$continuousMax = pop @array;
			}
		my $max = $max_val || $continuousMax;
		my $xpos = $x;
		my $columnCount = 0;
		my $colorscale;
		my $color;
		my @states = split(' ',$sequence);
		my $im_h = $my_data->get_image_handler;
		for (1 .. scalar(@states)) {
			my $val = $states[$_-1];
			$my_data->add_contin_data_map_coord($taxName,[$xpos,$y,$xpos+$fontWidth,$y+$fontHeight]) if $runtime_options->{'output_type'} eq 'png';
			if ($gap_val eq $val) {
				#$floatMap .=sprintf "<area shape=\"rect\" coords=%d,%d,%d,%d onMouseOver=\"showtip(this,event,'Gap')\">\n",$xpos,$y,$xpos+$fontWidth,$y+$fontHeight;
			}
			elsif ($missing_val eq $val) {
				&__draw_text($my_data,$xpos,$y,'?','black');
				#$floatMap .=sprintf "<area shape=\"rect\" coords=%d,%d,%d,%d onMouseOver=\"showtip(this,event,'Missing')\">\n",$xpos,$y,$xpos+$fontWidth,$y+$fontHeight;	
			}
			else {
				$colorscale = ($max == 0) ? 0 :  $val/$max;
					if ($colorscale > 0.75) {
						$color = [255,(1-($colorscale-0.75)/0.25)*255,0];
					}
					elsif ($colorscale > 0.5) {
						$color = [($colorscale-0.5)/0.25*255,255,0];
					}
					elsif ($colorscale > 0.25) {
						$color = [0,255,(1-($colorscale-0.25)/0.25)*255];
					}
					else {
						$color = [0,$colorscale/.25*255,255];
					}

				&__draw_filledRect($my_data,$xpos,$y+$fontHeight-($fontHeight*$colorscale),$xpos+$fontWidth,$y+$fontHeight,$color);
				&__draw_line($my_data,$xpos,$y+$fontHeight-($fontHeight*$colorscale),$xpos,$y+$fontHeight,'black',0.5);						# Left border
				&__draw_line($my_data,$xpos+$fontWidth,$y+$fontHeight-($fontHeight*$colorscale),$xpos+$fontWidth,$y+$fontHeight,'black',0.5); # Right border
				&__draw_line($my_data,$xpos,$y+$fontHeight-($fontHeight*$colorscale),$xpos+$fontWidth,$y+$fontHeight-($fontHeight*$colorscale),'black',0.5);	# Top border
				&__draw_line($my_data,$xpos,$y+$fontHeight,$xpos+$fontWidth,$y+$fontHeight,'black',0.5);		# Bottom border
				#$floatMap .=sprintf "<area shape=\"rect\" coords=%d,%d,%d,%d onMouseOver=\"showtip(this,event,'$val')\">\n",$xpos,$y,$xpos+$fontWidth,$y+$fontHeight;
			}

			$xpos += $fontWidth;
			$columnCount++;
			$xpos += $fontWidth if ($columnCount% ($blockWidth) == 0);
		}
	}
	elsif (($runtime_options->{'colorintron'}) ne '' && (lc($runtime_options->{'character_data_type'}) ne 'intron')) {

		my %intronSequences      = %{$nexusObject->get_block("characters","intron")->get_otuset->get_seq_string_hash};
		my $intronSeq            = $intronSequences{$taxName};
		my @intronLabels         = @{$nexusObject->get_block("characters","intron")->get_charlabels};
		my @intron_present_pos   = ();

		for (my $c = 0,my $index = 0; $c < length($intronSeq); $c++, $index++) {			# Get positions only where introns are present
			$index = index($intronSeq,'1',$index);
			last if ($index == -1);
			push @intron_present_pos, $intronLabels[$index];
		}
		#print "<PRE> $taxName ";print Dumper \@intron_present_pos;print"</PRE>";
		my $frontPos   = 0;
		my $aaNum      = 0;
		my @phaseColor = ('red','blue','darkgreen');
		if (lc($runtime_options->{'character_data_type'}) eq 'protein') {
			$frontPos = 0;
			$aaNum    = 0;
			my $numBlanks;
			foreach my $intron_pos (@intron_present_pos) {
				($aaNum = $intron_pos) =~ s/(-.)//;
				$aaNum -= $runtime_options->{'select_char_range'}->[0] if defined @{$runtime_options->{'select_char_range'}};
				(my $phaseNum  = $intron_pos) =~ s/(.*-)//;
				my $phaseColor = $phaseColor[$phaseNum];
				$numBlanks  = int($aaNum/$blockWidth)-int($frontPos/$blockWidth);
				my $frontPx    = ($frontPos+int($frontPos/$blockWidth))*$fontWidth;

				next if $aaNum < 1;
				if ($aaNum <= length($sequence)) {
					&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$frontPos+int($frontPos/$blockWidth),$aaNum-1-$frontPos+$numBlanks)),$color);
					$frontPx += ($aaNum-1-$frontPos+$numBlanks)*$fontWidth;
					$frontPx -= $fontWidth if ($aaNum%$blockWidth == 0);
					&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$aaNum-1+int(($aaNum-1)/$blockWidth),1)),$phaseColor);
					$frontPos = $aaNum;
				}
			}
			$numBlanks  = $aaNum < 0 ? 0 : int($aaNum/$blockWidth)-int($frontPos/$blockWidth);
			my $frontPx = ($frontPos + int($frontPos/$blockWidth)) * $fontWidth;
			&__draw_text( $my_data,$xnew + $frontPx, $y, uc( substr( $sequence,$frontPos + int ( $frontPos/$blockWidth), length($sequence) - $frontPos + $numBlanks) ), $color);
		}
		elsif (lc ($runtime_options->{'character_data_type'}) eq 'dna') {
			$frontPos = 0;
			$aaNum    = 0;
			foreach my $intron_pos (@intron_present_pos) {
				($aaNum = $intron_pos) =~ s/(-.)//;
				$aaNum -= 3 * $runtime_options->{'select_char_range'}->[0] if defined @{$runtime_options->{'select_char_range'}};
				(my $phaseNum = $intron_pos) =~ s/(.*-)//;
				my $dnaNum = ($aaNum-1)*3;
				next if $dnaNum < 0;
				my $phaseColor = $phaseColor[$phaseNum];
				my $numBlanks = int(($dnaNum-1)/$blockWidth)-int(($frontPos-1)/$blockWidth);
				my $frontPx = ($frontPos+int(($frontPos-1)/$blockWidth))*$fontWidth;
				if ($dnaNum+$phaseNum < length($sequence)) {
					&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$frontPos+int(($frontPos-1)/$blockWidth),$dnaNum-$frontPos+$numBlanks)),$color);
					$frontPx += ($dnaNum-$frontPos+$numBlanks)*$fontWidth;
					my $length = 1 if (int($dnaNum+1)/$blockWidth > int($dnaNum-1)/$blockWidth);
					&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$dnaNum+int(($dnaNum-1)/$blockWidth),3+$length)),$phaseColor);
					$frontPos = $dnaNum+3;
				}
			}
			my $frontPx = ($frontPos+int($frontPos/$blockWidth))*$fontWidth;
			&__draw_text($my_data,$xnew+$frontPx,$y,uc(substr($sequence,$frontPos+int($frontPos/$blockWidth),length($sequence)-$frontPos+int($aaNum/$blockWidth)-int($frontPos/$blockWidth))),$color);

		}
	}
	else {
		&__draw_text($my_data,$xnew,$y,uc($sequence),$color);
	}
}


sub __processSeqForDisplay() {
	my $string = shift;
	$string =~ tr/01/.+/;
	my @tmp = split (//, $string);
	my $tmp_string = "";
	my $char_block_width = $nexusG->get_charLabelBlockWidth;
	$string =~ s/(.{$char_block_width})/$1 /g;
	return $string;
}


sub __print_char_labels {
	my ($my_data, $block) = @_;
	warn("Grabbing characters block from NEXUS file...\n") if $DEBUG;
	my @columnLabels    = $my_data->get_char_column_labels;

	my @columnLabelsAll = @{$nexusObject->get_block("characters","intron")->get_charlabels} if $nexusObject->get_block("characters","intron");
	warn "WARNING: No labels\n" unless @columnLabels;
	my $blank           = 0;
	my $longestLabel    = $nexusG->get_longestCharLabelLength();
	my $yPosition       = $nexusG->get_lowerYMargin ;
	my $highlightcol    = $columnLabelsAll[$ppp_param-1];

	for (my $i = 0; $i <= $#columnLabels; $i++) {
		if ( $i && ($i % ($nexusG->get_charLabelBlockWidth) == 0) ) { # char #11, #21, etc.
			$blank += $nexusG ->get_fontWidth;
		}
		my $label=$columnLabels[$i];
		my $x = $nexusG->get_characterStartXpos + $blank + $i * $nexusG->get_fontWidth;

		my $colpos = 0;

		for (1 .. scalar(@columnLabelsAll)) {
#print "$highlightcol , $columnLabelsAll[$_-1]<br>";
#print "@columnLabels<br>";
			if ($highlightcol eq $columnLabels[$_-1]) {
				$colpos = $_;
				last;
			}
		}

		my $color = ($ppp_param && ($colpos==($i+1))) ? 'darkgreen': 'darkred';
		$my_data->set_label_map_coord($label,[$x,$yPosition,$x+$nexusG->get_fontWidth,$nexusG->get_lowerYbound-$nexusG->get_fontHeight]) if $runtime_options->{'output_type'} eq 'png';

		$label =~ s/-|_/\|/;
		substr($label,0,0) = ' ' x (($longestLabel/$nexusG->get_fontHeight)-length($label));
		&__print_vertical_label($my_data, $x, $yPosition, $label, $color, @columnLabelsAll);
	}
}
sub __highlight_char{
	my ($my_data, $block) = @_;
	warn("Grabbing characters block from NEXUS file...\n") if $DEBUG;
	my @columnLabels    = $my_data->get_char_column_labels;

	warn "WARNING: No labels\n" unless @columnLabels;
	my $blank           = 0;
	for (my $i = 0; $i <= $#columnLabels; $i++) {
		if ( $i && ($i % ($nexusG->get_charLabelBlockWidth) == 0) ) { # char #11, #21, etc.
			$blank += $nexusG ->get_fontWidth;
		}
		my $label=$columnLabels[$i];
		my $x = $nexusG->get_characterStartXpos + $blank + $i * $nexusG->get_fontWidth;

		if (my $char_highlight_pos  = grep /^$columnLabels[$i]$/ , @{$runtime_options->{'highlight_chars'} } ) {
			&__draw_filledRect($my_data,$x,1,$x+$nexusG->get_fontWidth,$nexusG->get_lowerYMargin,'pink');
			&__draw_filledRect($my_data,$x,$nexusG->get_upperYbound,$x+$nexusG->get_fontWidth,$nexusG->get_ysize-1,'pink');
		}
	}
}

sub __print_vertical_label {
	my ($my_data, $x, $y, $label, $color,@columnLabelsAll) = @_;
	foreach my $letter (split(//,$label)) {
		&__draw_text($my_data,$x,$y,$letter,$color);
		$y += $nexusG->get_fontHeight;
	}
	$label =~ s/\|/-/;
	$label =~ s/\s//g;
	&__print_intron_history($my_data,$x,$y,$label,$color,@columnLabelsAll) if ( (lc $runtime_options->{'character_data_type'}) eq 'intron') && ($nexusObject->get_block('history','intron'));
}

sub __print_intron_history {
	my ($my_data, $x, $y, $label,$color,@columnLabelsAll) = @_;
	&__draw_text($my_data,$x,$y,'H','blue');
	$my_data->set_intron_map_coord($label,[$x,$y,$x+$nexusG->get_fontWidth,$y+$nexusG->get_fontHeight]) if $runtime_options->{'output_type'} eq 'png';
#$labelAreaMap .=sprintf "<area shape=\"rect\" onMouseOver=\"showtip(this,event,'Intron history options for $label')\" onMouseOut=\"PopUpMenu2_Hide();\" coords=%d,%d,%d,%d href=\"javascript:PopUpMenu2_Set(getParam3(\'$qs\',\'$charnum\'),'','','','','');\">\n",$x, $y, $x + $nexusG->get_fontWidth, $y + $nexusG->get_fontHeight if ($runtime_options->{'output_type'} ne "ps" && $runtime_options->{'output_type'} ne "pdf");
}

sub __plot_wts {
	my ($my_data, @weights) = @_;
	my $blank   = 0;
	my $is_weights;
	for (my $i = 0; $i <= $#weights; $i++) {
		my $height = $weights[$i] * $nexusG->get_histogramHeight ;
		if ( $i && ($i % ($nexusG->get_charLabelBlockWidth)) == 0 ) { # char #11, #21, etc.
			$blank += $nexusG->get_fontWidth;
		}
		my $x1  =  $nexusG->get_characterStartXpos  + $blank + $i * $nexusG->get_fontWidth + (0.25 * $nexusG->get_fontWidth);
		my $x2  =  $x1 + ($nexusG->get_fontWidth/2);
		my $y1  =  $nexusG->get_lowerYbound - $height - $nexusG->get_charLabelMatrixGapWidth;
		my $y2  =  $nexusG->get_lowerYbound - $nexusG->get_charLabelMatrixGapWidth;
		&__draw_filledRect($my_data,$x1,$y1,$x2,$y2,'darkgreen');
	}
}

sub __set_node_coords {
	my $tree = shift; 
	my $treeName =  $tree->get_name() || "unnamed";
	my $cladogram_type = $runtime_options->{'cladogram_mode'} if $runtime_options->{'show_cladogram'};
	$tree->_set_xcoord($nexusG->get_TreeWidth,$cladogram_type);
	$tree->_set_ycoord(0,$nexusG->get_verticalOtuSpacing);
	my @nodes = @{$tree->get_nodes()};
	my $root = $tree->get_rootnode();
	warn("Getting names of OTUs in tree...\n") if ( $DEBUG );
	my @sorted;
	for my $node (@nodes) {
		push @sorted, $node->_get_xcoord();
	}
	@sorted = sort { $a <=> $b } @sorted;
	my $sortedNum = pop @sorted;
	my $amp = $nexusG->get_TreeWidth / $sortedNum if ($sortedNum != 0); # unit of branch length
		foreach my $node (@nodes) {
			$node->_set_xcoord(($node->_get_xcoord* $amp) + $nexusG->get_lowerXbound);
			$node->_set_ycoord($node->_get_ycoord + $nexusG->get_lowerYbound);
		}
}

sub __print_inode_names() {
	my ($my_data, $nodes) = @_;
	my ($xnew,$x1, $y1);
	foreach my $node (@{$nodes}) {
		next if $node->is_otu;
		$x1 = int($node->_get_xcoord);
		$y1 = int($node->_get_ycoord);
		$xnew = $x1 + $nexusG->get_fontWidth/2;
		$xnew  += $nexusG->get_pieChartRadius* 0.5 if ($ppp_param);
		&__draw_text($my_data,$xnew, $y1,$node->get_name, 'darkgray');
	}
}
sub __print_boot_strap() {
	my ($my_data, $nodes) = @_;
	foreach my $node (@{$nodes}) {
		my $name = $node->get_name();
		next unless $node->get_support_value; # print only non-zero values and only if defined in the tree
			&__draw_text($my_data,$node->_get_xcoord - ($nexusG->get_fontWidth * 4),$node->_get_ycoord + ($nexusG->get_fontHeight)/2,$node->get_support_value,'red');
	}
}

sub __plot_scale_border_title {
	my ($my_data) = @_;
# PRINT SCALE
	my $cladogram_type = $runtime_options->{'cladogram_mode'} if $runtime_options->{'show_cladogram'};
	if ( ($runtime_options->{'show_content'} ne 'Data only') && $nexusObject->get_block('trees') && (not  $cladogram_type)) {
#$lowerYbound -= $nexusG->get_histogramHeight/2 if (!($runtimeOptions{t}) && &__get_column_labels);
#$lowerYbound -= $nexusGi->get_fontHeight if ($runtimeOptions{t});
#&__print_line($lowerXbound, $lowerYbound, $lowerXbound + $amp / 10, $lowerYbound, 2);
#&__print_line($lowerXbound, $lowerYbound+5, $lowerXbound, $lowerYbound, 2);
#&__print_line($lowerXbound + $amp / 10, $lowerYbound+5, $lowerXbound + $amp / 10, $lowerYbound, 2);
	}

# PRINT TITLE	
	#my $file_param = $my_data->get_title;
	my $file_param = 'Test';
	&__draw_text($my_data,$nexusG->get_lowerXbound, $nexusG->get_fontHeight+5, uc($file_param), 'black');

# PRINT BORDER
	if ($runtime_options->{'show_border'} eq 'on' ){ # draw a box around what Postscript has determined is the plot
		my $lowerXBorder = $nexusG->get_lowerXMargin/2;
		my $lowerYBorder = $nexusG->get_lowerYMargin/2;
		my $upperXBorder = $nexusG->get_xsize - ($nexusG->get_upperXMargin/2);
		my $upperYBorder = $nexusG->get_ysize - ($nexusG->get_upperYMargin/2);
		&__draw_line($my_data,$lowerXBorder,$lowerYBorder,$upperXBorder,$lowerYBorder,'black',2);
		&__draw_line($my_data,$upperXBorder,$lowerYBorder,$upperXBorder,$upperYBorder,'black',2);
		&__draw_line($my_data,$upperXBorder,$upperYBorder,$lowerXBorder,$upperYBorder,'black',2);
		&__draw_line($my_data,$lowerXBorder,$upperYBorder,$lowerXBorder,$lowerYBorder,'black',2);
	}
}

sub __assign_ncbi_taxonomy {

	use DBI;

	my ($my_data , $taxlabels) = @_;
	my $dbh = DBI->connect("dbi:mysql:taxonomy", "root", "") || die "Can't connect to taxonomy: $DBI::errstr"; 
	my $dir_param = $runtime_options->{'directory_param'};	
	my $table_name = ($dir_param eq 'pandit') ? 'sptr_taxa' : 'cds';
	my $field_name = ($dir_param eq 'pandit') ? 'sptr_id' : 'prot_id';
	my $search_cond=($dir_param eq 'pandit') ? "= ?" : "like ?";
	my $sql_statement; 

	if($dir_param eq 'uploads') {
		$sql_statement=qq{ 
			SELECT kingdom,name
				from taxon_name 
				where name_class='scientific name' and
				taxon_id= ? limit 10};
	}else {
		$sql_statement=qq{ 
			SELECT kingdom,name
				from $table_name,taxon_name 
				where $table_name.taxon_id=taxon_name.taxon_id and 
				name_class='scientific name' and
				$table_name.$field_name $search_cond limit 10};
	}
	my $kingdom = {     	
		vertebrata	   => lc $runtime_options->{'kingdom'}->{'vertebrate'},
		invertebrata	   => lc $runtime_options->{'kingdom'}->{'invertebrate'},
		plants		   => lc $runtime_options->{'kingdom'}->{'plant'},
		fungi		   => lc $runtime_options->{'kingdom'}->{'fungi'},
		protist		   => lc $runtime_options->{'kingdom'}->{'protist'}
	};
	for my $taxlabel (@$taxlabels) {
		my $taxlabel_tmp=(split(/\//,$taxlabel))[0];
		(my $id=$taxlabel_tmp)=~s/^.*_//g;
		if ($dir_param eq 'uploads') {
## some conditions
		}else {
			chop($id) if ($dir_param eq 'NEXUS' or  $dir_param eq 'uploads');
			chop($id) if ($dir_param eq 'NEXUS' or $dir_param eq 'uploads');
			$id = ($dir_param eq 'pandit') ? $id : "$id%";
		}
		my $sth 	= $dbh->prepare($sql_statement) || die "Can't prepare statement: $DBI::errstr"; 
		my $rc 		= $sth->execute($id) || die "Can't execute statement: $DBI::errstr";
		my $num_of_rows = $sth->rows;
		my $matrix_ref  = $sth->fetchall_arrayref;
		for (my $rowNo  = 0;$rowNo < $num_of_rows;$rowNo++) {
			$my_data->set_node_color($taxlabel,$kingdom->{$$matrix_ref[0][$rowNo]});
		}	
	}

	$dbh->disconnect;
}

=head2 swap_children

 Title   : swap_children
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub swap_children {
	my ($self,$nodename) = @_;
	my $treename     = $self->get_name();
	my $tree         = $self->clone();
	my $swapnode     = $tree->find($nodename);
	$swapnode or die "ERROR: Node $nodename not found in $treename\n";
	my $childcount   = scalar(@{$swapnode->get_children()});
	my $tempnode     =  $swapnode->get_children()->[$childcount-1];
	for (my $index	 = $childcount-1; $index > 0; $index--) {
		print $index, " ";
		$swapnode->get_children()->[$index] = $swapnode->get_children()->[$index-1];
	}
	$swapnode->get_children()->[0] = $tempnode;
	$self = $tree->clone;
}

package MyData;
use Data::Dumper;

=head2 new

 Title   : new
 Usage   : NA
 Function: NA
 Returns : NA
 Args    : NA

=cut

sub new () {

	my $self = shift;
	my $RGBcolorHash = {
		white	 	=> [250,250,250],
		red		=> [250,0,0],
		green		=> [0,150,0],
		blue		=> [0,0,250],
		forest		=> [34,139,34],
		aqua		=> [152,245,255],
		gold		=> [255,185,15],
		gray		=> [130,130,130],
		pink		=> [255,34,179],
		brown		=> [139,69,19],
		black		=> [0,0,0],
		purple		=> [111,0,111],
		orange		=> [255,120,0],
		darkgray 	=> [110,110,110],
		darkpurple 	=> [111,0,111],
		darkred 	=> [170,0,0],
		darkgreen 	=> [0,140,0],
		silver 		=> [230,232,250],
		yellow 		=> [255,255,0],
		highlighter 	=> [51,184,215],
		tranparent_pink => [255,34,179]
	};
	my $data = {
		'selected_character_block'	=> undef,
		'title'				=> undef,
		'selected_tree' 		=> undef,
		'species_tree' 			=> undef,
		'char_block_seq'		=> undef,
		'char_block_wts' 		=> [],
		'char_column_labels' 		=> [],
		'nodes_color_hash' 		=> {},
		'ps_color_hash'			=> $RGBcolorHash,
		'gd_color_hash'			=> {},
		'gd_tree_map_coord'		=> undef, 
		'gd_label_map_coord'		=> undef,
		'gd_intron_map_coord'		=> undef,
		'gd_contin_data_map_coord'	=> undef,
	};
	bless ($data,$self);
	return $data;
}

sub set_title {
	my ($self,$title) = @_;
	$self->{'title'} = $title;
}
sub get_title {
	my ($self) = @_;
	return $self->{'title'};
}
sub set_tree_map_coord {
	my ($self,$node_name,$coord) = @_;
	$self->{'gd_tree_map_coord'}->{$node_name} = $coord;
}

sub get_tree_map_coord {
	my ($self, $node_name)  = @_;
	return $self->{'gd_tree_map_coord'}->{$node_name}; ## black
}

sub set_contin_data_map_coord {
	my ($self,$node_name,$coord) = @_;
	$self->{'gd_contin_data_map_coord'}->{$node_name} = $coord;
}

sub get_contin_data_map_coord {
	my ($self, $node_name)  = @_;
	return $self->{'gd_contin_data_map_coord'}->{$node_name}; ## black
}
sub add_contin_data_map_coord {
	my ($self, $node_name,$coord)  = @_;
	push (@{ $self->{'gd_contin_data_map_coord'}->{$node_name} }, $coord); ## black
}


sub set_label_map_coord {
	my ($self,$col_label,$coord) = @_;
	$self->{'gd_label_map_coord'}->{$col_label} = $coord;
}

sub get_label_map_coord {
	my ($self, $col_label)  = @_;
	return $self->{'gd_label_map_coord'}->{$col_label}; ## black
}
sub set_intron_map_coord {
	my ($self,$col_label,$coord) = @_;
	$self->{'gd_intron_map_coord'}->{$col_label} = $coord;
}

sub get_intron_map_coord {
	my ($self, $col_label)  = @_;
	return $self->{'gd_intron_map_coord'}->{$col_label}; ## black
}

sub set_selected_char_block {
	my $self = shift;
	$self->{'selected_character_block'} = shift; 
}

sub get_selected_char_block {
	my $self = shift;
	return $self->{'selected_character_block'}; 
}
sub set_image_handler {
	my $self = shift;
	$self->{'image_handle'} = shift;
}

sub get_image_handler {
	my $self = shift;
	return $self->{'image_handle'};
}
sub set_font {
	my $self = shift;
	$self->{'font'} = shift;
}

sub get_font {
	my $self = shift;
	return $self->{'font'};
}

sub get_image_handler_type {
	my $self = shift;
	return if not defined $self->{'image_handle'};
	if ((ref $self->{'image_handle'}) =~/GD/i) {
		return 'gd';
	} elsif ((ref $self->{'image_handle'}) =~/Post/i) {
		return 'ps';
	} else {
		return 'pdf';
	}
}
sub allocate_colors {
	my $self     = shift;
	my $img_h = $self->{'image_handle'};
	foreach my $color_val (keys %{ $self->{'ps_color_hash'} }) { 
		if ((ref $img_h) =~/GD/i) {
			if ($color_val eq 'tranparent_pink'){
				$self->{'gd_color_hash'}->{$color_val} = $img_h->colorAllocateAlpha( @{ $self->{'ps_color_hash'}->{$color_val} },120); 
			}else {
				$self->{'gd_color_hash'}->{$color_val} = $img_h->colorAllocate( @{ $self->{'ps_color_hash'}->{$color_val} } );
			}
		}
	}
}
sub get_color {
	my $self     = shift;
	my $name     = shift || 'black';
	my $img_h = $self->{'image_handle'};
	my $color;
	if ((ref $img_h) =~ /GD/i) {
		$color =  $self->{'gd_color_hash'}->{lc $name}; 
	}elsif ((ref $img_h) =~/Postscript/i)  {
		$color = $self->{'ps_color_hash'}->{lc $name};
	}else {
		$color = "#". join "", map {sprintf "%2.2X",$_} @{ $self->{'ps_color_hash'}->{lc $name} } if $self->{'ps_color_hash'}->{lc $name};
	}
	return $color || $name; 
}

sub get_char_block_seq {
	my $self = shift;
	my $taxon_name  = shift;
	my $block = $self->{'selected_character_block'};
	my $data_type;
	if ( not defined $self->{'char_block_seq'} and defined $block) {
		if ($block->get_format()) {
			$data_type  = $block->get_format()->{'datatype'} ;
		}
		if ($data_type eq 'continuous') {
			$self->{'char_block_seq'} = $block->get_otuset->get_seq_string_hash(' ');
		}
		else { 
			$self->{'char_block_seq'} = $block->get_otuset->get_seq_string_hash;
		}
	}
	return 	$self->{'char_block_seq'};
}

sub get_char_column_labels {
	my $self = shift;
	my $block = $self->{'selected_character_block'};
	my @columnLabels;
	if (defined $block && (not @{$self->{'char_column_labels'}})){
		my $characterLabels = $block->get_charlabels;
		my $seqLength = $block->get_nchar;
		if ($characterLabels && @$characterLabels) { 
			@columnLabels = @$characterLabels; 
		} elsif ($seqLength) { # not labeled, e.g., typical dna or aa seq alignment
			for (1 .. $seqLength) {push @columnLabels, $_;}
		}
		$self->{'char_column_labels'}  = \@columnLabels;
	}
	return @{$self->{'char_column_labels'}};
}

sub set_node_color {
	my ($self,$node_name,$color) = @_;
	$self->{'nodes_color_hash'}->{$node_name} = $color;
}

sub get_node_color {
	my ($self, $node_name)  = @_;
	return $self->{'nodes_color_hash'}->{$node_name} || 'black'; ## black
}
sub get_nodes_hash {
	my ($self,$name,$color)  = @_;
	return $self->{'nodes_color_hash'};
}

sub get_char_block_wts {
	my $self = shift;
	my $block = $self->{'selected_character_block'};
	my $is_weights = 0;
	my @assumptions_blocks = @{ $nexusObject->get_blocks('assumptions') };
	if (not @{$self->{'char_block_wts'}}) {
		my @weights;
		for my $asmpt_block (@assumptions_blocks) {
			if ($asmpt_block->get_link( 'characters' ) eq $block->get_title()) {
				warn("Grabbing assumptions block from NEXUS file...\n") if $DEBUG;
				foreach my $assumption(@{$asmpt_block->get_assumptions()}) {
					if( $assumption->is_wt() ) {
						@weights = @{ $assumption->get_weights() };
						my $max_wt;
						$max_wt = $nexusG->get_maximumWtvalue;
#foreach my $weight(@weights) {
#	$max_wt = $weight if ($weight > $max_wt) 
#}
						foreach my $weight(@weights) {
							if ($weight eq '-') {
								$weight = 0;
							}else {
								$weight = ($max_wt != 0 ) ? ($weight/$max_wt) : 0;
							}
							$is_weights = 0;
						}
						if ( $DEBUG ) {
							warn("No weights found in this file\n") unless $is_weights;
							warn("Weights have been found in this file\n") if $is_weights;
						}
					}
				}
			}
		}
		$self->{'char_block_wts'} = \@weights;
	}
	return @{$self->{'char_block_wts'}};
}
sub set_selected_tree {
	my $self = shift;
	$self->{'selected_tree'} = shift; 
}
sub set_species_tree {
	my ($self,$tree) = @_;
	$self->{'species_tree'} = $tree;
}
sub set_gene_tree{
	my ($self,$tree) = @_;
	$self->{'gene_tree'} = $tree;
}
sub get_species_tree {
	my ($self,$tree) = @_;
	return $self->{'species_tree'};
}
sub get_gene_tree {
	my ($self) = @_;
	return $self->{'gene_tree'};
}

sub get_nodename_from_gene_tree {
	my ($self,$species_node_name) = @_;
	my $gene_tree = $self->get_gene_tree;
	my $species_tree = $self->get_species_tree;
	my @gene_nodelist = @{ $gene_tree->get_nodes};
	my $comment;
	my $species_name;
	for my $gene_node (@gene_nodelist) {
		$comment = $gene_node->get_support_value;
		my ($species_name) = $comment =~ /:?S=([^:]*)/g;
		return $gene_node->get_name if $species_name eq $species_node_name;
	}
	return undef;

}
sub get_selected_tree {
	my $self = shift;
	return $self->{'selected_tree'}; 
}

1;

################# POD Documentation ##################


__END__

=head1 NAME

nexplot.pl - PostScript plot of tree + data table (from NEXUS infile)

	=head1 SYNOPSIS

	nexplot.pl [options] foo.nex [tree_name] > foo.ps 

	=head1 OPTIONS

	-h		Brief help message
	-d		Full documentation
	-v		Verbose mode
	-V		Print version information and quit

-f		Specify output file (default: STDOUT)

	INFORMATION TO DISPLAY
	-b		Turn on bootstrap values, if any
	-i		Turn on internal node labeling
-t		Tree only (ignore any characters)
	-I		Specify character block (by "Title") to be used in matrix 
	(e.g. "dna", "protein", "intron")
-m		Matrix only (ignore any trees)
	-c		Cladogram mode:
(auto if no branch lengths present in tree)
	normal: all branch lengths equal
	accelerated: same as normal except OTUs are aligned at end
	-U		Display taxa sets in color (-U "set1 color1 [set2 color2 ...]")
	Color options are red, orange, green, forest, aqua, blue, 
	purple, pink, brown, gray, black 

	PLOT FORMATTING
	-r		Right-justify labels (default: left-justified)
-C		Columns of characters per block (default = 10)
	-T		Specify tree width (longest branch; default: 10")
	-S		Spacing (vertically) between OTUs (default: .25")
	-R		Ratio of font height to Spacing (default: 0.8; rec: 0.5-1)
	-F		Font to use for labels and titles
	-B		Draw a box indicating postscript\'s bounds of the plot area
	-g		Include gray lines after OTU labels, 
	even if -t (tree only) option is used

	PAGE SETUP
	-s		Print on multiple pages, but shrink to page height
	-o		Print on multiple pages at actual size
	-W		Specify output page width (default: 8.5")
	-H		Specify output page height (default: 11")
	-a		Change page dimensions to fit plot

	=head1 DESCRIPTION

	B<This program> will read a NEXUS file and output a PostScript display of trees (one file for each tree
			in the tree block), as well as any character matrix (e.g. sequences) if present in the file.

	=head1 FILES

	=over 4

	=back
	=head1 VERSION

	$Id: NexPlotter.pm,v 1.2 2008/06/16 19:53:41 astoltzfus Exp $

=head1 REQUIRES

	Perl 5.004, Getopt::Std, Pod::Usage, NEXUS.pm

=head1 SEE ALSO

      perl(1)

=head1 AUTHOR

      Vivek Gopalan, Micheal Cheng, Weigang Qiu (with Peter Yang, Brendan O'Brien, and Arlin Stoltzfus)

=cut

##################### End ##########################