#
# Lukas Mueller, July 2004.
#

=head1 Name
    
    cview.pm - a collection of objects to draw chromosomes.

=head1 Synopsis

 my $dbh = DBI -> connect("dbi:mysql:host=localhost;database=sgn", "web_usr", "tomato");

 my $map = map_image -> new($dbh, 500, 600);

 my $chr1 = chromosome -> new(1,550,100,20);
 cview_sql::fetch_chromosome($dbh, $chr1, 1,1);
 $chr1 -> set_labels_left();
 $chr1 -> set_display_marker_offset();
 $chr1-> set_hilite(50, 100);
 $map->add_chromosome($chr1);

 my @m1 = $chr1 -> get_markers();

 for (my $i=0; $i<@m1; $i++) {
    
    #$m1[$i]->hide();
    $m1[$i]->hide_label();
    if ($i % 5 ==0) { 
	$m1[$i]->hilite(); $m1[$i]->show_label();
    }
 } 

 # adding a ruler
 #
 my $ruler = ruler -> new (200, 20, 550, 0, $chr1->get_chromosome_length());
 $ruler -> set_labels_right();
 $map -> add_ruler($ruler);
 
 # adding a physical map
 #
 my $physical = physical -> new(1, 550, 300, 20);
 cview_sql::fetch_chromosome($dbh, $physical, 1, 1);
 cview_sql::fetch_physical($dbh, $physical, 1, 1);
 $map -> add_physical($physical);

 # rendering the image
 #
 $map -> render_jpg();

=head1 Author

Lukas Mueller lam97@cornell.edu

=head1 cview package objects

The cview package defines several objects:
1) A map_image object that is like a canvas to draw other objects on
2) A chromosome object that contains chromosome information, such as markers and links between chromosomes
3) A marker object that contains the marker information
4) A chr_link object that stores information about markers that are linked on different chromosomes
5) A ruler object that draws a ruler
6) A physical object, which inherits from chromosome and draws a physical map.
7) A IL object, which inherits from chromosome, and draws an IL map.

These objects can be placed on the map_image at will and will know how to render themselves.

=cut

use strict;
use GD;


1;

package cview;

=head1 map_image object
    
=cut
    
package map_image;

=head2 map_image::new
    
map_image -> new(map name, map_width [pixels], map_height [pixels])
    
Creates a new map object.

=cut

sub new { 
    my $class = shift;
    my $map_name = shift;
    my $width = shift;  # the image width in pixels
    my $height = shift; # the image height in pixels
    
    my $args = {};
    
    $args -> {image} = new GD::Image($width, $height);
    $args -> {chromosomes} = ();
    $args -> {chr_links} = ();
    $args -> {width} = $width;
    $args -> {height} = $height;
    
    return bless $args, $class;
}

=head2 render()

$map -> render()   # takes no parameters

renders the map on the internal image.

=cut

sub render {
    my $self = shift;
    # the first color allocated is the background color.
    $self->{white} = $self->{image}->colorResolve(255,255,255);
    $self->{image}->filledRectangle(0,0 ,$self->{width}, $self->{height}, $self->{white});

    foreach my $c (@{$self->{chromosomes}}) {
	$c -> render($self->{image});
    }
    foreach my $l (@{$self->{chr_links}}) {
	$l -> render($self->{image});
    }
    foreach my $r (@{$self->{rulers}}) {
	$r -> render($self->{image});
    }
    foreach my $p (@{$self->{physical}}) {
	$p -> render($self->{image});
    }
}

=head2 render_png()

$map->render_png(); # no parameters

renders the image as a png to STDOUT.

=cut

sub render_png {
    my $self= shift;
    $self->render();
    print $self->{image}->png();
}

=head2 render_png_file()

    $map->render_png_file ($filepath)

render the image as a png saving the image at $filepath.

=cut

sub render_png_file {
    my $self = shift;
    my $filename = shift;
    $self -> render();
    open (F, ">$filename") || die "Can't open $filename for writing!!! Check write permission in dest directory.";
    print F $self->{image}->png();
    close(F);
}

=head2 render_jpg

    $map->render_jpg()

renders the image as a jpg to STDOUT.

=cut


sub render_jpg {
    my $self = shift;
    $self->render();
    print $self->{image}->jpeg();
}    

=head2 render_jpg_file

    $map->render_jpg_file(filepath)

renders the image as a jpg file at filepath

=cut

sub render_jpg_file {
    my $self = shift;
    my $filename = shift;
    #print STDERR "cview.pm: render_jpg_file.\n";
    $self ->render();
    #print STDERR "rendering. Now writing file..\n";
    open (F, ">$filename") || die "Can't open $filename for writing!!! Check write permission in dest directory.";
    print F $self->{image}->jpeg();
    close(F);
    #print STDERR "done...\n";
}

=head2 get_image_map

    $string = $map->get_image_map()

Get the image map as a string. Calls get_image_map for all the objects contained in the map_image.

=cut 

sub get_image_map {
    my $self = shift;
    my $map_name = shift;
    #print STDERR "get_image_map map\n";
    my $imagemap = "<MAP name=\"$map_name\">";
    foreach my $c (@{$self->{chromosomes}}) {
	#print STDERR "getting the chromosome image maps...\n";
	$imagemap .= $c -> get_image_map();
    }
    foreach my $p (@{$self->{physical}}) {
	$imagemap .= $p -> get_image_map();
    }
    return $imagemap."</MAP>";
}

=head2 add_chromosome

$map->add_chromosome($chromosome_object)

adds the chromosome object to the map. Obviously works also for subclasses of chromosomes such as physical and IL. 

=cut

sub add_chromosome {
    my $self = shift;
    my $chromosome = shift;
   
    push @{$self->{chromosomes}}, $chromosome;
}

=head2 add_chr_link

$map->add_chr_link($chr_link)

adds the chromosome linking object $chr_link to the map.

=cut

sub add_chr_link {
    my $self = shift;
    my $chr_link = shift;
    push @{$self->{chr_links}}, $chr_link;
}

=head2 add_ruler

$map->add_ruler($ruler)

adds the ruler $ruler to the map.

=cut 
 
sub add_ruler {
    my $self = shift;
    my $ruler = shift;
    push @{$self->{rulers}}, $ruler;
}

=head2 add_physical

$map->add_physical($physical)

adds the physical map $physical to the map. 

Note: The physical object has to be populated both in terms of marker positions and physical map.

=cut

sub add_physical {
    my $self = shift;
    my $physical = shift;
    push @{$self->{physical}}, $physical;
}


=head1 chromosome object

=cut

package chromosome;

=head2 new

my $c = chromosome -> new( chr number, height in pixels, horizontal offset, vertical offset, [start cM], [end cM])

Creates a new chromosome object. The horizontal offset denotes the offset of the chromosome mid-line. The vertical offset defines the upper end of the chromosome. Note that some renditions of the chromosome will add round edges on the top and on the bottom, so that the rounded top position will be smaller than the vertical offset.

