File Coverage

blib/lib/Chromosome/Map.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Chromosome::Map;

use strict;
use GD;

use Chromosome::Map::Track;

use constant FONT_MEDIUM	=> 'gdMediumBoldFont';
use constant FONT_SMALL		=> 'gdSmallFont';
use constant FONT_TINY		=> 'gdTinyFont';

use constant PAD_TOP	=> 20;
use constant PAD_BOTTOM	=> 40;
use constant PAD_LEFT	=> 20;
use constant PAD_RIGHT	=> 20;

use constant CHR_WIDTH 	  => 6;
use constant CHR_PAD_LEFT => 40;
use constant CHR_PAD_TOP  => 30;
use constant PAD_SCALE	  => 20;		# pixel interval for chromosome scale display

our $VERSION = '0.01';

#-------------------------------------------------------------------------------
# public methods
#-------------------------------------------------------------------------------

sub new {
	my $class = shift;
	$class = ref($class) || $class;

	my %Options = @_;
	my $self = {};
	$self->{_name}     = $Options{-name};
	$self->{_size}     = $Options{-length};
	$self->{_start}    = $Options{-start} || 0;
	$self->{_units}    = $Options{-units};
	$self->{_height}   = $Options{-height};
	$self->{_width}    = 0; 						# AUTO
	# define padding, could override
	$self->{_pad_left}   = $Options{-pad_left} 	 || PAD_LEFT;
	$self->{_pad_right}  = $Options{-pad_right}  || PAD_RIGHT;
	$self->{_pad_top}    = $Options{-pad_top} 	 || PAD_TOP;
	$self->{_pad_bottom} = $Options{-pad_bottom} || PAD_BOTTOM;
	$self->{_tracks}   = {};
	$self->{_ident_track} = 0;
	bless $self,$class;
	return $self;
}

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

sub get_map_start {
	my ($self) = @_;
	return $self->{_start};
}

sub get_map_size {
	my ($self) = @_;
	return $self->{_size};
}

sub get_map_units {
	my ($self) = @_;
	return $self->{_units};
}

sub get_nb_tracks {
	my ($self) = @_;
	return keys ( %{$self->{_tracks}});
}

sub get_list_track {
	my ($self) = @_;
	my %List = %{$self->{_tracks}};
	return %List;
}

sub add_track {
	# the indice number is automatically increment
	# the first track added will have an indice number of 1
	# in case of adding FEATURE track, the indice number will be set to 0
	# as this track must be the first closest to chr
	# NOTE: only ONE feature track can be added to a map
	my ($self,$track) = @_;
	my $indice = $self->_inc_track_ident;

	# set indice value to 0 if track type = feature
	# DO NOT add another feature track if exists
	if ($track->get_track_type eq 'feature') {
		$indice = 0;
		return 0 if ($self->{_tracks}->{$indice});
	}
	$self->{_tracks}->{$indice} = $track;
	$track->{_size}  = $self->get_map_size;
	$track->{_start} = $self->get_map_start;
	return 1;
}

sub png {
  my $gd = shift->_gd;
  $gd->png;
}

sub svg {
  my $gd = shift->_gd;
  $gd->svg;
}


#-------------------------------------------------------------------------------
# private methods
#-------------------------------------------------------------------------------

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

sub _inc_track_ident {
	my $self = shift;
	my $ident = $self->_get_track_ident;
	$ident++;
	$self->{_ident_track} = $ident;
	return $ident++;
}

sub _scale {
	# give the value of chromosomal unit for 1 px
	my $self = shift;
	$self->{_scale} = $self->_get_chr_length / ($self->get_map_size - $self->get_map_start);
}

sub _get_chr_length {
	# return the pixel value available for chr drawing
	my $self = shift;
	my $chr_length = $self->_height - (PAD_TOP + PAD_BOTTOM + CHR_PAD_TOP);
	return $chr_length;
}

sub _locate_element {
	# return the y-axis pixel value for one element
	# i.e element at 24.9 cM will have an y value = 340 px
	my ($self,$value) = @_;
	my $y = $self->_get_y_top + ( ($value - $self->get_map_start) * $self->_scale);
	return $y;
}

sub _get_map_width {
	# use each x_bound track value to calculate final image width
	my $self = shift;
	my %Track = $self->get_list_track;
	my $img_width;
	foreach my $num (sort {$a <=> $b} keys %Track) {
		my $track = $Track{$num};
		$img_width += $track->_get_xbound;
	}
	return $img_width;
}

sub _is_extra_bottom_padding {
	# search the maximum value of extra_bottom_padding
	my $self = shift;
	my %Track = $self->get_list_track;
	my $extra_padding = 0;
	foreach my $num (sort {$a <=> $b} keys %Track) {
		my $track = $Track{$num};
		$extra_padding = $track->_get_extra_bottom_padding if ($track->_get_extra_bottom_padding > $extra_padding);
	}
	return $extra_padding;
}

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

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

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

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

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

