view release on metacpan or  search on metacpan

lib/Bio/NEXUS/Tools/NexPlotter.pm  view on Meta::CPAN

	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');