Optionally, start_cM and end_cM can be supplied, which will set the start and end in cM for a chromosome section. The chromosome will be rendered as a section, i.e, the ends will be flat instead of rounded.

=cut

sub new {
    my $class = shift;

    my $args = {};

    $args -> {chr_nr} = shift; # used for display purposes
    $args -> {height} = shift;
    $args -> {x} = shift; # the horizontal offset of the chromosome
    $args -> {y} = shift; # the vertical offset of the chromosome
    $args -> {start_cM} = shift; # if a chromosome section, where the section starts, in cM
    $args -> {end_cM} = shift; # if a chromosome section, where the section ends, in cM
    
    $args -> {markers} = ();    

    $args -> {label_side} = "right";
    $args -> {width} = 20; # default width
    $args -> {curved_height} = $args->{width};
    my $self = bless $args, $class;
    
    $self -> {font} = GD::Font->Small();
    # set default colors
    $self -> set_color(200, 150, 150);
    $self -> set_hilite_color(255, 255, 0);
    $self -> set_outline_color(0,0,0);
    $self -> set_hide_marker_offset();
    return $self;
}

=head2 set_height

    $chr->set_height($height)

Sets the height of the chromosome in pixels. Recalculates all the scaling information.

=cut

sub set_height {
    my $self= shift;
    $self->{height}= shift;
    $self->layout();
}

=head2 get_height

    $height = $chr ->get_height()

Gets the height of the chromosome in pixels.

=cut

sub get_height {
    my $self = shift;
    return $self->{height};
}

=head2 set_length

sets the length in map units [cM].

This can also be automatically determined if not set manually, to the offset of the marker with the highest map unit value.

=cut 

    
sub set_length {
    my $self=shift;
    $self->{chromosome_length_cM}=shift;
}

=head2 get_length 

gets the length of the chromosome in map units.

=cut 

sub get_length {
    my $self=shift;
    
    return $self->{chromosome_length_cM};
}


=head2 set_section

    $chr->set_section($start_in_map_units, $end_in_map_units);

Defines the chromosome as a section. The section starts at the start coordinate in map units, and ends at the end coordinate in map units. Chromosomes that are sections are rendered differently than full chromosomes. The section will be rendered so that it fills the entire height of the chromosome as defined with new or set_height, and the top edge will be drawn at the horizontal and vertical offset defined in the new call or with set_horizonatal_offset and set_vertical_offset.

=cut 

    

sub set_section {
    my $self = shift;
    $self -> {start_cM} = shift;
    $self -> {end_cM} = shift;
    $self -> {is_section} =1;
}

=head2 get_section

    $flag = $chr->is_section()

Returns true if the chromosome $chr is a section. 

=cut

sub is_section {
    my $self = shift;
    return $self -> {is_section};
}

=head2 set_hilite

$chr->set_hilite(start_coord, end_coord)

Highlights the region of the chromosome between start_coord and end_coord with the hilite_color (which can be set with set_hilite_color, see below).

=cut

sub set_hilite { 
    my $self = shift;
    $self->{hilite_start}=shift;
    $self->{hilite_end}=shift;
}

=head2 set_hilite_color

$chr->set_hilite($red_channel, $green_channel, $blue_channel)

Sets the hilite color for chromosome highlighting. Three values between 0 and 255 are required for defining red, green and blue channels. The default color is yellow (255, 255,0)

=cut

sub set_hilite_color {
    my $self = shift;
    $self->{hilite_color}[0]=shift;
    $self->{hilite_color}[1]=shift;
    $self->{hilite_color}[2]=shift;
}

=head2 set_color

Sets the chromosome fill color. Three values between 0 and 255 are required for defining red, green and blue channels. The default color is 200, 100, 100, which is a light red.

=cut

sub set_color {
    my $self = shift;
    $self->{color}[0]=shift;
    $self->{color}[1]=shift;
    $self->{color}[2]=shift;
}

=head2 set_color

Sets the chromosome outline color. Three values between 0 and 255 are required for defining red, green and blue channels. The default color is 0,0,0, which is black.

=cut

sub set_outline_color {
    my $self = shift;
    $self->{outline_color}[0]=shift;
    $self->{outline_color}[1]=shift;
    $self->{outline_color}[2]=shift;
}

=head2 set_url

Sets the url for the hyperlink for the chromosome if it is clicked.

=cut


sub set_url {
    my $self = shift;
    $self->{url} = shift;
}

sub get_url {
    my $self = shift;
    return $self->{url};
}

=head2 set_width

Sets the width of the chromosome in pixels

=cut

sub set_width {
    my $self = shift;
    $self->{width}=shift;
}

=head2 set_caption

Sets the caption of the chromosome. The caption will be drawn centered on the top of the chromosome. Usually, the chromosome number should be displayed.

=cut


sub set_caption {
    my $self = shift;
    $self->{caption}=shift;
}

sub get_caption {
    my $self = shift;
    return $self->{caption};
}

=head2 set_labels_left

Causes the labels to be displayed on the left side of the chromosome.

=cut 

sub set_labels_left {
    my $self = shift;
    $self->{label_side} = "left";
}

=head2 set_labels_right

Causes the labels to be displayed on the right side of the chromosome.

=cut 

sub set_labels_right {
    my $self = shift;
    $self->{label_side} = "right";
}

=head2 set_labels_none

Causes the labels not to be displayed for the whole chromosome.

=cut

sub set_labels_none {
    my $self = shift;
    $self -> {label_side} = "";
}

sub get_width {
    my $self = shift;
    return $self ->{width};
}

=head2 set_display_marker_offset

Causes the marker offsets to be displayed on the opposite side of the labels.

=cut

sub set_display_marker_offset {
    #
    # is set, the marker offset in cM will be displayed on the opposite side of the label
    #
    my $self = shift;
    $self -> {display_marker_offset} = 1;
}

sub set_hide_marker_offset {
    my $self = shift;
    $self -> {display_marker_offset} = 0;
}

=head2 render

    $chr-> render($image);

This function is called to render the chromosome and recursively calls all the rendering functions of the objects it contains. The image parameter is an GD image object. Usually, you should not have to call this function, but the map_image object calls this function for you if you render a map.

=cut

sub render { 
    my $self = shift;
    my $image = shift;
    
    $self -> _calculate_scaling_factor();

    $self -> _distribute_labels();

    $self -> draw_chromosome($image);
    foreach my $m (@{$self->{markers}}) {
	$m -> render($image);
    }
}

sub get_enclosing_rect {
    my $self = shift;
    return (int($self->{x}-$self->get_width()/2), $self->{y}, $self->{x}+int($self->get_width()/2), $self->{y}+$self->{height});
}

=head2 get_image_map

Gets the image map for the chromosome and all contained objects within chromosome. This is normally called by the map_image object.

