package GO::View::GD;

#######################################################################
# Module Name  :  GO/View/GD.pm
#
# Date created :  Oct. 2003
#
# Cared for by Shuai Weng <shuai@genome.stanford.edu>
#
# You may distribute this module under the same terms as perl itself
#######################################################################

=pod

=head1 NAME

GO::View::GD - a helper class for GO::View to deal with the image

=head1 SYNOPSIS

use GO::View::GD;

To instantiate a new InitGD object, you may use  
following syntax:

    my $gd = GO::Util::InitGD->new(width=>$imgWidth,
                                   height=>$imgHeight);               


my $im = $gd->im;
my $white = $gd->white;
my $red = $gd->red;

and more ......     

=cut

use strict;
use GD;

use vars qw ($PACKAGE $VERSION);

$PACKAGE = "GO::View::GD";
$VERSION = 0.1;

#######################################################################
sub new {      ############ constructor ###############################
#######################################################################

=head2 new

  Title    : new
  Function : Creates a new GO::View::GD object
           : recognized named parameters are height and width
             both of which must be provided.
  Returns  : a GO::View::GD object
  Args     : the named parameters

=cut
       
    my ($self, %args) = @_;

    $self = {};
    bless $self;
    
    if (!$args{'width'} || !$args{'height'}) {

	die "The image width and height must be passed to $PACKAGE.";
	
    }

    $self->{'_im'} = new GD::Image($args{'width'}, $args{'height'});

    $self->{'_width'} = $args{'width'};
    $self->{'_height'} = $args{'height'};

    $self->_initColors;

    return $self;
}

#######################################################################
sub _initColors {
#######################################################################
# This private method simply initializes some colors, and stores them within
# the object for subsequent retrieval

    my ($self) = @_;

    $self->{'_white'}  = $self->im->colorAllocate(255, 255, 255);
    $self->{'_white1'} = $self->im->colorAllocate(254, 254, 254);
    
    $self->{'_black'} = $self->im->colorAllocate(0, 0, 0);

    $self->{'_blue'}  = $self->im->colorAllocate(0, 0, 255);
    $self->{'_blue1'} = $self->im->colorAllocate(0, 0, 125);
    $self->{'_blue2'} = $self->im->colorAllocate(0, 255, 255);
    $self->{'_blue3'} = $self->im->colorAllocate(0, 204, 204);
    $self->{'_blue4'} = $self->im->colorAllocate(80, 153, 255);
    $self->{'_blue5'} = $self->im->colorAllocate(128, 156, 201);

    $self->{'_lightBlue'} = $self->im->colorAllocate(127, 255, 255);
    $self->{'_darkBlue'} = $self->im->colorAllocate(10, 80, 161);
    
    $self->{'_darkGreen'} = $self->im->colorAllocate(47, 79, 47);
    $self->{'_green'}     = $self->im->colorAllocate(0, 255, 0);
    $self->{'_green1'}    = $self->im->colorAllocate(51, 160, 44);
    $self->{'_green2'}    = $self->im->colorAllocate(102, 255, 102);
    $self->{'_green3'}    = $self->im->colorAllocate(153, 212, 127);
    $self->{'_green4'}    = $self->im->colorAllocate(0, 255, 51);
    $self->{'_green5'}    = $self->im->colorAllocate(102, 153, 102);


    $self->{'_grey'}      = $self->im->colorAllocate(180, 180, 180);
    $self->{'_darkGrey'}  = $self->im->colorAllocate(102, 102, 102);
    $self->{'_lightGrey'} = $self->im->colorAllocate(215, 215, 215);

    $self->{'_magenta'}  = $self->im->colorAllocate(255, 0, 255);
    $self->{'_magenta1'} = $self->im->colorAllocate(255, 153, 255);
    $self->{'_magenta2'} = $self->im->colorAllocate(127, 0, 255);
    $self->{'_magenta3'} = $self->im->colorAllocate(204, 50, 153);
    $self->{'_magenta4'} = $self->im->colorAllocate(188, 128, 189);
    $self->{'_magenta5'} = $self->im->colorAllocate(129, 23, 136);
    

    $self->{'_maroon'} = $self->im->colorAllocate(142, 35, 107);

    $self->{'_orange'}  = $self->im->colorAllocate(255, 175, 0);
    $self->{'_orange1'} = $self->im->colorAllocate(255, 125, 0);
    
    $self->{'_red'}  = $self->im->colorAllocate(255, 0, 0);
    $self->{'_red1'} = $self->im->colorAllocate(255, 152, 153);
    $self->{'_red2'} = $self->im->colorAllocate(204, 0, 102);
    $self->{'_red3'} = $self->im->colorAllocate(153, 0, 0);
    $self->{'_red4'} = $self->im->colorAllocate(251, 128, 95);

    $self->{'_tan1'} = $self->im->colorAllocate(252, 192, 167);
    $self->{'_tan'}  = $self->im->colorAllocate(235, 199, 158);

    $self->{'_yellow'}  = $self->im->colorAllocate(255, 255, 0);
    $self->{'_yellow1'} = $self->im->colorAllocate(255, 204, 51);
    $self->{'_yellow2'} = $self->im->colorAllocate(255, 204, 102);
    $self->{'_yellow3'} = $self->im->colorAllocate(255, 204, 153);

    $self->{'_chartreuse'} = $self->im->colorAllocate(204, 236, 244);

    $self->{'_cenColor'} = $self->im->colorAllocate(0, 10, 10);
    
    $self->{'_sagecolor1'} = $self->im->colorAllocate(255, 127, 0);
    $self->{'_sagecolor2'} = $self->im->colorAllocate(127, 0, 255);
    $self->{'_sagecolor3'} = $self->im->colorAllocate(207, 181, 59);
    $self->{'_sagecolor4'} = $self->im->colorAllocate(204, 50, 153);

   
}

