view lib/CPT/Plot/Base.pm @ 1:8691c1c61a8e draft default tip

planemo upload commit 94b0cd1fff0826c6db3e7dc0c91c0c5a8be8bb0c
author cpt
date Mon, 05 Jun 2023 02:48:47 +0000
parents
children
line wrap: on
line source

package CPT::Plot::Base;
use Data::Dumper;
use CPT::Plot::Label;
use CPT::Plot::Class;
use CPT::Plot::Gene;
use CPT::Plot::Colours;
use Bio::SeqIO;
use SVG;
use Moose;

# ABSTRACT: Main plotting class for genome mapper

has 'svg'        => ( is => 'rw', isa => 'Any' );
has 'line_count' => ( is => 'rw', isa => 'Num', default => 1 );
has '_ft_count'  => ( is => 'rw', isa => 'Num', default => 0 );
has 'classes'    => ( is => 'rw', isa => 'HashRef' );

# Labels
has 'label' => ( is => 'rw', isa => 'Bool' );

has 'label_pos'              => ( is => 'rw', isa => 'Any' );
has 'label_shrink_mode'      => ( is => 'rw', isa => 'Any' );
has 'label_callouts'         => ( is => 'rw', isa => 'Any' );
has 'label_from'             => ( is => 'rw', isa => 'Any' );
has 'label_text_source'      => ( is => 'rw', isa => 'Any' );
has 'label_numeric_features' => ( is => 'rw', isa => 'Any' );
has 'label_query'            => ( is => 'rw', isa => 'Any' );
has 'label_numbering_count'  => ( is => 'rw', isa => 'Any', default => 1 );

has 'justified' => ( is => 'rw', isa => 'Str' );

# CHanged to any b/c unpassed = undef
has 'separate_strands'        => ( is => 'rw', isa => 'Any' );
has 'double_line_for_overlap' => ( is => 'rw', isa => 'Any' );
has 'opacity'                 => ( is => 'rw', isa => 'Str' );
has 'view'                    => ( is => 'rw', isa => 'Str' );

has 'color_scheme'  => ( is => 'rw', isa => 'HashRef' );
has 'wanted_tags'   => ( is => 'rw', isa => 'HashRef' );
has 'genome_length' => ( is => 'rw', isa => 'Int' );
has 'features'      => ( is => 'rw', isa => 'ArrayRef' );
has 'start'         => ( is => 'rw', isa => 'Int' );
has 'end'           => ( is => 'rw', isa => 'Int' );

has 'avgRowLength' => ( is => 'rw', isa => 'Int' );
has 'calc_height'  => ( is => 'rw', isa => 'Int' );
has 'calc_width'   => ( is => 'rw', isa => 'Int' );
has 'x_offset'     => ( is => 'rw', isa => 'Num' );
has 'y_offset'     => ( is => 'rw', isa => 'Num' );
has 'ils'          => ( is => 'rw', isa => 'Num' );
has 'width_mode'   => ( is => 'rw', isa => 'Str' );
has 'width_value'  => ( is => 'rw', isa => 'Num' );
has 'rows'         => ( is => 'rw', isa => 'Num' );
has 'split_factor' => ( is => 'rw', isa => 'Num' );

has 'rowdata'                => ( is => 'rw', isa => 'HashRef' );
has '_internal_maxrowlength' => ( is => 'rw', isa => 'Num' );

my $color_spec = CPT::Plot::Colours->new( 'default' => '#000000' );
our ( $parser, $tree, $cb );

sub init {
	my ($self) = @_;
	my %classes;
	my %cs = %{ $self->color_scheme() };
	foreach my $key ( keys %cs ) {
		$classes{$key} = CPT::Plot::Class->new(
			'key'      => $key,
			'color'    => $cs{$key}{color},
			'border'   => $cs{$key}{border},
			'plot'     => $cs{$key}{plot},
			'included' => 1,
		);
	}
	$self->classes( \%classes );
	$self->init_label_stuff();
	$self->filterFeatues();
}