=cut 

sub get_image_map {
    my $self = shift;
    my $coords = join ",", ($self -> get_enclosing_rect());
    my $string = "";;
    #print STDERR "get_image_map chromosome\n";
    if ($self->get_url()) {  $string =  "<AREA name=".$self->{chr_nr}." shape=\"rect\" coords=\"".$coords."\" href=\"".$self->get_url()."\">";}
    foreach my $m (($self->get_markers())) {
	$string .= $m -> get_image_map();
    }
    return $string;
    
}

sub _sort_markers {
    my $self=shift;

}

sub _calculate_scaling_factor {
    my $self = shift;    

    $self -> _calculate_chromosome_length(); 
    
    if ($self->get_length()==0) { return 0; }
    
    $self->{scaling_factor}=($self->{height}/$self->get_length());
    
    #print STDERR "calculating scaling factor. height in pixels: $self->{height} chromosome_length=$self->{chromosome_length_cM} scaling factor: $self->{scaling_factor}\n";
    
    return $self->{scaling_factor};
}

sub get_scaling_factor {
    my $self = shift;
    return $self->{scaling_factor};
}

=head2 add_marker
    
    $chr->add_marker($m);

Adds the marker object $m to the chromosome.
    
=cut
    
sub add_marker {
    my $self = shift;
    my $m = shift;
    push @{$self->{markers}}, $m;
}

=head2 get_markers

    my @m = $chr -> get_markers();

Gets all the markers in the chromosome as an array.

=cut

sub get_markers {
    my $self = shift;
    if (!defined($self->{markers})) { return (); }
    return @{$self->{markers}};
}

sub get_markers_in_interval {
    my $self = shift;
    my $start = shift;  # start in cM
    my $end = shift;    # end position in cM
    if (!$start && !$end) { $start = 0; $end = $self -> get_length()+1 ; }
    my @markers;
    foreach my $m (@{$self->{markers}}) {
	if ($m -> get_offset() >= $start && $m->get_offset() <= $end) {
	    push @markers, $m;
	}
    }
    return @markers;    # returns all the markers in between start and end
}

sub get_frame_markers {
    my $self = shift;
    my @framemarkers = ();
    foreach my $m (@{$self->{markers}}) { 
	if ($m->is_frame_marker()) { 
	    push @framemarkers, $m;
	}
    }
    return @framemarkers;
}

sub get_markers_ref {
    my $self = shift;
    return \@{$self->{markers}};
}

sub layout { 
    my $self = shift;
    $self->_calculate_chromosome_length();
    $self->_calculate_scaling_factor();
}

sub _calculate_chromosome_length {
    my $self = shift;
    my $length = 0;
    
    # get chromosome length in cM.
    # 
    # if it is a section, we return the length of the section, as defined by start_cM and end_cM
    #
    if (defined($self->{start_cM}) || defined($self->{end_cM})) {
	if ($self->{end_cM}>$self->{chromosome_length_cM}) { 
	    $self->{end_cM}=$self->{chromosome_length_cM};
	}
	$self->{chromosome_length_cM}=$self->{end_cM}-$self->{start_cM};
	return $self->{chromosome_length_cM};
    }
    
    # it may be that chromosome_length has been manually set with set_length.                              .
    #
    if ($self->get_length()) {
	return $self->get_length();
    }
    # otherwise, we get the marker with the highest cM position.
    # the length may have been set already by set_length...
    foreach my $m (@{$self->{markers}}) {
	my $offset = $m -> get_offset();
	if ($offset > $length) { $length = $offset; }
    }
    $self->{chromosome_length_cM} = $length;
    
    return $self->{chromosome_length_cM};
}

sub get_chromosome_length {
    # same as get_length. Deprecated.
    my $self = shift;
    return $self->{chromosome_length_cM};
}

=head2 get_cM_pixels

    my $pixels = $chr->get_cM_pixels($cM_pos);

Gets the number of pixels the cM value corresponds to. Note that you have to add the vertical chromosome offset (get_vertical_offset) to this number the get the actual image coordinates.

=cut


sub get_cM_pixels {
    my $self = shift;
    my $cM = shift;

    my $pixels = ($cM - $self->{start_cM}) * $self->{scaling_factor};
        #print STDERR "Scaling factor: $self->{scaling_factor} cM: $cM = $pixels pixels\n";
    return $pixels;
}

=head2 get_pixels_cM 

    my $cM = $chr->get_pixels_cM($pixels);

Gets the number of cM that the number of $pixels correspond to. Note that you have to substract the vertical chromosome offset (get_vertical_offset) from the pixels this number the get the correct number of cM.

=cut

sub get_pixels_cM {
    my $self = shift;
    my $pixels = shift;
    my $cM = ($pixels / $self->{scaling_factor}) + $self->{start_cM};
}

=head2 get_vertical_offset

Returns the vertical offset of the chromosome. Defines the upper limit of the chromosome. Certain chromosome renditions will add a round edge on the top that will extend the chromomsome beyond that value.

=cut 

sub get_vertical_offset {
    my $self = shift;
    return $self->{y};
}

sub get_horizontal_offset {
    my $self = shift;
    return $self->{x};
}



sub is_visible {
    my $self = shift;
    my $cM = shift;

    if ($self->is_section()) {
	if ($cM >= $self->{start_cM} && $cM <= $self ->{end_cM}) {
	    return 1;
	}
	else {return 0; }
    }
    return 1;
}

sub _distribute_labels_old {
     my $self = shift;
     
     my @m = $self->get_markers();
     my $lastlabelpos = 0;
     foreach my $m (@m) {
	 my $cM= $m->get_offset();
	 my $labelpos = $self->get_cM_pixels($cM)+$self->{y};
	 my $labelheight = $m -> get_label_height();
	 #print STDERR "label height: $labelheight\n";
	 if ($m->is_visible() && $m->is_label_visible()) {
	     if (($labelpos-$labelheight)<$lastlabelpos) { 
		 $labelpos = $lastlabelpos+$labelheight;
		 $m->set_label_pos($labelpos);
	     }
	     else { $m -> set_label_pos($labelpos); }
	     $lastlabelpos = $labelpos;
	 }
     }
}

