package Bio::EnsEMBL::GlyphSet::tsv_variations;
use strict;
use vars qw(@ISA);
use Bio::EnsEMBL::GlyphSet;
@ISA = qw(Bio::EnsEMBL::GlyphSet);
use Sanger::Graphics::Bump;
use Bio::EnsEMBL::Utils::Eprof qw(eprof_start eprof_end);
use Data::Dumper;
use Bio::EnsEMBL::Variation::Utils::Sequence qw(ambiguity_code variation_class);
sub _init {
my ($self) = @_;
my $check = $self->check();
return unless defined $check;
return unless $self->strand() == -1;
my $Config = $self->{'config'};
my $transcript = $Config->{'transcript'}->{'transcript'};
my $consequences_ref = $Config->{'transcript'}->{'consequences'};
my $alleles = $Config->{'transcript'}->{'allele_info'};
return unless $alleles && $consequences_ref;
# Drawing params
my( $fontname, $fontsize ) = $self->get_font_details( 'innertext' );
my $pix_per_bp = $Config->transform->{'scalex'};
my @res = $self->get_text_width( 0, 'M', '', 'font'=>$fontname, 'ptsize' => $fontsize );
my( $font_w_bp, $font_h_bp) = ($res[2]/$pix_per_bp,$res[3]);
my $height = $res[3] + 4;
# Bumping params
my $pix_per_bp = $Config->transform->{'scalex'};
my $bitmap_length = int($Config->container_width() * $pix_per_bp);
my $voffset = 0;
my @bitmap;
# Data stuff
my $colour_map = $self->my_config('colours');
my $EXTENT = $Config->get_parameter( 'context')|| 1e6;
$EXTENT = 1e6 if $EXTENT eq 'FULL';
warn "######## ERROR arrays should be same length" unless length @$alleles == length @$consequences_ref;
my $raw_coverage_obj = $Config->{'transcript'}->{'coverage_obj'};
my $coverage_level = $Config->{'transcript'}->{'coverage_level'};
my @coverage_obj;
if ( @$raw_coverage_obj ){
@coverage_obj = sort {$a->[2]->start <=> $b->[2]->start} @$raw_coverage_obj;
}
my $index = 0;
foreach my $allele_ref ( @$alleles ) {
my $allele = $allele_ref->[2];
my $conseq_type = $consequences_ref->[$index];
$index++;
next unless $conseq_type && $allele;
next if $allele->end < $transcript->start - $EXTENT;
next if $allele->start > $transcript->end + $EXTENT;
# Alleles (if same as ref, draw empty box )---------------------
my $aa_change = $conseq_type->aa_alleles || [];
my $label = join "/", @$aa_change;
my $S = ( $allele_ref->[0]+$allele_ref->[1] )/2;
my $width = $font_w_bp * length( $label );
# Note: due to some bizarre API caching, the allele->allele_string is incorrect here
# The alleles from conseq_type need to be used instead.
my $ref_allele = $allele->ref_allele_string();
my @conseq_alleles = @{$conseq_type->alleles || [] };
if ($allele->strand != $transcript->strand) {
map {tr/ACGT/TGCA/} @conseq_alleles;
}
warn "Consequence alleles has more than one alt allele" if $#conseq_alleles > 0;
# Type and colour -------------------------------------------
my $type = lc($conseq_type->display_consequence);
my $colour;
if ($type eq 'sara') {
$colour = $colour_map->{$type}->{'border'};
} else {
$colour = $colour_map->{$type}->{'default'};
}
my $c;
# Coverage -------------------------------------------------
if ( grep { $_ eq "Sanger"} @{$allele->get_all_sources() || []} ) {
my $coverage = 0;
foreach ( @coverage_obj ) {
next if $allele->start > $_->[2]->end;
last if $allele->start < $_->[2]->start;
$coverage = $_->[2]->level if $_->[2]->level > $coverage;
}
if ($coverage) {
$coverage = ">".($coverage-1) if $coverage == $coverage_level->[-1];
$c= $coverage;
}
}
my $allele_id = $allele->variation_name;
my $dbid = $allele->variation->dbID;
my $href_sara = $self->_url
({'type' => 'Transcript',
'action' => 'Transcript_Variation',
'v' => $allele_id,
'vf' => $dbid,
'alt_allele' => $conseq_alleles[0],
'sara' => 1,
});
# SARA snps ----------------------------------------------------
if ($ref_allele eq $conseq_alleles[0]) { # if 'negative snp'
my $bglyph = $self->Rect({
'x' => $S - $font_w_bp / 2,
'y' => $height + 2,
'height' => $height,
'width' => $width + $font_w_bp +4,
'bordercolour' => 'grey70',
'absolutey' => 1,
'href' => $href_sara,
});
my $bump_start = int($bglyph->{'x'} * $pix_per_bp);
$bump_start = 0 if ($bump_start < 0);
my $bump_end = $bump_start + int($bglyph->width()*$pix_per_bp) +1;
$bump_end = $bitmap_length if ($bump_end > $bitmap_length);
my $row = & Sanger::Graphics::Bump::bump_row( $bump_start, $bump_end, $bitmap_length, \@bitmap );
$bglyph->y( $voffset + $bglyph->{'y'} + ( $row * (2+$height) ) + 1 );
$self->push( $bglyph );
next;
}
# Normal SNPs
my $aa;
$aa = "$aa_change->[0] to $aa_change->[1]" if $aa_change->[1];
# Codon - make the letter for the SNP position in the codon bold
my $codon = $conseq_type->codon;
my $tc;
if ( $codon ) {
my $pos = ($conseq_type->cds_start % 3 || 3) - 1;
$codon =~ s/(\w{$pos})(\w)(.*)/$1<strong>$2<\/strong>$3/;
my $strand = $transcript->strand; # > 0 ? "+" : "-";
$tc = "transcript codon (". $strand." strand) ".$codon;
}
# Draw ------------------------------------------------
my @res = $self->get_text_width( 0, $label, '', 'font'=>$fontname, 'ptsize' => $fontsize );
my $W = ($res[2]+4)/$pix_per_bp;
my $href = $self->_url
({'type' => 'Transcript',
'action' => 'Transcript_Variation',
'v' => $allele_id,
'vf' => $dbid,
'alt_allele' => $conseq_alleles[0],
'aa_change' => $aa,
'tc' => $tc,
'cov' => $c,
});
my $tglyph = $self->Text({
'x' => $S-$res[2]/$pix_per_bp/2,
'y' => $height + 3,
'height' => $font_h_bp,
'width' => $res[2]/$pix_per_bp,
'textwidth' => $res[2],
'font' => $fontname,
'ptsize' => $fontsize,
'colour' => 'black',
'text' => $label,
'absolutey' => 1,
});
my $bglyph = $self->Rect({
'x' => $S - $W / 2,
'y' => $height + 2,
'height' => $height,
'width' => $W,
'colour' => $colour,
'absolutey' => 1,
'href' => $href,
});
my $bump_start = int($bglyph->{'x'} * $pix_per_bp);
$bump_start = 0 if ($bump_start < 0);
my $bump_end = $bump_start + int($bglyph->width()*$pix_per_bp) +1;
$bump_end = $bitmap_length if ($bump_end > $bitmap_length);
my $row = & Sanger::Graphics::Bump::bump_row( $bump_start, $bump_end, $bitmap_length, \@bitmap );
$tglyph->y( $voffset + $tglyph->{'y'} + ( $row * (2+$height) ) + 1 );
$bglyph->y( $voffset + $bglyph->{'y'} + ( $row * (2+$height) ) + 1 );
$self->push( $bglyph, $tglyph );
}
}
sub title {
my($self,$f) = @_;
my $vid = $f->variation_name;
my $type = $f->display_consequence;
my $dbid = $f->dbID;
my ($s,$e) = $self->slice2sr( $f->start, $f->end );
my $loc = $s == $e ? $s
: $s < $e ? $s.'-'.$e
: "Between $s and $e"
;
return "Variation: $vid; Location: $loc; Consequence: $type; Ambiguity code: ".$f->ambig_code;
}
sub error_track_name { return $_[0]->species_defs->AUTHORITY.' transcripts'; }
1;