sub init_label_stuff {
	my ($self) = @_;

	if ( $self->{'label_from'} eq 'custom' ) {
		use Parse::BooleanLogic;
		$parser = new Parse::BooleanLogic( operators => [ '', 'OR' ] );
		$tree = $parser->as_array( $self->label_query );
		print $parser;

		#foreach bio feature,
		#if solve == 1, then add to our return,
		#else doesn't match
		#endforeach
		#my $new_tree = $parser->solve($tree,$filter);
		$cb = sub {
			my $query   = $_[0]->{'operand'};
			my $feature = $_[1];

			my $negate = 0;
			if ( substr( $query, 0, 1 ) eq '!' ) {    #negate
				$negate = 1;
				$query = substr( $query, 1 );
			}
			if ( $query =~ m/([^:]+):["']{0,1}([^'"]*)["']{0,1}/ ) {
				my ( $k, $v ) = ( $1, $2 );
				my $result;
				if ( $k eq 'contains' ) {
					my $values = join(
						"\t",
						map {
							if ( $_ ne
								"translation" )
							{
								join(
									'',
									$feature
									  ->get_tag_values
									  (
										$_
									  )
								);
							}
						} $feature->get_all_tags()
					);
					if ( $values =~ m/$v/i ) {
						$result = 1;
					}
					else {
						$result = 0;
					}
				}
				elsif ( $k eq 'key' ) {
					if ( $v =~ m/,/ ) {
						$result = 0;
						foreach ( split( /,/, $v ) ) {
							if ( $feature
								->primary_tag
								eq $_ )
							{
								$result = 1;
							}
						}
					}
					else {
						$result =
						  $feature->primary_tag eq $v;
					}
				}
				elsif ( $k eq 'tag' ) {
					if ( $v =~ m/([^=]+)=(.*)/ ) {
						my ( $tag_name, $tag_match ) =
						  ( $1, $2 );
						if ( $feature->has_tag($1) ) {
							if (
								join(
									'',
									$feature
									  ->get_tag_values
									  (
										$1
									  )
								) =~ /$2/i
							  )
							{
								$result = 1;
							}
							else {
								$result = 0;
							}
						}
						else {
							$result = 0;
						}
					}
					else {
						$result = $feature->has_tag($v);
					}
				}
				else {

					#error
					$result = 0;
				}
				return ( $negate xor $result );
			}
			else {

				#error
				return 0;
			}

			#error
			return 0;
		};
	}
}

sub filterFeatues {
	my ($self) = @_;

	#$self->{'wanted_tags'} = map { $_ => 1 } split(/,/,$self->{'q'});
	my %tags = map { $_ => 1 } split( /,/, "tRNA,CDS" );
	$self->wanted_tags( \%tags );
	my @feats = @{ $self->features() };
	for my $feat_object (@feats) {
		my $should_add = 1;
		if ( $feat_object->primary_tag eq 'source' ) {
			$should_add = 0;
		}
		if ( $feat_object->primary_tag eq 'gene' ) {
			$should_add = 0;
		}
		if ( defined $self->start()
			&& $feat_object->start < $self->start() )
		{
			$should_add = 0;
		}
		if ( defined $self->end()
			&& $feat_object->end > $self->end() )
		{
			$should_add = 0;
		}
		if ($should_add) {
			$self->addGene($feat_object);
		}
	}
}