sub _distribute_labels {
     my $self = shift;
     
     my @m = $self->get_markers();
     my $lastlabelpos = 0;

     # calculate the downwards offsets
     #
     my %downwards=();
     
     if (!@m) { return; }

     foreach my $m (@m) {
	 if ($m->is_visible() && $m->is_label_visible()) {
	     my $cM= $m->get_offset();
	     my $labelpos = $self->get_cM_pixels($cM)+$self->{y};
	     my $labelheight = $m -> get_label_height();
	     #print STDERR "label height: $labelheight\n";

	     if (($labelpos-$labelheight)<$lastlabelpos) { 
		 $labelpos = $lastlabelpos+$labelheight;
		 if (exists($downwards{$m->get_name()})) { print STDERR "CATASTROPHY: Duplicate marker name $m->{get_name}\n"; }
		 $downwards{$m->get_name()} = $labelpos;
	     }
	     else {
		 $downwards{$m->get_name()}=$labelpos;
	     } 
	     $lastlabelpos = $labelpos;
	 }
     }
     
     # calculate the upwards offsets
     #
     my %upwards = ();
     my $toplabelpos = $self->{y}+$self->{height}+12+$m[-1]->get_label_height();
     foreach my $m (reverse(@m))  {
	 if($m->is_visible() && $m->is_label_visible()) {
	     my $cM=$m->get_offset();
	     my $labelpos = $self->get_cM_pixels($cM)+$self->{y};
	     my $labelheight= $m->get_label_height();
#	     print STDERR $m->get_name()." offset = $cM ID=".$m->get_id()."\n";
	     if (($labelpos+$labelheight)>$toplabelpos) {
		 $labelpos = $toplabelpos-$labelheight;
		 if (!$m->get_name()) { print STDERR "CATASTROPHY: Didn't get name on marker ".$m->get_id()."\n"; }
		 if (exists($upwards{$m->get_name})) { print STDERR "CATASTHROPHY: duplicate marker name ".$m->get_name()."\n"; }
		 $upwards{$m->get_name()} = $labelpos;
	     }
	     else {
		 $upwards{$m->get_name()}=$labelpos;
	     }
	     $toplabelpos = $labelpos;
	 }
     }
     
     # load into marker objects
     #
     foreach my $m (@m) {
	 $m->set_label_pos(($downwards{$m->get_name()}+$upwards{$m->get_name()})/2);
     }


 }

=head2 draw_chromosome

    $chr->draw_chromosome($image, $type);

Draws the chromosome on $image. Image is a GD image. The default chromosome rendering is as a 'sausage' type chromosome. A line model is available by supplying the type parameter "line". This is usually called by the map_image object.

=cut

sub draw_chromosome {
    my $self = shift;
    my $image = shift;

    # draw chromosome outline

    if ($self->{style} eq "line") { 
	$self->draw_chromosome_line($image);
    }
    elsif ($self->{style} eq "sausage") {
	$self->draw_chromosome_sausage($image);
    }
    else { $self->draw_chromosome_sausage($image); }
}

sub draw_chromosome_line {
    my $self=shift;
    my $image=shift;

    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);
    #print STDERR "$self->{x}, $self->{y}, $self->{x}, $self->{y}+$self->{height}, $color\n";
    $image -> line($self->{x}, $self->{y}, $self->{x}, $self->{y}+$self->{height}, $color);
}

sub draw_chromosome_sausage {
    my $self = shift;
    my $image = shift;
    
    # allocate colors
    #
    my $outline_color = $image -> colorResolve($self->{outline_color}[0], $self->{outline_color}[1], $self->{outline_color}[2]);
    my $hilite_color = $image -> colorResolve($self->{hilite_color}[0], $self->{hilite_color}[1], $self->{hilite_color}[2]);
    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);

    my $halfwidth = $self ->{width}/2;

    $image -> line($self->{x} - $halfwidth, $self->{y} , $self->{x}-$halfwidth, $self->{y}+$self->{height}, $outline_color);
    $image -> line($self->{x} + $halfwidth, $self->{y} , $self->{x}+$halfwidth, $self->{y}+$self->{height}, $outline_color);
    if ($self->is_section()) {
	my $text_color = $image -> colorResolve(50, 50, 50);
	$image -> line ($self->{x}-$halfwidth, $self->{y}, $self->{x}+$halfwidth, $self->{y}, $outline_color);
	$image -> line ($self->{x}-$halfwidth, $self->{y}+$self->{height}, $self->{x}+$halfwidth, $self->{y}+$self->{height}, $outline_color);
	$image -> fill($self->{x}, $self->{y}+1, $color);
	my $top_label = int($self->{start_cM})."cM";
	my $bottom_label = int($self ->{end_cM})."cM";
	$image -> string($self->{font}, $self->{x}-$self->{font}->width()* length($top_label)/2, $self->{y}-$self->{font}->height()-3, $top_label, $text_color);
$image -> string($self->{font}, $self->{x} - $self->{font}->width() * length($bottom_label)/2, $self->{y}+$self->get_height()+3, $bottom_label,$text_color);
    }
    else {
	$image -> arc ($self->{x}, $self->{y}, $self->{width}, $self->{curved_height}, 180, 0, $outline_color);
	$image -> arc ($self->{x}, $self->{y}+$self->{height}, $self->{width}, $self->{curved_height}, 0, 180, $outline_color);
	$image -> fill ($self->{x}, $self->{y}, $color);
    }
    
    

    if ($self->{hilite_start} || $self->{hilite_end}) { 

	my $start = $self->{y}+$self->get_cM_pixels($self->{hilite_start});
	my $end   = $self->{y}+$self->get_cM_pixels($self->{hilite_end});
	$image -> rectangle($self->{x}-$halfwidth, 
                            $start, 
                            $self->{x}+$halfwidth,
                            $end,
			    $outline_color);
	$image -> fill ($self->{x}, $start+1,  $hilite_color);

    }
    
    if ($self->{caption}) {
	my $bigfont = GD::Font->Large();
	$image -> string($bigfont, $self->{x}- $bigfont->width() * length($self->{caption})/2, $self->{y}-$bigfont->height()-$self->{curved_height}/2, "$self->{caption}", $outline_color);
    }
}

=head1 marker object

=cut

package marker;

=head2 new

    my $m -> new ($chr, $marker_id, $marker_name, $marker_type, $confidence, $order_in_loc, $location_subscript, $cM_offset, $loc_type, $loc_order);

Creates a new marker. The $chr is the chromosome object the marker belongs to. The marker_id has to be a unique id for the marker. 

=cut

sub new {
    my $class = shift;
    my $args = {};
    my $self = bless $args, $class;
    my $chromosome = shift;
    $self->{chromosome}=$chromosome;
    ($self->{marker_id}, $self->{marker_name}, $self->{marker_type}, $self->{confidence}, $self->{order_in_loc}, $self->{location_subscript}, $self->{offset}, $self->{loc_type}, $self->{loc_order}) = @_;
    $self -> set_color(50, 50 , 50);
    $self -> set_hilite_color(255, 255, 0);
    $self -> set_label_line_color(150,150,150);
    $self -> set_offset_text_color(150, 150, 150);
    $self -> {label_position} = 0;
    $self -> unhilite();
    $self -> unhide();
    $self-> {label_spacer} = 40; # the distance between the label and the midline of the chromosome
    $self -> {font} = GD::Font->Small();
    return $self;
}

=head2 set_color()

Sets the color of the marker (more specifically, the line of the marker on the chromosome). Three numbers between 0 and 255 for red, green and blue channels are required. Default color is black.

