The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Bio::Graphics::Browser2::OptionPick;

=head1 NAME

Bio::Graphics::Browser2::OptionPick -- Pick options

=head1 SYNOPSIS

 use Bio::Graphics::Browser2::OptionPick;
 my $picker = Bio::Graphics::Browser2::OptionPick->new($render_object);

 print start_html(),
  start_form(),
  $picker->('bgcolor','orange','blue'),
  end_form(),
  end_html();

=head1 Author

Copyright 2007 Cold Spring Harbor Laboratory.

This package and its accompanying libraries is free software; you can
redistribute it and/or modify it under the terms of the GPL (either
version 1, or at your option, any later version) or the Artistic
License 2.0.  Refer to LICENSE for the full license text. In addition,
please see DISCLAIMER.txt for disclaimers of warranty.

=cut


use strict;
use Bio::Graphics::Panel;
use Bio::Graphics::Glyph::heat_map;

# my @GRADIENT =
#   ('white','#D3D3D3','#A9A9A9','gray','black','red','yellow','blue','green','orange','magenta','cyan',
#    '#FFCCCC','#FFAAAA','#FF9999','#EE7777','#EE5555','#EE3333','#EE2222','#DD0000','#DD2222','#EE3344','#EE5566',
#    '#EE6699','#EE88BB','#EEAADD','#EEBBFF','#EEBBFF','#EEBBFF','#DDBBFF','#DDBBFF','#CCBBFF','#CCCCFF','#CCCCFF',
#    '#AAAAEE','#8899EE','#7777DD','#5566CC','#3355BB','#2233BB','#0022AA','#2244AA','#3366BB','#5588CC','#7799CC',
#    '#88BBDD','#AADDDD','#CCFFEE','#BBFFCC','#AAFFAA','#99EE88','#77EE66','#66EE44','#55EE22','#44EE00','#66EE11',
#    '#77EE11','#99EE22','#AAEE22','#CCEE33','#DDEE33','#FFFF44');
my $heatmap = 'Bio::Graphics::Glyph::heat_map';
my $bgp     = 'Bio::Graphics::Panel';

my @GRADIENT = sort {
    my ($r1,$g1,$b1) = $bgp->color_name_to_rgb($a);
    my ($r2,$g2,$b2) = $bgp->color_name_to_rgb($b);
    my ($h1,$s1,$v1) = $heatmap->RGBtoHSV($r1,$g1,$b1);
    my ($h2,$s2,$v2) = $heatmap->RGBtoHSV($r2,$g2,$b2);
    return $h1<=>$h2 || $s1<=>$s2 || $v1<=>$v2;
} grep {!/gradient/} Bio::Graphics::Panel->color_names;
my %LABELS = ();

sub new {
  my $self   = shift;
  my $render_object = shift;
  return bless {render_object => $render_object},ref $self || $self;
}

sub translate {
  my $self = shift;
  my $str =  shift;
  return $self->{render_object}->tr($str) || $str;
}

sub render_object { shift->{render_object} }


sub color_pick {
  my $self = shift;
  my ($form_name,$default_color,$current_color,$class) = @_;
  $class ||= 'color_picker';

  my ($bgcolor,$fontcolor);
  my $dynamic    = $self->translate('DYNAMIC_VALUE');

  if (ref($default_color)) {  # CODE or something else horrible
      $default_color = $dynamic;
      $bgcolor       = 'white';
      $fontcolor     = 'black';
  } else {
      $bgcolor     = $default_color;
      my ($r,$g,$b)   = Bio::Graphics::Panel->color_name_to_rgb($default_color);
      my $avg         = ($r+$g+$b)/3;
      $fontcolor   = $avg > 128 ? 'black' : 'white';
  }

  $current_color ||= $default_color;

  my ($current_bg,$current_fg);
  if ($current_color eq $dynamic) {
      $current_bg = 'white';
      $current_fg = 'black';
  } else {
      $current_bg = $current_color;
      my ($r,$g,$b)   = Bio::Graphics::Panel->color_name_to_rgb($current_color);
      my $avg         = ($r+$g+$b)/3;
      $current_fg     = $avg > 128 ? 'black' : 'white';
  }

  my $menu = qq(<select name="$form_name"
                class="$class",
                style="background-color:$current_bg;color:$current_fg"
                onChange="var s=this.options[this.selectedIndex];Element.extend(s);this.style.background=s.getStyle('background-color');this.style.color=s.style.color">\n);

  my $default = $self->translate('DEFAULT');

  # add default color
  my $selected = $default_color eq $current_color ? 'selected' : '';
  $menu .= qq(<option value="$default_color" style="color:$fontcolor;background-color:$bgcolor"$selected>$default_color $default</option>\n);

  my $index = 0;
  for my $color (@GRADIENT) {
    next if $color eq $default_color;
    my $selected    = $color eq $current_color ? 'selected' : '';
    my $description  = $color;
    my ($r,$g,$b)   = Bio::Graphics::Panel->color_name_to_rgb($color);
    my $avg         = ($r+$g+$b)/3;
    my $fontcolor   = $avg > 128 ? 'black' : 'white';
    $menu .= qq(<option value="$color" bgcolor="$color" style="background-color:$color;color:$fontcolor"$selected>$description</option>\n);
  }
  $menu .= "</select\n>";
  return $menu;
}

sub popup_menu {
  my $self = shift;
  my %args = @_;
  my $name    = $args{-name};
  my $current = $args{-current};
  my $default = $args{-default};
  my $values  = $args{-values};
  my $id      = $args{-id};
  my $class   = $args{-class};
  my $labels  = $args{-labels}  || {};
  my $scripts = $args{-scripts} || {};

  my $dynamic =  $self->translate('DYNAMIC_VALUE');
  my %seen;
  my @values = grep {!$seen{$_}++} map { ref($_) || /^CODE\(/ ? $dynamic : $_ } @$values;

  $current ||= $default;
  my $def    = $self->translate('DEFAULT');
  my $def_label = $labels->{$default} || $default;
  my %labels    = (%$labels,$default => "$def_label $def");
  my @extra     = $id ? (-id => $id) : ();
  push @extra,(-class=>$class) if $class;

  return CGI::popup_menu(-name    => $name,
			 -values  => \@values,
			 -default => $current,
			 -labels  => \%labels,
                         %$scripts,
                         @extra,
			 -override=>1);
}

1;