sub addGene {
	my ( $self, $feat_object ) = @_;
	my $tag   = $feat_object->primary_tag;
	my $label = "";
	if ( $self->label() ) {

#If it meets the criteria specified for labelling an object, set the label, else don't set a label
		if ( $self->label_from() eq 'custom' ) {
			if ( $parser->solve( $tree, $cb, $feat_object ) ) {
				if (
					$feat_object->has_tag(
						$self->label_text_source()
					)
				  )
				{
					$label = join(
						' ',
						$feat_object->get_tag_values(
							$self
							  ->label_text_source(
							  )
						)
					);
				}
				else {
					$label = '[]';
				}
			}

#if($feat_object->has_tag($self->label_text_source())){
#$label = ' '.join(' ', $feat_object->get_tag_values($self->label_text_source()));
#}
		}
		elsif ( $self->label_from() eq 'numeric' ) {
			if ( ${ $self->wanted_tags() }{$tag} ) {
				$label = $self->label_numbering_count();
				$self->label_numbering_count(
					$self->label_numbering_count() + 1 );
			}
		}
		else {
			die $self->label_from();
		}
	}
	my @color_arr;
	my $color;
	if ( $feat_object->has_tag('color') ) {
		push( @color_arr, $feat_object->get_tag_values('color') );
	}
	if ( $feat_object->has_tag('color') ) {
		push( @color_arr, $feat_object->get_tag_values('color') );
	}
	if ( scalar @color_arr ) {
		$color = $color_arr[0];
	}

	my $gene = CPT::Plot::Gene->new(
		'tag'    => $tag,
		'label'  => $label,
		'start'  => $feat_object->start,
		'end'    => $feat_object->end,
		'strand' => $feat_object->strand,
		'color'  => $color,
	);

#This is a "failsafe" addition of classes, in case the user didn't specify a color
	if ( !defined ${ $self->classes() }{$tag} ) {
		${ $self->classes() }{$tag} = CPT::Plot::Class->new(
			'key'      => $tag,
			'color'    => '#000000',
			'border'   => 1,
			'plot'     => 1,
			'included' => 1,
		);
	}
	else {
		${ $self->classes() }{$tag}->addObject($gene);
	}
}