=cut

sub set_color {
    my $self = shift;
    $self->{marker_color}[0]=shift;
    $self->{marker_color}[1]=shift;
    $self->{marker_color}[2]=shift;
}

=head2 set_hilite_color

Sets the hilite color. Default is yellow. Three numbers between 0 and 255 for red, green and blue channels are required.

=cut

sub set_hilite_color {
    my $self = shift;
    $self->{hilite_color}[0]=shift;
    $self->{hilite_color}[1]=shift;
    $self->{hilite_color}[2]=shift;
}

=head2 set_label_line_color

Sets the color of the line connecting the label with the marker. Default is black. Three numbers between 0 and 255 for red, green and blue channels are required.

=cut

sub set_label_line_color {
    my $self = shift;
    $self->{label_line_color}[0]=shift;
    $self->{label_line_color}[1]=shift;
    $self->{label_line_color}[2]=shift;
}   

=head2 set_offset_text_color

Sets the color of the offset scale text, if enabled.

=cut

sub set_offset_text_color {
    my $self = shift;
    $self->{offset_text_color}[0]=shift;
    $self->{offset_text_color}[1]=shift;
    $self->{offset_text_color}[2]=shift;
}
    
=head2 set_text_color()

sets the color of the label text.

=cut


sub set_text_color {
    my $self = shift;
    $self->{text_color}[0]=shift;
    $self->{text_color}[1]=shift;
    $self->{text_color}[2]=shift;
}

=head2 get_name

Gets the complete name of the marker including the suffix.

=cut

sub get_name {
    my $self = shift;
    # test if there is anything in loation_subscript and set to empty string
    # otherwise a 0 may be appended.
    if (!$self->{location_subscript}) { $self->{location_subscript}= ""; }
    return $self->{marker_name}.$self->{location_subscript};
}

=head2 get_marker_name()

gets the marker name, excluding the suffix.

=cut

sub get_marker_name {
    my $self = shift;
    # this function returns the marker name without the subscript. This is useful for constructing links to the marker detail page
    # which requires a type/name tuple 
    return $self-> {marker_name};
}

=head2 get_id

gets the unique id associated with the marker.

=cut 

sub get_id {
    my $self = shift;
    return $self->{marker_id};
}

sub get_confidence { 
    my $self= shift;
    return $self->{confidence};
}

sub set_frame_marker {
    my $self = shift;
    $self->{loc_type} = "frame";
}

sub set_marker_type {
    my $self = shift;
    $self->{marker_type} = shift;
}

sub get_marker_type {
    my $self = shift;
    return $self->{marker_type};
}

sub is_frame_marker {
    my $self = shift;
    return ($self->{loc_type} eq "frame");
}

sub get_label_height {
    my $self = shift;
    return $self -> {font} -> height();
}

sub get_label_width {
    my $self = shift;
    my $width = $self -> {font} -> width();
    return ($width*length($self->get_name()));
}

sub set_label_pos {
    my $self = shift;
    $self -> {label_position} = shift;
}

sub get_label_pos {
    my $self = shift;
    return $self->{label_position};
}

sub get_label_spacer {
    my $self = shift;
    return $self->{label_spacer};
}

sub get_chromosome {
    my $self=shift;
    return $self->{chromosome};
}

=head2 set_url

sets the url that this marker links to.

=cut

sub set_url {
    my $self = shift;
    $self->{url}=shift;
}

sub get_url {
    my $self = shift;
    return $self->{url};
}

=head2 hilite

Hilites the marker in the hilite color (default is yellow).

=cut

sub hilite {
    my $self = shift;
    $self->{hilited}=1;
}

sub unhilite {
    my $self = shift;
    $self -> {hilited} = 0;
}

=head2 hide

Hides the marker completely from the chromosome.

=cut 

sub hide {
    my $self = shift;
    $self -> {hidden} = 1;
}

=head2 unhide

Unhides the marker.

=cut

sub unhide {
    my $self = shift;
    $self -> {hidden} = 0;
}

=head2 is_hidden

Returns true if marker is hidden.

=cut

sub is_hidden {
    my $self = shift;
    return $self -> {hidden};
}

=head2 hide_label

Hides the label of the marker only. The marker 'tick' is still being drawn.

=cut

sub hide_label {
    my $self= shift;
    $self->{label_hidden} = 1;
}

=head2 show_label

Unhides the label if it was previously hidden. Otherwise has no effect.

=cut 

sub show_label {
    my $self=shift;
    $self ->{label_hidden} = 0;
}

=head2 is_label_visible

Returns true if the lable is not hidden.

=cut

sub is_label_visible {
    my $self = shift;
    return !$self->{label_hidden};
}

=head2 get_image_map()

Returns the image map for this label as a string. Usually the chromosome object calls this function.

=cut

sub get_image_map {
    my $self = shift;
    #print STDERR "get_image_map marker\n";
    my $coords = join ",", ($self -> get_label_rect());
    if ($self->get_url()) {
	return "<AREA name=".$self->get_name()." shape=\"rect\" coords=\"".$coords."\" href=\"".$self->get_url()."\">\n";
    }
}

=head2 render()

    $marker -> render($image);

Renders the map on a GD image object. The chromosome object usually calls this function to render the entire chromosome.

=cut

sub render { 
    my $self = shift;
    my $image = shift;

    # render marker only if it is visible (markers outside of sections or hidden markers are not visible)
    if ($self -> is_visible()) {
	my $y = $self->get_chromosome()->{y} + $self->get_chromosome()->get_cM_pixels($self->{offset});
	my $color = $image -> colorResolve($self->{marker_color}[0], $self->{marker_color}[1], $self->{marker_color}[2]);
	my $chromosome_width = $self->get_chromosome()->{width};
	my $halfwidth = $chromosome_width/2;
	$image -> line($self->get_chromosome()->{x} - $halfwidth +1, $y, $self->get_chromosome()->{x}+$halfwidth-1, $y, $color);
	
	if ($self->is_label_visible()) {$self->draw_label($image);}
    }
    
}

sub get_label_rect {
    # function used for imagemaps and hiliting 
    my $self = shift;
    my $halflabelheight = $self->get_label_height() / 2;
    my $halfwidth = $self -> get_chromosome()->get_width() / 2;
    if ($self->get_chromosome()->{label_side} eq "left") { 
        $self ->{ux}=$self->get_chromosome()->{x}-$self->{label_spacer}-$self->get_label_width()-2;
	$self ->{uy}=$self->{label_position}-int($halflabelheight);
	$self ->{lx}=$self->{ux}+$self->get_label_width()+2;
	$self ->{ly}=$self->{uy}+$self->get_label_height();
    }	
    elsif ($self->get_chromosome()->{label_side} eq "right") {
	$self ->{ux}=$self->get_chromosome()->{x}+$self->{label_spacer}-2;
	$self ->{uy}=$self->{label_position}-int($halflabelheight);
	$self ->{lx}=$self->{ux}+$self->get_label_width()+2;
	$self ->{ly}=$self->{uy}+$self->get_label_height();
    }
    return ($self->{ux}, $self->{uy}, $self->{lx}, $self->{ly});
}

