package Bio::EnsEMBL::GlyphSet::snp_fake_haplotype;
use strict;
use vars qw(@ISA);

use Bio::EnsEMBL::Utils::Eprof qw(eprof_start eprof_end eprof_dump);

use Bio::EnsEMBL::GlyphSet;
use Data::Dumper;  
our @ISA = qw(Bio::EnsEMBL::GlyphSet);

sub _init {
  my ($self) = @_;

  my $Config        = $self->{'config'};
  my $conf_colours  = $self->my_config('colours' );

  my @snps = @{$Config->{'snps'}};
  return unless scalar @snps;
  return unless $Config->{'snp_fake_haplotype'};

  # Get reference strain name for start of track:
  my $individual_adaptor = $self->{'container'}->adaptor->db->get_db_adaptor('variation')->get_IndividualAdaptor;
  my $golden_path =  $individual_adaptor->get_reference_strain_name();
  my $reference_name = $Config->{'reference'};
  # Put allele and coverage data from config into hashes -----------------------
  my %strain_alleles;   # $strain_alleles{strain}{id::start} = allele
  my %coverage;         # $coverage{strain} = [ [start, end, level], [start, end, level]   ];

  my $fully_inbred;
  foreach my $data ( @{$Config->{'snp_fake_haplotype'}} ) { 
    my( $strain, $allele_ref, $coverage_ref ) = @$data;

    # find out once if this species is inbred or not. Then apply to all
    unless (defined $fully_inbred) {
      my ($individual) = @{$individual_adaptor->fetch_all_by_name($strain)};
      if ($individual) {
	      $fully_inbred = $individual->type_individual eq 'Fully_inbred' ? 1 : 0;
      }
    }
    $strain_alleles{$strain} = {};  # every strain should be in here
    foreach my $a_ref ( @$allele_ref ) { 
      next unless $a_ref->[2];

      # strain_alleles{strain_name}{snp_id::start} = allele
      $strain_alleles{$strain}{ join "::", $a_ref->[2]->{'_variation_id'}, $a_ref->[2]->{'start'} } = $a_ref->[2]->allele_string ;
    }
    foreach my $c_ref ( @$coverage_ref ) { 
      push @{ $coverage{$strain} }, [ $c_ref->[2]->start, $c_ref->[2]->end, $c_ref->[2]->level ];
    }
  }

  # Default to Ensembl golden path ref strain if chosen "ref" strain isn't selected on the display
  $reference_name = $golden_path unless $strain_alleles{$reference_name};

  # Info text 
  my $info_text = "Comparison to $reference_name alleles";

  my( $fontname_c, $fontsize_c ) = $self->get_font_details( 'caption' );
  my @res_c = $self->get_text_width( 0, 'X|X', '', 'font'=>$fontname_c, 'ptsize' => $fontsize_c );
  my $th_c = $res_c[3];

  my( $fontname, $fontsize ) = $self->get_font_details( 'innertext' );
  my @res = $self->get_text_width( 0, 'X|X', '', 'font'=>$fontname, 'ptsize' => $fontsize );
  my $w  = $res[2];
  my $th = $res[3];
  my $pix_per_bp    = $Config->transform->{'scalex'};

  my $track_height = $th + 4;

  $self->push($self->Space({ 'y' => 0, 'height' => $track_height, 'x' => 1, 'w' => 1, 'absolutey' => 1, }));

  my $offset = $track_height;
  my $textglyph = $self->Text({
    'x'          => -$self->get_parameter('__left_hand_margin'),
    'y'          => 2+$offset,
    'width'      => 0,
    'height'     => $th_c,
    'font'       => $fontname_c,
    'ptsize'     => $fontsize_c,
    'colour'     => 'black',
    'text'       => $info_text,
    'absolutey'  => 1,
    'absolutex'  => 1,
    'halign'     => 'left'
   });
  $self->push( $textglyph );
  $offset += $th_c + 6;

  # Reference track ----------------------------------------------------
  my @ref_name_size = $self->get_text_width( 80, $reference_name, '', 'font'=>$fontname, 'ptsize' => $fontsize );
  if ($ref_name_size[0] eq '') {
    $self->strain_name_text($th, $fontname, $fontsize, $offset, "Compare to", $Config, $fully_inbred);
    $offset += $track_height;
    $self->strain_name_text($th, $fontname, $fontsize, $offset, "    $reference_name", $Config, $fully_inbred);
  }
  else {
    $self->strain_name_text($th, $fontname, $fontsize, $offset, "Compare to $reference_name", $Config, $fully_inbred);
  }
  # First lets draw the reference SNPs....
  my @golden_path;
  my @widths = ();
  foreach my $snp_ref ( @snps ) {
    my $start = $snp_ref->[0];
    my $end   = $snp_ref->[1];
    my $snp   = $snp_ref->[2];

    my @res = $self->get_text_width( ($end-$start+1)*$pix_per_bp, 'X|X', 'X|X', 'font'=>$fontname, 'ptsize' => $fontsize );
    my $tmp_width = ($w*2+$res[2])/$pix_per_bp;
    $tmp_width =  $end-$start+1 if  $end-$start+1 < $tmp_width;
    push @widths, $tmp_width;
    my $label =  $snp->allele_string; 

    my ($golden_path_base) = split "\/", $label;
    my $reference_base;
    my $colour = "white";

    if ($reference_name eq $golden_path) {
      $reference_base = $golden_path_base; 
    }
    else { 
      return unless $strain_alleles{$reference_name};
      my $start  = $snp->start;
      $reference_base =  $strain_alleles{$reference_name}{ join "::", $snp->{_variation_id}, $start }; 

      # If no allele for SNP but there is coverage, allele = golden path allele
      unless ($reference_base) {
	      foreach my $cov ( @{$coverage{$reference_name}} ) {
	        if( $start >= $cov->[0] && $start <= $cov->[1] ) {
	          $reference_base = $golden_path_base;
	          last;
	        }
	      }
      }

      # Golden path ne reference but still need the golden path track in there somewhere
      my $golden_colour = undef;

      if ($reference_base) { # determine colours for golden path row dp on reference colours
      	$conf_colours->{$self->bases_match($golden_path_base, $reference_base) }->{'default'};
      }
      push @golden_path, {
			  label   => $label,
			  snp_ref => $snp_ref,
			  colour  => $golden_colour,
			  base    => $golden_path_base,
			 };
    }

    # Set ref base colour and draw glyphs ----------------------------------
    $colour = $conf_colours->{'same'}->{'default'} if $reference_base; 
    $snp_ref->[3] = {};

    # If ref base is like "G", have to define "G|G" as also having ref base colour
    if (length $reference_base ==1) {
      $snp_ref->[3]{ "$reference_base|$reference_base"} = $conf_colours->{'same'}{'default'};
      $snp_ref->[3]{ $reference_base} = $conf_colours->{'same'}{'default'};
    }
    elsif ($reference_base =~/(\w)\|(\w)/) {
      if ($1 ne $2) { # heterozygous it should be stripy
	      $snp_ref->[3]{ $reference_base} = $conf_colours->{'het'}{'default'};
	      $snp_ref->[3]{ $2.$1} = $conf_colours->{'het'}{'deafult'};
      }
      else {
	      $snp_ref->[3]{ $reference_base } = $conf_colours->{'same'}{'default'};
      }
    }

    $snp_ref->[4] = $reference_base ;
    $self->do_glyphs($offset, $th, $tmp_width, $pix_per_bp, $fontname, $fontsize, $Config, $label, $snp_ref->[0],  $snp_ref->[1], $colour, $reference_base);

  } #end foreach $snp_ref

  # Make sure the golden path one is in there somewhere
  my $c = 0;
  if ( $reference_name ne $golden_path && !$strain_alleles{$golden_path} ) {
    $offset += $track_height;
    $self->strain_name_text( $th, $fontname, $fontsize, $offset, $golden_path, $Config, $fully_inbred);
    foreach my $hash (@golden_path) {
      my $snp_ref = $hash->{snp_ref};
      my $text_colour = $hash->{colour} ? "white" : "black";
      $self->do_glyphs($offset, $th, $widths[$c], $pix_per_bp, $fontname, $fontsize, $Config, $hash->{label}, $snp_ref->[0], $snp_ref->[1], $hash->{colour}||"white", $hash->{base}, $text_colour);
      $c++;
    }
  }

  # Draw SNPs for each strain -----------------------------------------------
  foreach my $strain ( sort {$a cmp $b} keys %strain_alleles ) {
    next if $strain eq $reference_name; 
    $offset += $track_height;
    $self->strain_name_text($th,$fontname, $fontsize, $offset, $strain, $Config, $fully_inbred);

    my $c = 0;
    foreach my $snp_ref ( @snps ) {
      my $snp = $snp_ref->[2];
      my $label =  $snp->allele_string;
      my $start  = $snp->start;

      my $allele_string =  $strain_alleles{$strain}{ join "::", $snp->{_variation_id}, $start };

      # If no allele for SNP but there is coverage, allele = reference allele
      unless( $allele_string ) {
	      foreach my $cov ( @{$coverage{$strain}} ) {
	        if( $start >= $cov->[0] && $start <= $cov->[1] ) {
	          ($allele_string) = split "\/", $label;
	          last;
	        }
	      }
      }

      # Determine colour ------------------------------------
      my $colour = "white";#undef;
      my $text = $snp_ref->[4] ? "white" : "black"; # text colour white if ref base defined
      if( $allele_string && $snp_ref->[4] ) {      # only fill in colour if ref base is defined
        $colour = $snp_ref->[3]{ $allele_string };
        unless($colour) {                           # allele not the same as reference
	  if (length $allele_string ==1 ) {
	    $colour =  $snp_ref->[3]{ $allele_string } = $conf_colours->{'different'}{'default'};
	  }
	  else{ # must be a het or must be different
	    my $type = $self->bases_match((split /\|/, $allele_string), "one_allele");
	    $colour = $snp_ref->[3]{ $allele_string } = $conf_colours->{$type}{'default'};
	    #$colours[ scalar(values %{ $snp_ref->[3] } )] || $colours[-1];
	  }

        }
      }

      # Draw rectangle ------------------------------------
      $self->do_glyphs($offset, $th,$widths[$c], $pix_per_bp, $fontname, $fontsize, $Config, $label, $snp_ref->[0], 
		       $snp_ref->[1], $colour, $allele_string, $text);
      $c++;
    }
  }
  $self->push($self->Space({ 'y' => $offset + $track_height, 'height' => $th+2, 'x' => 1, 'width' => 1, 'absolutey' => 1, }));

  # Colour legend stuff
  foreach (keys %$conf_colours) { 
    push @{ $Config->{'tsv_haplotype_legend_features'}->{'variations'}->{'legend'}}, $conf_colours->{$_}->{'text'},   $conf_colours->{$_}->{'default'};
  }
  return 1;
}
# Glyphs ###################################################################