sub partitionLines {
	my ($self) = @_;

# To use when I finally get partitioning.pm working
#sub partitionLines{
#	my ($self) = @_;
#
#	my $partioner = Partitioning->new(
#		genome_length => $self->genome_length(),
#		rows          => $self->rows(),
#		justified     => $self->justified(),
#	);
#
#	# Add data to it
#	foreach(keys %classes){
#		if($classes{$_}->isIncludedInPartioning()){
#			$partioner->add($classes{$_}->getItemList());
#		}
#	}
#	# Run &&  get Results
#	my %result = %{$partioner->run()};
#	# . . .
#	print Dupmer %results;
#	# Profit
#	exit 1;
#	# This is supposed to merge two hashes. [http://perldoc.perl.org/perlfaq4.html#How-do-I-merge-two-hashes%3f]
#	@self{keys %result} = values %result;

	my @items;

	$self->avgRowLength(
		int(
			$self->genome_length() /
			  $self->rows() *
			  $self->split_factor()
		)
	  )
	  ; #TODO, allow adjusting or just re-calc? need to benchmark first I guess.
	$self->calc_height( int( ( 1 + $self->rows() ) * $self->ils() ) );

	if ( $self->width_mode() eq 'dynamic' ) {
		$self->calc_width(
			int( $self->avgRowLength() / $self->width_value() ) );
	}
	else {
		$self->calc_width( $self->width_value() );
	}

	my $fake_count = 100;
	if ($fake_count) {
		for ( my $i = 0 ; $i <= $fake_count ; $i++ ) {
			my $key =
			  int( $self->genome_length() * $i / $fake_count );
			push( @items, [ $key, $key, 1 ] );
		}
	}

	my %classes = %{ $self->classes() };
	foreach ( keys %classes ) {
		if ( $classes{$_}->included() ) {
			push( @items, @{ $classes{$_}->getItemList() } );
		}
	}

	#Sort based on where each item starts
	@items = sort { ${$a}[0] <=> ${$b}[0] } @items;

	#my $z = '(' . join('),(',map { "${$_}[0],${$_}[1]" } @items ) . ')';
	#print join("\n",split(/(.{1,120})/msxog, $z)) . "\n";
	my %rowdata;

	my ( $longest_last_object, $thisRowEnd, $currentRow ) =
	  ( 1, 1 + $self->avgRowLength(), 1 );
	$rowdata{1}{start} = 1;
	foreach my $item_ref (@items) {
		my ( $item_start, $item_end ) = @{$item_ref};

		#print "\t$item_start\t$item_end\t$thisRowEnd\n";
		if ( $item_start >= $thisRowEnd || $item_end > $thisRowEnd ) {

       # This was just cleaned up from the following commented out piece of code
			if (       $self->justified() eq 'justify'
				|| $item_start >= $rowdata{$currentRow}{end} )
			{
				$rowdata{$currentRow}{end} = $thisRowEnd;
			}
			else {
				$rowdata{$currentRow}{end} =
				  max( $longest_last_object, $item_start );
			}

      # There was a corner case here:
      # O    represents the end of a gene,
      # ---  represents a gene
      # |    represents $thisRowEnd
      #
      #
      # ------O     |  O---------
      # In this case, the second end would be chosen as
      # max($longest_last_object,$item_start), which is NOT what we
      # want.  You want  | to be chosen, not O, so in the case that
      # item_start is >= current row end (or should that be >?), we
      # use this.
      #
      # ------O     |
      #          O--+--------
      # This case works fine
      #
      #
      # ------O     |
      #    O--------+--------
      # This case also works fine
      #
      #
      #				if($self->justified()){
      #					$rowdata{$currentRow}end() = $thisRowEnd;
      #				}else{
      #					if($item_start <= $rowdata{$currentRow}end()){
      #						$rowdata{$currentRow}end() = max($longest_last_object,$item_start);
      #					}else{
      #						$rowdata{$currentRow}end() = $thisRowEnd;
      #					}
      #				}
			$self->_internal_maxrowlength(
				max(
					$self->_internal_maxrowlength(),
					$rowdata{$currentRow}{end} -
					  $rowdata{$currentRow}{start}
				)
			);
			$currentRow++;

			#print "$item_start $rowdata{$currentRow-1}{end}\n";
			if ( $item_start <= $rowdata{ $currentRow - 1 }{end} ) {
				$rowdata{$currentRow}{start} = $item_start;
			}
			else { #nonjustified never encounters the following line
				$rowdata{$currentRow}{start} =
				  $rowdata{ $currentRow - 1 }{end} + 1;
			}
			$thisRowEnd =
			  $self->avgRowLength() + $rowdata{$currentRow}{start};
		}
	}

#	if($self->justified()){
#		foreach my $item_ref(@items){
#				my ($item_start, $item_end) = @{$item_ref};
#				# If the item starts OR ends after this row is supposed to end
#				# print "\t$item_start\t$item_end\t$thisrowend\n";
#				if($item_start >= $thisRowEnd || $item_end >  $thisRowEnd){
#					$rowdata{$currentRow}end() = $thisRowEnd;
#					#Internal max row length is the length of the longest row
#					$self->_internal_maxrowlength'} = max($self->{'_internal_maxrowlength'},$rowdata{$currentRow}{'end'}-$rowdata{$currentRow}{'start());
#					#Update which row we're on (so we aren't using +1s everywhere)
#					$currentRow++;
#					if($item_start <= $rowdata{$currentRow-1}end()){
#						$rowdata{$currentRow}start() = $item_start;
#					}else{
#						$rowdata{$currentRow}start'} = $rowdata{$currentRow-1}{'end() + 1;
#					}
#					#tracks where the current row ends
#					#print Dumper $rowdata;
#					#print ">>$thisRowEnd\t".$self->avgRowLength'}." + ".$rowdata{$currentRow}{'start()."\n";
#					$thisRowEnd = $self->avgRowLength'} + $rowdata{$currentRow}{'start();
#					#print ">>$thisRowEnd\t".$self->avgRowLength'}." + ".$rowdata{$currentRow}{'start()."\n";
#				}
#		}
#	}else{#Non justified, raggedright
#		foreach my $item_ref(@items){
#				my ($item_start, $item_end) = @{$item_ref};
#				#print "\t$item_start\t$item_end\t$thisrowend\n";
#				if($item_start >= $thisRowEnd || $item_end >  $thisRowEnd){
##					print "\t> $item_start\t$item_end\t$thisRowEnd\n";
##					print "Candidate for ending [" . ($item_start >= $thisRowEnd) ."]\t[" .($item_end >= $thisRowEnd) . "]\n";
##					# If we have ``justified'' rulers, they all need to the be the SAME length (until the last)
##					print "              -- $rowdata{$currentRow}end()$thisRowEnd\n";
#					$rowdata{$currentRow}end() = max($longest_last_object,$item_start);
#					#Internal max row length is the length of the longest row
#					$self->_internal_maxrowlength'} = max($self->{'_internal_maxrowlength'},$rowdata{$currentRow}{'end'}-$rowdata{$currentRow}{'start());
#					#Update which row we're on (so we aren't using +1s everywhere)
#					$currentRow++;
#					#if($item_start <= $rowdata{$currentRow-1}end()){
#						$rowdata{$currentRow}start() = $item_start;
#					#}
#					#tracks where the current row ends
#					$thisRowEnd = $self->avgRowLength'} + $rowdata{$currentRow}{'start();
#				}
#				$longest_last_object = max($longest_last_object,$item_end);
#		}
#	}
#make sure the final row length is set, in addition to the _int_max_rowlength
	$thisRowEnd = $rowdata{$currentRow}{end} =
	  $self->genome_length() + 1;    #Putative
	$self->_internal_maxrowlength(
		max(
			$self->_internal_maxrowlength(),
			$rowdata{$currentRow}{end} -
			  $rowdata{$currentRow}{start}
		)
	);
	$rowdata{max} = $currentRow;

	if ( defined $self->{start} && defined $self->{end} ) {
		%rowdata = (
			'1' =>
			  { 'end' => $self->{end}, 'start' => $self->{start} },
			'max' => 1,
		);
	}

	$self->rowdata( \%rowdata );

}