=head2 is_visible

returns true if the marker is visible, meaning it is not hidden and it lies not outside the chromosome section, if defined.

=cut

sub is_visible {
    my $self = shift;
    if ($self->{hidden}) { return 0; }
    if ($self->{chromosome}->is_section()) {
	if ($self->{offset} >= $self->{chromosome}->{start_cM} && $self->{offset} <= $self ->{chromosome}->{end_cM}) {
	    return 1;
	}
	else {return 0; }
    }
    return 1;
}

sub get_type{
    my $self = shift;
    return $self -> {type};
}

sub draw_label {
    my $self = shift;
    my $image = shift;
    my $halflabelheight = $self->get_label_height() / 2;
    my $halfwidth = $self -> get_chromosome()->get_width() / 2;
    my $label_line_color = $image-> colorResolve($self->{label_line_color}[0], $self->{label_line_color}[1], $self->{label_line_color}[2]);
    my $text_color = $image -> colorResolve($self->{text_color}[0], $self->{text_color}[1], $self->{text_color}[2]);
    my $offset_text_color = $image -> colorResolve($self->{offset_text_color}[0], $self->{offset_text_color}[1], $self->{offset_text_color}[2]);
    #$self->{font}=$self->get_chromosome()->{font};
    # hilite label if hilited
    #
    if ($self->{hilited}) {
	my $hilite_color = $image -> colorResolve($self->{hilite_color}[0], $self->{hilite_color}[1], $self->{hilite_color}[2]);
	my @rect = $self->get_label_rect();
	$image -> filledRectangle(@rect, $hilite_color);
    }
    
    # draw the labels left if label_side eq left 
    #
    if ($self->get_chromosome()->{label_side} eq "left") { 
	#$image->string($font,$x,$y,$string,$color)
	
	$image -> string($self->{font},$self->get_chromosome()->{x}-$self->{label_spacer}-$self->get_label_width(),$self->{label_position}-$halflabelheight,  $self->get_name(), $text_color);	
	
	$image -> line($self->get_chromosome()->{x}- $self->{label_spacer} , 
                       $self->{label_position}, 
                       $self->get_chromosome()->{x}-$halfwidth -1, 
                       $self->get_chromosome()->get_cM_pixels($self->{offset})+$self->get_chromosome()->{y}, 
                       $label_line_color);

	# draw the offset on the right if label_side eq left, if display_marker_offset is true in the chromosome object
	#
	if ($self->get_chromosome()->{display_marker_offset}) { 
	    $image -> string($self->{font},$self->get_chromosome()->{x}+$self->{label_spacer}+2, $self->{label_position}-$halflabelheight,  $self-> {offset}, $offset_text_color);
	    $image -> line ($self->get_chromosome()->{x}+$self->{label_spacer} , $self->{label_position}, $self->get_chromosome()->{x}+$halfwidth, $self->get_chromosome()->get_cM_pixels($self->{offset})+$self->get_chromosome()->{y}, $label_line_color);
	}

    }

    # draw the labels on the right side if label_side is right
    #
    elsif ($self->get_chromosome()->{label_side} eq "right") {
	$image -> string($self->{font},$self->get_chromosome()->{x}+$self->{label_spacer}, $self->{label_position}-$halflabelheight,  $self->get_name(), $text_color);
	$image -> line ($self->get_chromosome()->{x}+$self->{label_spacer} , $self->{label_position}, $self->get_chromosome()->{x}+$halfwidth+1, $self->get_chromosome()->get_cM_pixels($self->{offset})+$self->get_chromosome()->{y}, $label_line_color);


	# draw the offset on the left if label_side eq right, if display_marker_offset is true in the chromosome object
	#
	if ($self->get_chromosome()->{display_marker_offset}) {
	    $image -> string($self->{font},$self->get_chromosome()->{x}-$self->{label_spacer}-$self->get_label_width(),$self->{label_position}-$halflabelheight,  $self-> {offset}, $offset_text_color);	
	    
	    $image -> line($self->get_chromosome()->{x}- $self->{label_spacer} , 
			   $self->{label_position}, 
			   $self->get_chromosome()->{x}-$halfwidth, 
			   $self->get_chromosome()->get_cM_pixels($self->{offset})+$self->get_chromosome()->{y}, 
			   $label_line_color);
	}	    
	
    }

}

=head2 get_offset()

Returns the offset of the marker in map units (cM).

=cut
    
sub get_offset {
    my $self = shift;
    return $self->{offset};
}



package chr_link;

sub new { 
    my $class = shift;
    my $args = {};
    my $self = bless $args, $class;

    $self->{chr1}=shift;
    $self->{cM1} = shift;
    $self->{chr2}=shift;
    $self->{cM2} = shift;
 
    # define default color
    $self -> set_color(100, 100, 100);
    return $self;
}

sub set_color {
    my $self = shift;
    $self->{color}[0]=shift;
    $self->{color}[1]=shift;
    $self->{color}[2]=shift;
}

sub render {
    my $self = shift;
    my $image = shift;

    # draw only of both markers are visible...
    if ($self->{chr1}->is_visible($self->{cM1}) && $self->{chr2}->is_visible($self->{cM2})) {
	my $sign = (($self->{chr2}->{x}) <=> ($self->{chr1}->{x}));
	my $x1 = $self->{chr1}->{x} + $sign*($self->{chr1}->get_width()/2);
	my $y1 = $self->{chr1}->get_cM_pixels($self->{cM1});
	my $x2 = $self->{chr2}->{x} - $sign*($self->{chr2}-> get_width()/2);
	my $y2 = $self->{chr2}->get_cM_pixels($self->{cM2});

	#print STDERR "link color: $self->{color}[0], $self->{color}[1], $self->{color}[2]\n";
	my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);
	$image -> line($x1, $self->{chr1}->{y}+$y1, $x2, $self->{chr2}->{y}+$y2, $color);
    }
    else { 
	#print STDERR "Not rendering link because not visible. chr1 cM: $self->{cM1} chr2 cM: $self->{cM2}\n"; 
    }
    
}

package ruler;

sub new {
    my $class = shift;
    
    my $args ={};
    my $self = bless $args, $class;
    $self ->{x} = shift;
    $self ->{y} = shift;
    $self ->{height} = shift;
    $self ->{start_value} = shift;
    $self ->{end_value} = shift;
    $self -> {font} = GD::Font->Small();
    $self -> set_color (50, 50, 50);
    $self -> {label_side} = "left";
    $self -> {unit} = "cM";
    return $self;
}

sub set_color {
    my $self = shift;
    $self -> {color}[0] = shift;
    $self -> {color}[1] = shift;
    $self -> {color}[2] = shift;
}

