diff 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 diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/CPT/Plot/Base.pm	Mon Jun 05 02:48:47 2023 +0000
@@ -0,0 +1,983 @@
+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