sub getSVG {
	my ($self) = @_;
	return $self->svg();
}

# SVG
sub createSVG {
	my ($self) = @_;
	my %rowdata = %{ $self->rowdata() };
	$self->calc_height( int( ( 1 + $rowdata{max} ) * $self->ils() ) );
	if ( $self->width_mode() eq 'dynamic' ) {
		$self->calc_width(
			int( $self->avgRowLength() / $self->width_value() ) );
	}
	else {
		$self->calc_width( $self->width_value() );
	}

	$self->svg(
		SVG->new(
			width  => $self->calc_width() + 2 * $self->x_offset(),
			height => $self->calc_height() + 2 * $self->y_offset(),
		)
	);

#$self->svg()->title( id => 'documenfeatures from t-title' )->cdata("Genome Map of [$file_name]");

	my $ui_group = $self->svg()->tag(
		'g',
		id    => 'group_ui',
		style => {
			stroke         => '#000000',
			fill           => '#000000',
			'fill-opacity' => 1,
		}
	);

	foreach ( my $i = 1 ; $i <= $rowdata{max} ; $i++ ) {
		$self->_addRuler( $i, $ui_group );
	}

	my %classes = %{ $self->classes() };
	foreach my $class_key ( keys %classes ) {

		#print "Adding features from $class_key\n";
		my $class = $classes{$class_key};
		if ( !$class->plot() ) {
			next;
		}
		my $group = $self->svg()->tag(
			'g',
			id    => 'group_' . $class->key(),
			style => {
				stroke => (
					$class->plot()
					? (
						$class->border()
						? "black"
						: "none"
					  )
					: 'none'
				),
				fill           => $class->color(),
				'fill-opacity' => $self->opacity(),
			}
		);
		my @data = @{ $class->getObjects() };
		foreach my $gene (@data) {
			my ( $start, $end ) =
			  ( $gene->start(), $gene->end() );
			my $row = calculateRow( $self, $start, $end );
			addFeature(
				$self,
				group    => $group,
				row      => $row,
				start    => $start,
				end      => $end,
				key      => $gene->tag(),
				strand   => $gene->strand(),
				label    => $gene->label(),
				ui_group => $ui_group,
				color    => $gene->color(),
			);

		}
	}

}

sub calculateRow {
	my ( $self, $start, $end ) = @_;
	my %rowdata = %{ $self->rowdata() };
	for ( my $i = 1 ; $i <= $rowdata{max} ; $i++ ) {
		if (
			   $start > $rowdata{$i}{start} - 1
			&& $start < $rowdata{$i}{end} + 1
			&& $end > $rowdata{$i}{start} - 1
			&& $end < $rowdata{$i}{end} + 1

		  )
		{
			return $i;
		}
	}

#print "<b>$start,$end,".$self->rowdata'}{$i}{'start'}.",".$self->{'rowdata'}{$i}{'end()."<\/b>\n";
	return 1.5;
}