sub im { 

=head2 im

This method returns the internal GD::Image object

=cut

    $_[0]->{'_im'};

}

sub height {

=head2 height

This method returns the height that was used to instantiate the object

=cut

    $_[0]->{'_height'}; 

}

sub width {

=head2 width

This method returns the width that was used to instantiate the object

=cut

    $_[0]->{'_width'};

}

sub white1 { $_[0]->{'_white1'} }
sub black  { $_[0]->{'_black'} }

sub blue  { $_[0]->{'_blue'} }
sub blue1 { $_[0]->{'_blue1'} }
sub blue2 { $_[0]->{'_blue2'} }
sub blue3 { $_[0]->{'_blue3'} }
sub blue4 { $_[0]->{'_blue4'} }
sub blue5 { $_[0]->{'_blue5'} }

sub lightBlue { $_[0]->{'_lightBlue'} }
sub darkBlue  { $_[0]->{'_darkBlue'} }

sub darkGreen { $_[0]->{'_darkGreen'} }
sub green     { $_[0]->{'_green'} }
sub green1    { $_[0]->{'_green1'} }
sub green2    { $_[0]->{'_green2'} }
sub green3    { $_[0]->{'_green3'} }
sub green4    { $_[0]->{'_green4'} }
sub green5    { $_[0]->{'_green5'} }

sub grey      { $_[0]->{'_grey'} }
sub darkGrey  { $_[0]->{'_darkGrey'} }
sub lightGrey { $_[0]->{'_lightGrey'} }

sub magenta  { $_[0]->{'_magenta'} }
sub magenta1 { $_[0]->{'_magenta1'} }
sub magenta2 { $_[0]->{'_magenta2'} }
sub magenta3 { $_[0]->{'_magenta3'} }
sub magenta4 { $_[0]->{'_magenta4'} }
sub magenta5 { $_[0]->{'_magenta5'} }

sub maroon   { $_[0]->{'_maroon'} }

sub orange  { $_[0]->{'_orange'} }
sub orange1 { $_[0]->{'_orange1'} }


sub red  { $_[0]->{'_red'} }
sub red1 { $_[0]->{'_red1'} }
sub red2 { $_[0]->{'_red2'} }
sub red3 { $_[0]->{'_red3'} }
sub red4 { $_[0]->{'_red4'} }

sub tan  { $_[0]->{'_tan'} }
sub tan1 { $_[0]->{'_tan1'} }

sub white { $_[0]->{'_white'} }

sub yellow  { $_[0]->{'_yellow'} }
sub yellow1 { $_[0]->{'_yellow1'} }
sub yellow2 { $_[0]->{'_yellow2'} }
sub yellow3 { $_[0]->{'_yellow3'} }