sub strain_name_text {
  my ($self, $th, $fontname, $fontsize, $offset, $name, $Config, $fully_inbred) = @_;
  (my $url_name = $name) =~ s/Compare to |^\s+//;
  my $URL = $self->_url({'action' => 'ref',  'reference' => $url_name});
  my $textglyph = $self->Text({
      'x'          => -$self->get_parameter('__left_hand_margin'),
      'y'          => $offset+1,
      'height'     => $th,
      'font'       => $fontname,
      'ptsize'     => $fontsize,
      'colour'     => 'black',
      'text'       => $name,
      'halign'     => 'left',
      'width'      => 105,
      'absolutex'  => 1,
      'absolutey'  => 1,
      'absolutewidth'  => 1,
      'href'      => $URL,
  });
  $self->push( $textglyph );
  return 1;
}
sub do_glyphs {
  my ($self, $offset, $th, $tmp_width, $pix_per_bp, $fontname, $fontsize, $Config, $label, $start, $end, $colour, $allele_string, $text_colour) = @_;
  my $length = exists $self->{'container'}{'ref'} ? $self->{'container'}{'ref'}->length : $self->{'container'}->length;

  $start = 1 if $start < 1;
  $end = $length if $end > $length;

  my @res = $self->get_text_width( 0, length($allele_string)==1 ? "A" : $allele_string, '', 'font'=>$fontname, 'ptsize' => $fontsize );

  # Heterozygotes should be stripey
  my @stripes;
  if ($colour eq 'stripes') {
    my $Config        = $self->{'config'};
    my $conf_colours  = $self->my_config('colours');
    $colour = $conf_colours->{'same'}{'default'};
    @stripes = ( 'pattern'       => 'hatch_thick',
		 'patterncolour' => $conf_colours->{'different'}{'default'},
	       );
  }

  my $back_glyph = $self->Rect({
    'x'         => ($end+$start-1-$tmp_width)/2,
    'y'         => $offset,
    'colour'    => $colour,
    'bordercolour' => 'black',
    'absolutey' => 1,
    'height'    => $th+2,
    'width'     => $tmp_width,
    'absolutey' => 1,
    @stripes,
  });
  $self->push( $back_glyph );
  if ( ($end-$start + 1) > $res[2]/$pix_per_bp) {
    if( $res[0] eq 'A' and $res[0] ne $allele_string ) {
      @res = $self->get_text_width( 0, $allele_string, '', 'font'=>$fontname, 'ptsize' => $fontsize );
    }

    my $tmp_width = $res[2]/$pix_per_bp;
    my $textglyph = $self->Text({
      'x'          => ( $end + $start - 1 - $tmp_width)/2,
      'y'          => 1+$offset,
      'width'      => $tmp_width,
      'textwidth'  => $res[2],
      'height'     => $th,
      'font'       => $fontname,
      'ptsize'     => $fontsize,
      'colour'     => $text_colour || "white",
      'text'       => $allele_string,
      'absolutey'  => 1,
    }) if $res[0];
    $self->push( $textglyph ) if defined $textglyph;
  }
  return 1;
}

sub bases_match {
  my ($self, $one, $two, $one_allele) = @_;
  $one .= "|$one" if length $one == 1;
  $two .= "|$two" if length $two == 1;

  my $same = $one_allele ? "different" : "same";
  my $different = $one_allele ? "het"  : "different";
  return $same if ($one eq $two);

  foreach (split /\|/, $one) {
    return "het" if $_ eq substr $two, 0, 1;
    return "het" if $_ eq substr $two, 2, 1;
  }
  return $different;
}
1;