sub _addRuler {
	my ( $self, $row, $ui_group ) = @_;
	my $y_fix = $self->ils() * ( $row - 1 );

	#	my @d = (
	#		$self->calc_width(),
	#		$self->rowdata'}{$row}{'end(),
	#		$self->rowdata'}{$row}{'start(),
	#		($self->rowdata'}{$row}{'end'}-$self->{'rowdata'}{$row}{'start()),
	#		$self->_internal_maxrowlength(),
	#	);
	#	print join("\t",@d),"\n";
	my %rowdata = %{ $self->rowdata() };
	my $line_width =
	  $self->calc_width() *
	  ( $rowdata{$row}{end} - $rowdata{$row}{start} ) /
	  $self->_internal_maxrowlength();

#print "Adding ruler\t".$self->rowdata'}{$row}{'start'}."\t".$self->{'rowdata'}{$row}{'end'}."\t" . ($self->{'rowdata'}{$row}{'end'} - $self->{'rowdata'}{$row}{'start()) . "\n";

	$ui_group->line(
		id => 'ui_element_' . ( $self->line_count() + rand() ),
		x1 => 0 + $self->x_offset(),
		x2 => $line_width + $self->x_offset(),
		y1 => $y_fix + $self->y_offset(),
		y2 => $y_fix + $self->y_offset()
	);

	#	print "Ruler is being plotted from $y_fix to $line_width\n";
	if ( $self->separate_strands() ) {

	#$ui_group->rectangle(
	#id => 'ui_element_' . ( $self->line_count() + rand() ) . "_" . rand(1),
	#x      => 0 + $self->x_offset(),
	#y      => $y_fix - 2.5 + $self->y_offset(),
	#width  => $line_width,
	#height => 5
	#);

		#$y_fix += 100;
	}

	if ( $self->double_line_for_overlap() && $row > 1 )
	{    #This shows any duplicated part of the scale
		if ( $rowdata{ $row - 1 }{end} - $rowdata{$row}{start} >= 0 )
		{    #Equal to zero indicates ONE base of overlap
			$ui_group->line(
				id => 'ui_element_'
				  . ( $self->line_count() + rand() ),
				y1 => $y_fix - 5 + $self->y_offset(),
				y2 => $y_fix - 5 + $self->y_offset(),
				x1 => 0 + $self->x_offset(),
				x2 => $self->calc_width() * (
					$rowdata{ $row - 1 }{end} -
					  $rowdata{$row}{start}
				  ) / $self->_internal_maxrowlength() +
				  $self->x_offset(),

#$calc_width*($rowdata{$row-1}end'}-$rowdata{$row}{'start'})/$self->{'_internal_maxrowlength'} + $self->{'x_offset(),
			);
		}
	}
	$ui_group->line(
		id => 'ui_element_' . ( $self->line_count() + rand() ),
		x1 => 0 + $self->x_offset(),
		x2 => $line_width + $self->x_offset(),
		y1 => $y_fix + $self->y_offset(),
		y2 => $y_fix + $self->y_offset()
	);
	foreach ( $rowdata{$row}{start} - 1 .. $rowdata{$row}{end} ) {
		if ( $_ % 1000 == 0 && $_ % 10000 != 0 ) {
			my $current_location =
			  $self->calc_width() *
			  ( $_ - $rowdata{$row}{start} ) /
			  $self->_internal_maxrowlength();
			$ui_group->line(
				id => 'ui_element_'
				  . ( $self->line_count() + rand() ),
				x1 => $current_location + $self->x_offset(),
				x2 => $current_location + $self->x_offset(),
				y1 => $y_fix + $self->y_offset(),
				y2 => $y_fix + 5 + $self->y_offset(),
			);
		}
		if ( $_ % 10000 == 0 ) {
			my $current_location =
			  $self->calc_width() *
			  ( $_ - $rowdata{$row}{start} ) /
			  $self->_internal_maxrowlength();
			$ui_group->line(
				id => 'ui_element_'
				  . ( $self->line_count() + rand() ),
				x1 => $current_location + $self->x_offset(),
				x2 => $current_location + $self->x_offset(),
				y1 => $y_fix + $self->y_offset(),
				y2 => $y_fix + 10 + $self->y_offset(),
			);
			$ui_group->text(
				id => 'ui_text'
				  . ( $self->line_count() + rand() ),
				x => $current_location + 10 + $self->x_offset(),
				y => $y_fix + 20 + $self->y_offset(),
				-cdata         => ( $_ / 1000 ) . " kb",
				'fill'         => '#000000',
				'fill-opacity' => 1,
				'font-family'  => 'mono',
				'stroke'       => 'none'
			);
		}

		if (
			(
				   $_ == $rowdata{$row}{start} - 1
				|| $_ == $rowdata{$row}{end}
			)
			&& ( $_ % 10000 != 0 )
		  )
		{
			my $current_location =
			  $self->calc_width() *
			  ( $_ - $rowdata{$row}{start} ) /
			  $self->_internal_maxrowlength();
			$ui_group->line(
				id => 'ui_element_'
				  . ( $self->line_count() + rand() ),
				x1 => $current_location + $self->x_offset(),
				x2 => $current_location + $self->x_offset(),
				y1 => $y_fix + $self->y_offset(),
				y2 => $y_fix + 10 + $self->y_offset(),
			);
			$ui_group->text(
				id => 'ui_text'
				  . ( $self->line_count() + rand() ),
				x      => $current_location + $self->x_offset(),
				y      => $y_fix + 20 + $self->y_offset(),
				-cdata => sprintf( '%d kb', ( $_ / 1000 ) ),
				'fill' => '#000000',
				'fill-opacity' => 1,
				'font-family'  => 'mono',
				'stroke'       => 'none'
			);
		}
	}
}

