Bio::Graphics::Glyph::spectrogram - The "spectrogram" glyph

  See L<Bio::Graphics::Panel>, L<Bio::Graphics::Glyph>
      and L<Bio::Graphics::Browser::Plugin::Spectrogram> 

  Option      Description                      Default
  ------      -----------                      -------

  -height     Height of glyph		       calculated

  -bump       Whether to bump features         off

  -win        window size used to calculate    calculated
              the spectrogram values

package Bio::Graphics::Glyph::spectrogram;
# $Id: spectrogram.pm,v 1.1 2008-12-08 23:18:43 lstein Exp $

use strict;
use Bio::Graphics::Glyph::generic;
use GD::Simple;
use GD;
use List::Util qw/sum max/;

use Data::Dumper;

use vars '@ISA';
@ISA = 'Bio::Graphics::Glyph::generic';

# saturation value is fixed at the maximum
use constant SAT  => 255;
use constant GDS  => GD::Simple->new(1,1);

# each spectrogram feature will be a standalone
# (unaggregated) feature.
sub draw {
  my $self = shift;
  my $gd = shift;
  my ( $x1, $y1, $x2, $y2 ) = $self->bounds(@_);
  my $v_offset = $y1;
  my $last_y   = 0;
  my $last_label;
  my $height   = $self->option('height');
  my $win      = $self->option('win');
  my $feat     = $self->feature;

  # API change?
  my $att;
  if (ref $feat->attributes) {
    $att = $feat->attributes;
  } 
  else {
    $att = {$feat->attributes};
  }

  my $max      = $att->{max};
  my $black    = $gd->colorResolve(0,0,0);

  my %seen;

  my $rows = @{$att->{g}};
  my $step = int $height/$rows;
  my $lbl_type = shift @{$att->{labels}} if defined $att->{labels};

  for my $g (@{$att->{g}}) {
    my $a   = shift @{$att->{a}};
    my $t   = shift @{$att->{t}};
    my $c   = shift @{$att->{c}};
    my $lbl = shift @{$att->{labels}} if defined $att->{labels}; 

    my ($hue,$bri) = get_bg_color($g,$a,$t,$c);
    $hue = int(($hue/360)  * 255);
    $hue += 255 if $hue < 0;
    $hue -= 255 if $hue > 255;
    $bri = int(($bri/$max) * 255);
    my @rgb = GDS->HSVtoRGB($hue,SAT,$bri);
    my $bgcolor = $gd->colorResolve(@rgb);
    $self->filled_box($gd, $x1, $y1, $x2, $y1+$step, $bgcolor, $bgcolor);

    if ($lbl && $y1 > $last_y+10) {

      my $label = sprintf '%4s', int $lbl;

      # print labels for the number closest to an integer
      # we use the previous value to catch the transition
      if ($last_label ne $label) {
	  $gd->string(gdSmallFont, $x1-25, $last_y-5, $last_label, $black);
      }
      # this will hopefully catch the label at the bottom of the stack
      elsif (!$att->{labels}->[0]) {
	$gd->string(gdSmallFont, $x1-25, $y1-5, $label, $black);
      }
      
      $last_y = $y1 + 15;
      $last_label = $label;
    }
  
    if ($lbl) {
      $gd->stringUp(gdSmallFont, $x1-27, $y2-5, $lbl_type, $black);
    }

    $y1 += $step;
  }
}


# HSV color space:
# Hue        (0-360 degrees)
# Saturation (0-100)
# Brightness (0-100)

sub get_bg_color {
  my ($g,$a,$t,$c) = @_;
  my $total = sum(@_) || return (0,0);
  my $max = max (@_);
  my $angle;

  # Assign the angular coordinate for the 
  # dominant base (>50% of signal) 
  if ($max == $g && $max >= $total/2) {
    $angle = 60;  # yellow
  }
  elsif ($max == $a && $max >= $total/2) {
    $angle = 240; # blue
  }
  elsif ($max == $t &&  $max >= $total/2) {
    $angle = 0;   # red
  }
  elsif ($max == $c &&  $max >= $total/2) {
    $angle = 120; # green
  }

  # or else take the weighted average coordinate
  # This is not perfect, as the coordinates are not
  # equidistant, but most spots will fall into
  # the above category
  else {
    my $acg     = 60*$g + 120*$c + 240*$a;
    my $t_angle = $acg/($g + $c + $a) > 180 ? 360 : 1;
    $angle  = ($t_angle*$t + $acg)/$total;
  }

  $angle += 0.5;

  return (int($angle), $total);
}

# make sure bumping is off to get an aligned spectrogram
sub bump { 0 }

1;