sub _get_y_top {
	my $self = shift;
	return ($self->_pad_top + CHR_PAD_TOP);
}

sub _get_y_bottom {
	my $self = shift;
	return ($self->_height - $self->_pad_bottom);
}

sub _get_screen_size_ratio {
	# return a "printable" size ratio
	my $self = shift;
	my $size = $self->get_map_size;
	my $screen_size = 1;

	$screen_size = 1000 if ($size > 10_000);
	$screen_size = 1_000_000 if ($size > 10_000_000);
	return $screen_size;
}

sub _gd {
	use constant TRACK_PAD       => 3;
	use constant CHR_WIDTH_TRACK => 70;

	my $self = shift;

	# Define the choosen font size using constant name
	my $font_size_medium = FONT_MEDIUM;
	my $font_size_small  = FONT_SMALL;
	my $font_size_tiny   = FONT_TINY;
	my $font_medium = GD->$font_size_medium;
	my $font_small  = GD->$font_size_small;
	my $font_tiny   = GD->$font_size_tiny;

	# first render tracks
	my %Track_list = $self->get_list_track;
	foreach my $num (sort {$a <=> $b} keys %Track_list) {
		my $track = $Track_list{$num};
		$track->_render_track($self);
	}

	# defined Y0 and Ymax (map limits)
	my $y_chr_top    = $self->_get_y_top;
	my $y_chr_bottom = $self->_get_y_bottom;
	my $x_chr = $self->_pad_left + CHR_PAD_LEFT;

	# create final image
	my $width = CHR_WIDTH_TRACK + $self->_get_map_width + $self->_pad_left;
	my $height = $self->_height + $self->_is_extra_bottom_padding;
	my $img = GD::Image->new($width,$height);

	# adding each IMG track to final IMG
	my $x_track = $x_chr + CHR_WIDTH + 1;
	foreach my $num (sort {$a <=> $b} keys %Track_list) {
		my $track   = $Track_list{$num};
		my $gd      = $track->_get_gd;
		my $x_bound = $track->_get_xbound;
		$x_track += TRACK_PAD if ($track->get_track_type ne 'feature');
		$img->copy ($gd, $x_track, 0, 0, 0, $x_bound, $height);
		$x_track += $x_bound;
	}

	# get images scale (unit per pixel)
	my $scale = $self->_scale;

	# colors definition
	my $black = $img->colorAllocate(0,0,0);
	my $white = $img->colorAllocate(255,255,255);

	$img->fill(0,0,$white);

	# write map name and draw CHR rectangle
	my $screen_name = $self->get_map_name." (".$self->get_map_units.")";
	$img->string($font_medium, $self->_pad_top, $self->_pad_left,$screen_name, $black);
	$img->filledRectangle($x_chr, $y_chr_top, $x_chr+CHR_WIDTH, $y_chr_bottom, $black);

	# draw chromosomal scale
	$self->_draw_grid($img,$x_chr);

	return $self->{_gd} = $img;
}


sub _ticks {
	# calculate major and minor ticks, given a start position
	# modified from Bio::Graphics::Panel module
	# the MIN_GD_VALUE is used when the map scale is too big
	use constant MIN_WIDTH => 40;
	use constant MIN_GD_VALUE => 50;

	my $self = shift;

	my $length = $self->get_map_size;
	my $min_width = MIN_WIDTH;

	# figure out tick mark scale
	# we want no more than 1 major tick mark every 40 pixels
	# and enough room for the labels
	my $scale = $self->_scale;

	$min_width = MIN_GD_VALUE if ($scale > $min_width);

	my $interval = 1;

	while (1) {
		my $pixels = $interval * $scale;
		last if $pixels >= $min_width;
		$interval *= 10;
	}
	return ($interval,$interval/10);
}

sub _draw_grid {
	# draw a grid scale
	# modified from Bio::Graphics::Panel module
	use constant GRID_WIDTH => 3;

	my ($self,$gd,$x_chr) = @_;

	my $black = $gd->colorAllocate(0,0,0);

	my @positions;
	my ($major,$minor) = $self->_ticks;

	my $first_tick = $minor * int($self->get_map_start/$minor);

	for (my $i = $first_tick; $i <= $self->get_map_size; $i += $minor) {
		push @positions,$i;
	}

	my $size_ratio = $self->_get_screen_size_ratio;
	my $x_scale = $self->_pad_left;
	for my $tick (@positions) {
		my $y = $self->_locate_element($tick);
		my $offscale_major = 0;
		if ($tick % $major == 0) {
			$offscale_major = GRID_WIDTH;
			my $screen_value_grid = sprintf ("%.1f",($tick / $size_ratio));
			$gd->string(gdTinyFont,$x_scale,$y-5,$screen_value_grid,$black);
		}
		$gd->line($x_chr - GRID_WIDTH - $offscale_major, $y, $x_chr, $y, $black);
	}
}

1;

__END__