sub set_labels_right {
    my $self = shift;
    $self->{label_side} = "right";
}

sub set_labels_left {
    my $self = shift;
    $self ->{label_side} = "left";
}

sub set_labels_none {
    my $self = shift;
    $self -> {label_side} = "";
}

sub set_units {
    my $self=shift;
    $self->{unit}=shift;
}

sub render {
    my $self = shift;
    my $image=shift;

    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);

    #draw line
    $image -> line($self->{x}, $self->{y}, $self->{x}, $self->{y}+$self->{height}, $color);
    
    #draw tick marks

    my $tick_spacing = 10;
    my $label_spacing = 20;
    if ($self->{end_value} < 100) { $label_spacing=10; $tick_spacing=5; }
    my $tick_number = ($self->{end_value}-$self->{start_value})/$tick_spacing;
    $self->_calculate_scaling_factor();
    for (my $i=0; $i<$tick_number; $i++) {
	my $y = $self->{y} + (($i*$tick_spacing)*$self->{scaling_factor});
	$image -> line($self->{x}-2, $y, $self->{x}+2, $y, $color); 
	
	if  ($i*$tick_spacing % $label_spacing ==0) { 
	    if ($self->{label_side} eq "left") { 
		$image -> string($self->{font}, $self->{x}-$self->{font}->width*length($i*$tick_spacing)-2, $y - $self->{font}->height/2, $i*$tick_spacing, $color);
	    }
	    if ($self->{label_side} eq "right") {
		$image -> string($self->{font}, $self->{x}+4, $y - $self->{font}->height/2, $i*$tick_spacing, $color);
	    } 
	}
    }
    my $label = "[".$self->{unit}."]";
    $image -> string($self->{font}, $self->{x}-$self->{font}->width()*length($label)/2, $self->{y}-$self->{font}->height()-3, $label, $color);

}

sub _calculate_scaling_factor {
    my $self = shift;
    my $dist = ($self->{end_value}-$self->{start_value});
    if ($dist ==0) { return 0; }
    $self -> {scaling_factor} = $self->{height}/($self -> {end_value} - $self->{start_value});
    return $self->{scaling_factor};
}
    
    
package physical;

use vars qw(@ISA);
@ISA = qw(chromosome);


sub new {
    my $class = shift;
    my $self = chromosome->new(@_);
    $self->{box_height}=4;
    @{$self->{offset}} = ();
    $self -> set_color(100,100,0);
    $self -> {font} = GD::Font->Tiny();
    return bless $self, $class;
}

sub add_bac_association {
    my $self = shift;
    my $offset = shift;
    my $bac_id = shift;
    #print STDERR "Adding BAC assoc: offset=$offset, bac_id=$bac_id\n";
    $self->{physical_offset}[$offset]++;
}

sub _get_largest_group {
    my $self = shift;
    my $largest = 0;
    for (my $i=0; $i<(@{$self->{physical_offset}}); $i++) {
	#print STDERR "offset = $i\n";
	if ($self->{physical_offset}[$i]>$largest) { $largest = $self->{physical_offset}[$i]; }
    }
    return $largest;
}

    

sub render {
    my $self= shift;
    my $image = shift;

    $self->_calculate_chromosome_length();
    $self->_calculate_scaling_factor();

    #print STDERR "rendering physical...\n";

    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);
    
    # draw coordinate system lines
    #
    my $halfwidth = $self->get_width()/2;
    $self->{largest} = $self->_get_largest_group();

    $image -> line($self->{x}-$halfwidth, $self->{y}, $self->{x}-$halfwidth, $self->{y}+$self->{height}, $color);

    $image -> stringUp($self->{font}, $self->{x}-$halfwidth-$self->{font}->height()/2, $self->{y}-4, "#BACs", $color);
    
    # draw the 10 line. Logarithmic scale
    #
    my $x = $self->{x}-$halfwidth+log(10)/log($self->{largest})*$self->get_width();
    $image -> dashedLine ($x, $self->{y}, $x, $self->{y}+$self->{height}, $color);
    $image -> stringUp ($self->{font}, $x - $self->{font}->height()/2, $self->{y}-4,"10", $color);

    # draw the 100 line. Logarithmic scale
    #
    my $x = $self->{x}-$halfwidth+log(100)/log($self->{largest})*$self->get_width();
    $image -> dashedLine ($x, $self->{y}, $x, $self->{y}+$self->{height}, $color);
    $image -> stringUp ($self->{font}, $x - $self->{font}->height()/2, $self->{y}-4,"100", $color);

    # draw the boxes
    # 
    #print STDERR "Largest = $self->{largest} WIDTH= ".$self->get_width()."\n";
    #print STDERR "Physical connections: ".@{$self->{offset}}."\n";
    for (my $i=0; $i<(@{$self->{physical_offset}}); $i++) {
	#print STDERR "offset = $i, $self->{physical_offset}[$i]\n";
	if ($self->{physical_offset}[$i]) {
	    
	    my $y = $self->{y}+$self->get_cM_pixels($i);
	    #print STDERR "DRawing box...y = $y scaling: $self->{scaling_factor}\n";
	    my $box_width = log($self->{physical_offset}[$i])/log($self->{largest})*$self->get_width();

	    if ($box_width<1) { $box_width=2; }
	    $image -> filledRectangle(
				      $self->{x} - $halfwidth, 
				      $y-$self->{box_height}/2, 
				      ($self->{x}-$halfwidth)+$box_width,  
				      $y + $self->{box_height}/2, 
				      $color);
	}
    }
}

sub get_box_rect {
    my $self = shift;
    my $offset = shift;
    my $y = $self->{y}+$self->get_cM_pixels($offset);
    if ($self->{physical_offset}[$offset] > 0) {
	#print STDERR "LARGEST: $self->{largest}\n";
	my $box_width = log($self->{physical_offset}[$offset])/log($self->{largest})*$self->get_width();
	if ($box_width<1) { $box_width=2; }
	return ($self->{x} - $self->get_width()/2, $y-$self->{box_height}/2, ($self->{x}-$self->get_width()/2)+$box_width,  $y + $self->{box_height}/2);    
    }
}


sub get_image_map {
    my $self = shift;
    my $string = "";
    #print STDERR "get_image_map physical\n";
    if ($self->get_url()) {
	for (my $i; $i<(@{$self->{physical_offset}}); $i++) {
	    my ($x, $y, $v, $w) = $self -> get_box_rect($i);
	    $string .="<AREA shape=\"rect\" coords=\"$x, $y, ".($self->{x}+$self->get_width()/2).", $w \" href=\"".$self->get_url()."\">";
	}
    }
    return $string;
}

package IL;

use vars qw(@ISA);

(@ISA) = ("chromosome");

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->{sections}=();
    $self->{fragments} =();
    return $self;
}