sub chartreuse { $_[0]->{'_chartreuse'} }

sub cenColor { $_[0]->{'_cenColor'} }

sub sagecolor1 { $_[0]->{'_sagecolor1'} }
sub sagecolor2 { $_[0]->{'_sagecolor2'} }
sub sagecolor3 { $_[0]->{'_sagecolor3'} }
sub sagecolor4 { $_[0]->{'_sagecolor4'} }

######################################################################
sub drawFrameWithLabelAndDate { 
######################################################################

=head2 drawFrameWithLabelAndDate

This method draws a blue frame around the image with date at the right
bottom corner and image label on the left bottom corner if there is a
label passed in.  The date and label will be printed in red

Usage:

   $gd->drawFrameWithLabelAndDate;

Optional arguments:

'date', which is a string indicating the date, otherwise the current
date will be determineed and used.  The date will be printed in red in
the lower right hand corner.

'text', which is a string that can be used to label the image.  This will 
printed in the lower left hand corner of the image.

=cut

    my ($self, %args) = @_;

    my $date = $args{'date'};
    
    $self->im->rectangle(0, 0, $self->width - 1, $self->height - 1, $self->blue);

    if (!$date) {

	$date = localtime; # gives us something like : Wed Dec  3 14:52:53 2003

	# now grab the month, day, and year, and reformat

	$date =~ s/^[^ ]+ +([^ ]+) +([0-9]+) .+ ([0-9]+)$/$1 $2\, $3/;

    }

    if ($args{'text'}) { 

	$self->im->string(gdSmallFont, 5, $self->height-15, $args{'text'}, $self->red);

    }

    $self->im->string(gdSmallFont, $self->width - length($date) * 6-10, 
		      $self->height-15, $date, $self->red);	

}

######################################################################
sub drawBar {
######################################################################

=head2 drawBar

This method draws a rectangle for a given coordinate set and creates a
link for the box if there is a linkUrl passed in.  The link for the
box is in the form of text that can be placed in an image map on an
html page.  The text for that is currently printed to STDOUT.

Usage:

  $gd->drawBar(barColor=>$gd->blue,
	       numX1=>$X1,
	       numX2=>$X2,
	       numY=>$Y,
	       linkUrl=>$linkUrl,
	       barHeight=>$barHeight,
	       outline=>1,
	       arrow=>'up');

Required Arguments:

barColor     : The color of the box
numX1        : The left-hand x-coordinate of the box
numX2        : The right-hand x-coordinate of the box
numY         : The top y coorinate of the box

Optional Arguments:

strand       : ??? - left over from use in SGDs ORF Map
linkUrl      : A url to which you would like the box to be linked
barHeight    : The height of the box - will be used to determine the bottom
               y-coordinate of the box - default is 4 pixels
outlineColor : The color in which to outline the box
onInfoText   : Information text that can used for mouseovers

arrow        : The type of arrowhead desired on the box.  One of up, down,
               left, right, which indicates the direction in which the arrow
               head should point
arrowHeight  : The height of the arrowhead

=cut

    my ($self, %args) = @_;

    my $barColor = $args{'barColor'} || $self->_handleMissingArgument('barColor'); 
    my $numX1    = $args{'numX1'}    || $self->_handleMissingArgument('numX1');
    my $numX2    = $args{'numX2'}    || $self->_handleMissingArgument('numX2');
    my $numY     = $args{'numY'}     || $self->__handleMissingArgument('numY'); 

    my $linkUrl      = $args{'linkUrl'};
    my $strand       = $args{'strand'};
    my $barHeight    = $args{'barHeight'} || '4';
    my $outlineColor = $args{'outlineColor'};
    my $onInfoText   = $args{'onInfoText'};
    my $arrow        = $args{'arrow'};
    my $arrowHeight  = $args{'arrowHeight'};
    
    my $numY1 = $numY;
    my $numY2 = $numY1 + $barHeight;
    
    $self->_drawBarWithLink($numX1, $numY1, $numX2, $numY2, 
			    $barColor, $linkUrl, $strand, 
			    $onInfoText, $outlineColor);

    if ($arrow) {
	my ($X1, $Y1, $X2, $Y2);
	if ($arrow =~ /up/i) {
	    $X1 = $numX1;
	    $Y1 = $numY1;
	    $X2 = $numX2;
	    $Y2 = $Y1;
	}
	elsif ($arrow =~ /down/i) {
	    $X1 = $numX1;
	    $Y1 = $numY2;
	    $X2 = $numX2;
	    $Y2 = $Y1;
	}
	elsif ($arrow =~ /left/) {
	    $X1 = $numX1;
	    $Y1 = $numY1;
	    $X2 = $X1;
	    $Y2 = $numY2;
	}
	else {
	    $X1 = $numX2;
	    $Y1 = $numY1;
	    $X2 = $X1;
	    $Y2 = $numY2;
	}
	$self->_drawTriangle($barColor, $X1, $Y1, 
			     $X2, $Y1, $arrow, $arrowHeight);
    }

    return $numX2+5; 
    
}


