Bio-Graphics
view release on metacpan or search on metacpan
lib/Bio/Graphics/Glyph/decorated_transcript.pm view on Meta::CPAN
# $self->Bio::Graphics::Glyph::processed_transcript::draw(@_);
#
#}
sub draw_component {
my $self = shift;
warn "draw_component(): " . ref($self) . " " . $self->feature . "\n" if (DEBUG == 2);
# draw regular glyph first
if ( $self->feature->source eq 'legend' ) {
# hack, but processed_transcript cannot be drawn without arrow...
$self->Bio::Graphics::Glyph::segments::draw_component(@_);
}
else {
$self->Bio::Graphics::Glyph::processed_transcript::draw_component(@_);
}
# draw decorations if parent information available
if ( $self->{'parent'} and $self->feature->primary_tag eq "CDS") {
return $self->draw_decorations(@_);
lib/Bio/Graphics/Glyph/generic.pm view on Meta::CPAN
$self->render_label($gd,
$font,
1,
$y,
$label);
}
}
sub render_label {
my $self = shift;
my ($gd,$font,$x,$y,$label,$is_legend) = @_;
my $rlp = $self->record_label_positions;
unless ($rlp || $is_legend)
{
$gd->string($font,$x,$y,$label,$self->labelcolor);
}
$self->panel->add_key_box($self,$label,$x,$y)
if $rlp
}
sub draw_description {
my $self = shift;
my ($gd,$dx,$dy,$partno,$total_parts) = @_;
lib/Bio/Graphics/Glyph/phylo_align.pm view on Meta::CPAN
$node->{'_description'}{'x'} = $x;
$node->{'_description'}{'childmin'} = $min_child_x;
$node->{'_description'}{'childmax'} = $max_child_x;
}
$node->{'_description'}{'y'} = $height;
}
sub get_legend_and_scale {
my $yscale = shift;
my $height = shift;
if ($yscale < 2*$height - 1) {
$height = 0;
}
#########
# chage scale later so that the base can be anything and not just 1!!
# scale legend goes in order from min, axis, max, if either min or max = 1, then will only have min & max
my @order = sort {$a <=> $b} (1, @_);
my $graph_scale = - ($yscale - $height) / (log10($order[2]) - log10($order[0]));
my $graph_legend = {1 => $graph_scale * (log10(1) - log10($order[2])),
$order[0] => $graph_scale * (log10($order[0]) - log10($order[2])),
$order[2] => 0};
#print "order is @order and the yscale is $yscale and height is $height<br>";
return ($graph_legend, $graph_scale);
}
#main method that draws everything
sub draw {
my $self = shift;
my $font = $self->mono_font;
my $height = $font->height;
my $scale = $self->scale;
my $gd = shift;
lib/Bio/Graphics/Glyph/phylo_align.pm view on Meta::CPAN
my $connector = $self->connector;
#all species having alignments in viewing window (key=name, val=feat obj)
my %alignments = $self->extract_features;
#print "Species are:",keys %alignments,"<br>\n";
my ($min_score, $max_score) = $self->get_score_bounds(%alignments);
#$min_score = 0 unless $min_score;
my ($graph_legend, $graph_scale) = get_legend_and_scale($yscale, $height, $min_score, $max_score);
#print "min/max scores: $min_score, $max_score<br>\n",
#"graph legend and scale: $graph_legend, $graph_scale";
# TODO: Gap entries give an undef for the min values for some reason
my $refspecies = $self->option('reference_species');
my @current_species = keys %alignments; #all species in viewing window
my @known_species = $self->known_species($tree); #all species from cladogram info
my @unknown_species = $self->unknown_species(\%alignments,
$refspecies,
\@current_species,
lib/Bio/Graphics/Glyph/phylo_align.pm view on Meta::CPAN
my @features = @{$alignments{$species}};
#draw the axis for the plots
$self->draw_pairwisegraph_axis($gd,
$graph_legend,
$x1,
$x2,
$y_track_top,
$y_track_bottom,
$draw_clado_left,
@bounds) unless $self->dna_fits;
#iterate through the wigfiles and put them on the graph
###
lib/Bio/Graphics/Glyph/phylo_align.pm view on Meta::CPAN
# my $targ_dna = $feat->hit->seq->seq || print "No targ dna";
next if !defined $ref_dna || !defined $targ_dna;
$self->draw_dna($gd,$ref_dna, $targ_dna,$fx1,$fy1,$fx2,$fy2,\@gaps);
} else {
my $wigfile = $attributes{'wigfile'};
if ($wigfile) {
if (-e $wigfile) {
$self->pairwise_draw_wig_graph($gd, $feat, $x1, $scale, \@gaps, $graph_legend->{1}, $graph_scale, $fx1, $fy1, $fx2, $fy2,$wigfile);
} else {
warn "Wigfile $wigfile does not exist, skipping ...";
}
} else {
$self->pairwise_draw_graph($gd, $feat, $x1, $scale, \@gaps, $graph_legend->{1}, $graph_scale, $fx1, $fy1, $fx2, $fy2);
}
}
}
#label the species in the cladogram
my $x_label_start = $start_x + $xoffset + $font->width;
$self->species_label($gd, $draw_clado_left, $x_label_start, $y, $species) unless ($self->option('hide_label'));
lib/Bio/Graphics/Glyph/phylo_align.pm view on Meta::CPAN
my $write_pos = $x_max - $x_start - $text_width;
$gd->filledRectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$font->height, $bgcolor);
$gd->rectangle($write_pos, $y_start, $write_pos + $text_width+2, $y_start+$font->height, $self->fgcolor);
$gd->string($font, $write_pos+2, $y_start, $species, $self->fgcolor);
}
}
# draws the legends on the conservation scale
sub draw_pairwisegraph_axis {
my $self = shift;
my ($gd, $graph_legend, $x1, $x2, $y_track_top, $y_track_bottom, $draw_clado_left, @bounds) = @_;
my $font = $self->mono_font;
my $axis_color = $self->color('axis_color') || $self->fgcolor;
my $mid_axis_color = $self->color('mid_axis_color') || $axis_color;
for my $label (keys %$graph_legend) {
my $y_label = $graph_legend->{$label} + $y_track_top;
my $col = $axis_color;
$col = $mid_axis_color if ($y_label != $y_track_top && $y_label != $y_track_bottom);
$gd->line($x1,$y_label,$x2,$y_label,$col);
my @coords = (0, $y_label, $x1, $y_label);
if ($draw_clado_left) {
#draw the legend on the right
$coords[0] = $bounds[0] - $coords[0];
$coords[2] = $bounds[0] - $coords[2];
my $x_text_offset = length($label) * $font->width;
$gd->string($font, $coords[0]-$x_text_offset, $coords[1], $label, $self->fgcolor);
$gd->line(@coords, $self->fgcolor);
$gd->line($x2,$y_track_top,$x2,$y_track_bottom,$self->fgcolor);
} else {
lib/Bio/Graphics/Glyph/xyplot.pm view on Meta::CPAN
for my $draw_method (@draw_methods) {
$self->$draw_method($gd,$dx,$dy,$y_origin);
}
$self->panel->startGroup($gd);
$self->_draw_scale($gd,$scale,$min_score,$max_score,$dx,$dy,$y_origin);
$self->panel->endGroup($gd);
$self->draw_label(@_) if $self->option('label') or $self->record_label_positions;
$self->draw_description(@_) if $self->option('description');
$self->draw_legend(@_) if $self->option('overlay');
$self->panel->endGroup($gd);
}
sub lookup_draw_method {
my $self = shift;
my $type = shift;
return '_draw_boxes' if $type eq 'histogram'; # same thing
return '_draw_boxes' if $type eq 'boxes';
lib/Bio/Graphics/Glyph/xyplot.pm view on Meta::CPAN
}
sub contrasting_label_color {
my $self = shift;
my ($gd,$bgcolor) = @_;
my ($r,$g,$b) = $gd->rgb($bgcolor);
my $avg = ($r+$g+$b)/3;
return $self->translate_color($avg > 128 ? 'black' : 'white');
}
sub draw_legend {
my $self = shift;
my ($gd,$left,$top,$partno,$total_parts) = @_;
return if $self->bump eq 'overlap';
my $color = $self->option('fgcolor');
my $name = $self->feature->{name};
my $label = "<a id=\"legend_$name\" target=\"_blank\" href=\"#\"> <font color=\'$color\';\">" . $name . "</font></a>" or return;
my $font = $self->labelfont;
my $x = $self->left + $left - $self->string_width($label,$font) - $self->extra_label_pad;
my $y = $self->{top} + $top;
my $is_legend = 1;
$self->render_label($gd,
$font,
$x,
$y,
$label,
$is_legend);
}
1;
__END__
=head1 NAME
Bio::Graphics::Glyph::xyplot - The xyplot glyph
lib/Bio/Graphics/Panel.pm view on Meta::CPAN
($height+$spacing) * $rows + $self->{key_font}->height +KEYPADTOP;
}
else { # no known key style, neither "between" nor "bottom"
return $self->{key_height} = 0;
}
}
sub add_key_box {
my $self = shift;
my ($track,$label,$x,$y, $is_legend) = @_;
my $value = [$label,$x,$y,$x+$self->{key_font}->width*CORE::length($label),$y+$self->{key_font}->height,$track];
push @{$self->{key_boxes}},$value;
}
sub key_boxes {
my $ref = shift->{key_boxes};
return wantarray ? @$ref : $ref;
}
sub add_category_labels {
( run in 0.629 second using v1.01-cache-2.11-cpan-49f99fa48dc )