view release on metacpan or  search on metacpan

lib/Bio/Graphics/Glyph/decorated_transcript.pm  view on Meta::CPAN

sub decoration_border_color {
	my $self = shift;
	my $decoration = shift;
	
	if (!$decoration)
	{
		$self->throw("decoration not specified")	if (DEBUG);
		return "black";
	}

	$self->{'active_decoration'} = $decoration; # set active decoration for callback
	my $decoration_border_color = $self->option('decoration_border_color');

	return "black" if (!$decoration_border_color);
	
	return $decoration_border_color;
}

sub decorations_visible {
	my $self = shift;

	return $self->code_option('decoration_visible');
}

sub decoration_visible {
	my $self = shift;
	my $decoration = shift;
	
	if (!$decoration)
	{
		$self->throw("decoration not specified")	if (DEBUG);
		return 1;
	}

	$self->{'active_decoration'} = $decoration; # set active decoration for callback
	my $decoration_visible = $self->option('decoration_visible');

	return $decoration_visible
	  if ( defined $decoration_visible and $decoration_visible ne "" );

	return 1;
}

#sub draw {
#	my $self = shift;
#
#	warn "draw(): level " . $self->level . " " . $self->feature . "\n"
#	  if (DEBUG);
#
#	$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(@_);
	}
}

sub draw_decorations {
	my $self = shift;
	my ( $gd, $dx, $dy ) = @_;

	warn "draw_decorations(): " . $self->feature . "\n" if (DEBUG == 2);

	my ( $left, $top, $right, $bottom ) = $self->bounds( $dx, $dy );

	warn "  bounds: left:$left,top:$top,right:$right,bottom:$bottom\n"
	  if (DEBUG == 2);

	foreach my $mh (@{$self->sorted_decorations}) {
		  
		# skip invisible decorations
		next if ( !$self->decoration_visible($mh) );

		# determine overlapping segments between protein decorations and feature components
		my $overlap_start_nt = max( $self->feature->start, $mh->start );
		my $overlap_end_nt = min( $self->feature->end, $mh->end );
		if ( $overlap_start_nt <= $overlap_end_nt ) {

			# manual override; forces flip to be drawn flipped
			$self->factory->panel->flip( $self->flip )
			  if ( $self->option('flip_minus') ); 
			
			my ( $h_left, $h_right ) =
			  $self->map_no_trunc( $overlap_start_nt, $overlap_end_nt + 1 );
			( $h_left, $h_right ) = ( $h_right, $h_left )
			  if ( $h_left > $h_right );
#			my ($h_top, $h_bottom) = ($dy + $self->top + $self->pad_top, $dy + $self->bottom - $self->pad_bottom);
			my $h_top = $dy + $self->decoration_top($mh);
			my $h_bottom = $dy + $self->decoration_bottom($mh);

			my $color = $self->decoration_color($mh);

			 # don't draw over borders; not supported by SVG
			$gd->clip( $left + 1, $h_top, $right - 1, $h_bottom )
			  if ( !$gd->isa("GD::SVG::Image") );

			if ($color ne 'transparent')
			{
				warn "filledRectangle: left=$h_left,top=$h_top,right=$h_right,bottom=$h_bottom\n"
				  if (DEBUG == 2);
				$gd->filledRectangle( $h_left, $h_top, $h_right, $h_bottom,
					$self->factory->translate_color($color) );				
			}