######################################################################
sub drawName {
######################################################################

=head2 drawName

This method draws a string and creates a link for it if there is a
linkUrl passed in.  The link is in the form of text that can be placed
in an image map on an html page.  The text for that is currently
printed to STDOUT.

Usage:

    $gd->drawName(name=>" = GO term with child(ren)",
		  nameColor=>$gd->black,  
		  numX1=>$numX1,
		  numY=>$y-2);

Required Arguments:

name      : The text that should be printed on the image
nameColor : The color in which the text should be written
numX1     : The X-coordinate where the text should be printed
numY      : The Y-coordinate where the text should be printed

Optional Arguments

linkUrl : A url to which you would like the text to be linked

=cut
 
    my ($self, %args) = @_;

    my $name      = $args{'name'}      || $self->_handleMissingArgument('name'); 
    my $nameColor = $args{'nameColor'} || $self->_handleMissingArgument('nameColor');
    my $numX1     = $args{'numX1'}     || $self->_handleMissingArgument('numX1');
    my $numY      = $args{'numY'}      || $self->_handleMissingArgument('numY'); 
    my $linkUrl   = $args{'linkUrl'};
        
    $self->_drawNameWithLink($name, $nameColor,
			     $linkUrl, $numX1, 
			     $numX1+length($name)*6, 
			     $numY, $numY+8);
   
    
    return $numX1+length($name)*6; 
    
}

################################################################
sub imageMap{
################################################################

=head2 imageMap

 Title    : imageMap
 Usage    : my $map = $goView->imageMap;
 Function : returns the text that constitutes an image map for the
            created image.

	    During creation of various glyphs, that have had a URL
	    passed in to which they could link, text that can be used
	    as an image map for the image, within a web page, will be
	    generated.  When all glyphs have been added to the image,
	    you can retrieve the image map text.  It then needs to be
	    wrapped in a <MAP>...</MAP> declaration, and the html that
	    displays the image will need to refer to the image, eg:

	    <MAP NAME='blah'>

	    _IMAGE_MAP_TEXT_HERE_

	    </MAP>
	    <img src='http::/some.url.here/xxx/gif' usemap='#blah'>

	    Note that the map and the usemap tag have the same name.

 Returns  : a string

=cut

#########################################################################

    return $_[0]->{IMAGE_MAP};

}

################################################################
sub _appendToMap{
################################################################

=head2 _appendToMap

This protected method appends the passed in string onto the image
map that is generated for the image that is also created by this
module

Usage:

    $self->_appendToMap($text);

=cut

################################################################

    my ($self, $text) = @_;

    $self->{IMAGE_MAP} .= $text if defined $text;
    
}