sub addFeature {
	my ( $self, %data ) = @_;
	my %rowdata = %{ $self->rowdata() };
	my $x =
	  $self->calc_width() *
	  ( $data{'start'} - $rowdata{ $data{'row'} }{'start'} ) /
	  $self->_internal_maxrowlength() + $self->x_offset();
	my $w =
	  $self->calc_width() *
	  ( $data{'end'} - $data{'start'} ) /
	  $self->_internal_maxrowlength();
	my $h = 15;
	my $y =
	  ( $data{'row'} - 1 ) * $self->ils() + $self->y_offset() - $h / 2;

	my $id = "$x$y$w$h" . rand();

#print "Item(".$data{'start'}.",".$data{'end'}.",".$data{'row'}.") =\t($x,$y,$w,$h)\n";

	if ( $self->separate_strands() ) {
		$y += -$data{'strand'} * 30;
	}

	if ( $self->view() eq 'alt_random' ) {    # Max add = 20
		$y += 4 * ( $x % 5 );
	}
	elsif ( $self->view() eq 'alt_every' ) {    # Max add = 10
		  # We (Sort of like a convolution?) multiply by strand This has
		  # the following effect; when on the top strand, we will only
		  # ever add a positive to the height of the item (moving it
		  # downward and closer to the ruler). On the bottom strand
		  # however, we only ever add a negative to the height of the
		  # item (moving it upwards towards the ruler). This allows the
		  # items on the top and bottom to stay balanced.
		$y +=
		  $data{'strand'} * 10 *
		  ( ( $self->_ft_count( $self->_ft_count() + 1 ) ) % 2 ) -
		  10 * $data{'strand'};

		# However, This is imperfect, since we add items based on class,
		# not from left to right
	}
	elsif ( $self->view() eq 'alt_artemis' ) {    # Max add = 20?
		   # Muwahahahaha. Sorry. Determined coefficient and constant by
		   # trial and error, but this matches up with the artemis view
		   # without an if/else based on which strand. :D
		$y +=
		  10 * ( ( $data{'start'} - 2 * $data{'strand'} + 1 ) % 3 ) -
		  10 * $data{'strand'};
	}

	my $item_color = $color_spec->getColour( $data{'color'} );
	if ($item_color) {
		$data{'group'}->rectangle(
			x      => ($x),
			y      => $y,
			width  => $w,
			height => $h,
			id     => $id,
			fill   => $color_spec->getColour( $data{'color'} )
		);
	}
	else {
		$data{'group'}->rectangle(
			x      => ($x),
			y      => $y,
			width  => $w,
			height => $h,
			id     => $id,
		);
	}
	if ( $self->label() && $data{'label'} ) {

		my ( $lx, $ly );
		my @char_data = split( //, $data{label} );

		#Exit early if we don't even want to plot.
		my $is_too_small = ( scalar(@char_data) * 2 > $w );
		if ( $self->label_shrink_mode() eq 'cutoff' && $is_too_small ) {
			return;
		}

		#Font Scaling
		my $font_scaling = 100;
		if ( $self->label_shrink_mode() eq 'shrink' ) {
			$font_scaling *= $w / ( 8 * scalar(@char_data) );
		}

		# Horizontal positioning
		$lx =
		  $x +
		  $w / 2
		  ; #Horizontally center it, but this is by the leading edge of the text
		if ( scalar(@char_data) * 8 > $w
			&& $self->label_shrink_mode() eq 'shrink' )
		{
			$lx -=
			  scalar(@char_data) * 4 *
			  $font_scaling / 100
			  ; #Adjustment for scaled text. Determined by experiment
		}
		else {
			$lx -=
			  scalar(@char_data) * 4
			  ; #Move four pixels left for every character in the label
		}

		# Vertical positioning
		if ( $self->label_pos() eq "above" ) {    #Label is ABOVE
			if (       $self->separate_strands()
				&& $data{'strand'} == -1 )
			{
				$ly =
				  $y +
				  $h / 2 + 10 + 30
				  ; #Need to consider below strand, only one strand.
			}
			else {
				$ly =
				  $y +
				  $h / 2 - 30
				  ; #Need to consider below strand, only one strand.
			}
		}
		else {              #Label is ON
			$ly = $y + $h / 2 + 5;
		}

		if ( $data{'label'} !~ /^gene_[0-9]+$/ ){
			$self->plot_label( $lx, $ly, $font_scaling, $data{'label'},
				$data{'ui_group'} );

			if (       $self->label_callouts()
				&& $self->label_pos() eq "above" )
			{
				$data{'ui_group'}->line(
					id => 'l' . "_" . rand(1),
					x1 => $x + ( $w / 2 ),
					x2 => $x + ( $w / 2 ),
					y1 => (
						$self->separate_strands()
						  && $data{'strand'} eq '-1' ? $y + $h
						: $y
					),
					y2 => (
						$self->separate_strands()
						  && $data{'strand'} eq '-1' ? $ly - 12
						: $ly
					)
				);
			}
		}

	}
}

sub plot_label {
	my ( $self, $x, $y, $font_size, $label, $ui_group ) = @_;
	if ( $font_size < 80 ) {
		$font_size = 80;
	} 
	$ui_group->text(
		id             => 'text' . rand(1),
		x              => $x,
		y              => $y,
		-cdata         => $label,
		'fill'         => '#000000',
		'fill-opacity' => 1,
		'font-family'  => 'mono',
		'font-size'    => $font_size . '%',
		'stroke'       => 'none'
	);
}

sub max ($$) { $_[ $_[0] < $_[1] ] }
sub min ($$) { $_[ $_[0] > $_[1] ] }

no Moose;
1;

__END__

=pod

=encoding UTF-8

=head1 NAME

CPT::Plot::Base - Main plotting class for genome mapper

=head1 VERSION

version 1.96

=head1 AUTHOR

Eric Rasche <rasche.eric@yandex.ru>

=head1 COPYRIGHT AND LICENSE

This software is Copyright (c) 2014 by Eric Rasche.

This is free software, licensed under:

  The GNU General Public License, Version 3, June 2007

=cut