sub add_section {
    # sections are the non-overlapping sections of the ILs that have labels of the form 1-A
    my $self=shift;
    my $section_name = shift;
    my $marker1 = shift;
    my $offset1 = shift;
    my $marker2 = shift;
    my $offset2 = shift;
    
    
    my %section = ();
    $section{marker1}=$marker1;
    $section{offset1}=$offset1;
    $section{marker2}=$marker2;
    $section{offset2}=$offset2;
    $section{name}=$section_name;
    $section{label_position} = 0;
    push @{$self->{sections}}, \%section;

}


sub add_fragment {
    # fragments are the overlapping sections defining the different IL lines and have lables of the form IL1-1.
    my $self=shift;
    my $fragment_name=shift;
    my $marker1=shift;
    my $offset1 = shift;
    my $marker2 = shift;
    my $offset2 = shift;

    my %fragment = ();
    $fragment{marker1}=$marker1;
    $fragment{offset1}=$offset1;
    $fragment{marker2}=$marker2;
    $fragment{offset2}=$offset2;
    $fragment{name}=$fragment_name;
    $fragment{label_position} = 0;
    push @{$self->{fragments}}, \%fragment;

}

sub render {
    my $self=shift;
    my $image = shift;

    $self->_calculate_scaling_factor();
    $self->_calculate_chromosome_length();
    $self-> set_color(100,100,100);
    #print STDERR "Rendering ILs...\n";
    $self->{font}= GD::Font->Small();
    my $section_x = $self->{x} - $self->get_width()/2;

    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);
    my $light_color = $image -> colorResolve(200, 200, 200);
    # render sections
    #
    my $previous_label_position = 0;
    my $line =  1;
    my $spacing = 7;


    foreach my $s (@{$self->{sections}}) {
	my $y_start = $self->{y}+$self->get_cM_pixels($$s{offset1});
	my $y_end   = $self->{y}+$self->get_cM_pixels($$s{offset2 });
	
	
	$image -> line($section_x - 10, $y_start, $section_x + @{$self->{fragments}}*$spacing, $y_start, $light_color);
	$image -> line($section_x - 10, $y_end,   $section_x + @{$self->{fragments}}*$spacing, $y_end,  $light_color);
	$image -> line($section_x,      $y_start, $section_x, $y_end,   $color);
	$image -> string($self->{font}, $section_x - $self->{font}->width()* length($$s{name})-2, ($y_end + $y_start)/2-$self->{font}->height()/2, $$s{name}, $color); 
	
    }

    # render fragments
    #
    if (!defined($self->{fragments})) { print STDERR "IL: no fragments to render.\n"; return; }
    my $max_fragments = @{$self->{fragments}};

    foreach my $f (@{$self->{fragments}}) {
	my $y_start = $self->{y}+$self->get_cM_pixels($$f{offset1});
	my $y_end   = $self->{y}+$self->get_cM_pixels($$f{offset2 });
	
	my $label_position = ($y_end+$y_start)/2;
	if ($label_position < ($previous_label_position+$self->{font}->height())) { $label_position = $previous_label_position + $self->{font}->height(); }

	$image -> line($section_x+$line*$spacing, $y_start, $section_x+$line*$spacing, $y_end,$color);
	$image -> line($section_x+$line*$spacing+1, $y_start, $section_x+$line*$spacing+1, $y_end,   $color);
	$image -> string($self->{font}, $section_x +$max_fragments*$spacing+3, $label_position-$self->{font}->height()/2, $$f{name}, $color); 
	$image -> line($section_x+$line*$spacing, ($y_end+$y_start)/2, $section_x+$max_fragments*$spacing+3, $label_position, $color);
	$line++;
	$previous_label_position = $label_position;
    }
	
}
    
    
package chromosome_glyph;

use vars qw(@ISA);

@ISA = ('chromosome');


sub new {
    my $class = shift;
    my $self = $class->SUPER::new(@_);
    $self->set_outline_color(0,0,0);
    $self->set_color(255, 255, 255);
    $self->set_hilite_color(50, 255, 50);
    $self->set_width(10);
    $self->{curved_height} = 8;
    return $self;
}


sub set_fill_level {
    # 
    # set the percentage level to be displayed as finished in the chromosome. 50% would be 50, not 0.5
    #
    my $self=shift;
    $self->{fill_level} = shift;
}


sub set_bac_count { 
    #
    # set the number of bacs sequenced for that chromosome
    #
    my $self=shift;
    $self->{bac_count} = shift;
}


sub render {
    # 
    # draw the chromosome
    #
    my $self= shift;

    $self->_calculate_scaling_factor();
    
    my $image = shift;
    
    # allocate colors
    #
    my $outline_color = $image -> colorResolve($self->{outline_color}[0], $self->{outline_color}[1], $self->{outline_color}[2]);
    my $hilite_color = $image -> colorResolve($self->{hilite_color}[0], $self->{hilite_color}[1], $self->{hilite_color}[2]);
    my $color = $image -> colorResolve($self->{color}[0], $self->{color}[1], $self->{color}[2]);
    
    my $halfwidth = $self ->{width}/2;
    
    $image -> line($self->{x} - $halfwidth, $self->{y} , $self->{x}-$halfwidth, $self->{y}+$self->{height}, $outline_color);
    $image -> line($self->{x} + $halfwidth, $self->{y} , $self->{x}+$halfwidth, $self->{y}+$self->{height}, $outline_color);
    $image -> arc ($self->{x}, $self->{y}, $self->{width}, $self->{curved_height}, 180, 0, $outline_color);
    $image -> arc ($self->{x}, $self->{y}+$self->{height}, $self->{width}, $self->{curved_height}, 0, 180, $outline_color);
    $image -> fill ($self->{x}, $self->{y}, $color);
    
    if ($self->{fill_level}) { 
	print STDERR "Y: $self->{y}, Length: ".$self->get_length().", fill_level=".$self->{fill_level}."\n";
	my $level = $self->{y}+$self->get_cM_pixels($self->get_length()*(100-$self->{fill_level})/100);
	print STDERR "LEVEL: $level\n";
	$image -> line($self->{x}-$halfwidth+1, 
		       $level, 
		       $self->{x}+$halfwidth-1,
		       $level,
		       $outline_color);
	$image -> fill ($self->{x}, $level+1,  $hilite_color);
	
    }
    
    
    
    if ($self->{caption}) {
	my $bigfont = GD::Font->Large();
	$image -> string($bigfont, $self->{x}- $bigfont->width() * length($self->{caption})/2, $self->{y}-$bigfont->height()-$self->{curved_height}/2, "$self->{caption}", $outline_color);
    }

    my $percent_finished_caption = "[$self->{fill_level}\%]";
    $image -> string($self->{font}, $self->{x}- $self->{font}->width() * length($percent_finished_caption)/2, $self->{y} + $self->get_height()+$self->{curved_height}, "$percent_finished_caption", $outline_color);
    

}