#####################################################################
sub _drawTriangle {
#####################################################################
# This method draws a triangle based on the given coordinate set.
#
    my ($self, $color, $numX1, $numY1, $numX2, $numY2, 
	$arrow, $height) = @_;

    if (!$height) {
	if ($arrow =~ /(up|down)/i) {
	    $height = $numX2 - $numX1;
	}
	else {
	    $height = $numY2 - $numY1; 
        }
    }
    my ($numX, $numY, $midX, $midY);
    if ($arrow =~ /up/i) {
	$numX = ($numX1 + $numX2)/2;
	$numY = ($numY1 + $numY2)/2 - $height;
	$midX = $numX;
	$midY = $numY + $height/2;
    }
    elsif ($arrow =~ /down/i) {
	$numX = ($numX1 + $numX2)/2;
	$numY = ($numY1 + $numY2)/2 + $height;
	$midX = $numX;
	$midY = $numY - $height/2;
    }
    elsif ($arrow =~ /left/i) {
	$numX = ($numX1 + $numX2)/2 - $height;
	$numY = ($numY1 + $numY2)/2;
	$midX = $numX - $height/2;
	$midY = $numY;
    }
    else {
	$numX = ($numX1 + $numX2)/2 + $height;
	$numY = ($numY1 + $numY2)/2;
	$midX = $numX + $height/2;
	$midY = $numY;
    }

    $self->im->line($numX1, $numY1, $numX2, $numY2, $color);
    $self->im->line($numX1, $numY1, $numX,  $numY,  $color);
    $self->im->line($numX2, $numY2, $numX,  $numY,  $color);

    $self->im->fillToBorder($midX, $midY, $color, $color);
    
}

######################################################################
sub _drawBarWithLink {
######################################################################
# This method draws a box (bar) with a link.

    my ($self, $numX1, $numY1, $numX2, $numY2, $barColor, 
	$linkUrl, $strand, $onInfoText, $outlineColor) = @_;

    $onInfoText ||= ""; # avoid warnings
    
    if (!$strand) {

	$self->im->filledRectangle($numX1, $numY1, $numX2, $numY2, 
			   $barColor);

	if ($outlineColor) {
	   $self->im->rectangle($numX1, $numY1, $numX2, $numY2, 
			      $outlineColor); 
	}

    }else {

	if (!$outlineColor) { $outlineColor = $barColor; }

	my $midY = ($numY1+$numY2)/2;

	if ($numX2 < $numX1 + 6) {
	    $numX2 = $numX1 + 6;
	}

        if ($strand =~ /^W/i || $strand == 1) {

	    $numX2 -= 4;
	    $self->im->line($numX1, $numY1, $numX1, $numY2, $outlineColor);
	    $self->im->line($numX2, $numY1, $numX2+4, $midY, $outlineColor);
	    $self->im->line($numX2, $numY2, $numX2+4, $midY, $outlineColor);

	}else {

	    $numX1 += 4;
	    $self->im->line($numX2, $numY1, $numX2, $numY2, $outlineColor);
	    $self->im->line($numX1, $numY1, $numX1-4, $midY, $outlineColor);
	    $self->im->line($numX1, $numY2, $numX1-4, $midY, $outlineColor);
	}

	$self->im->line($numX1, $numY1, $numX2, $numY1, $outlineColor);
	$self->im->line($numX1, $numY2, $numX2, $numY2, $outlineColor);	    
	
	$self->im->fillToBorder(($numX1+$numX2)/2, $midY, 
				$outlineColor, $barColor);
	
    }

    if ($linkUrl) {	
	$numX1 = int($numX1);
	$numX2 = int($numX2);
	$numY1 = int($numY1);
	$numY2 = int($numY2);
	$self->_appendToMap("<AREA SHAPE='RECT' COORDS='$numX1,$numY1,$numX2,$numY2' HREF='$linkUrl' title=\"$onInfoText\">\n");	
    }
}

######################################################################
sub _drawNameWithLink {
######################################################################
# This method draws a string with a link.

    my ($self, $name, $nameColor, $linkUrl, $nX1, $nX2, $nY1, $nY2) = @_;

    $self->im->string(gdSmallFont, $nX1, $nY1, $name, $nameColor);

    if ($linkUrl) {
	$nX1 = int($nX1);
	$nX2 = int($nX2);
	$nY1 = int($nY1);
	$nY2 = int($nY2);
	$self->_appendToMap("<AREA SHAPE=\"RECT\" COORDS=\"$nX1,$nY1,$nX2,$nY2\" HREF=\"$linkUrl\">\n");
    }
}


######################################################################
sub _handleMissingArgument {
######################################################################
# This method will die, with a message to indicate which argument is
# missing in which method, etc. if it finds a missing argument.
#

    my ($self, $args) = @_;

    my ($file, $line, $method) = (caller(1))[1..3];

    die "The argument '$args' must be passed to '$method' method.\n".

	"Please add this argument to line $line in $file."; 

}

1; # to keep Perl happy

=pod

=head1 AUTHOR

Shuai Weng (shuai@genome.stanford.edu)

=cut









