package Ascii_genome_illustrator; use strict; use warnings; use Carp; sub new { my $packagename = shift; my ($molecule_name, $illustration_length) = @_; my $self = { name => $molecule_name, illustration_length => $illustration_length, features => [], }; bless ($self, $packagename); return ($self); } #### sub add_features { ## accepts list of features my $self = shift; my @features = @_; foreach my $feature (@features) { unless (ref $feature eq 'ARRAY') { confess "Error, improper params; should be a list of feature array refs"; } $self->add_feature(@$feature); } return; } #### sub add_feature { my $self = shift; my ($feature_name, $feature_end5, $feature_end3, $glyph) = @_; unless ($feature_name && $feature_end5 =~ /^\d+$/ && $feature_end3 =~ /^\d+$/ && defined($glyph) ) { confess "Error, improper params"; } unless (length($glyph) == 1 && $glyph !~ /\s/) { confess "Error, glyph must be a single non ws character.";} my $orient = ($feature_end5 < $feature_end3) ? '+' : '-'; my ($lend, $rend) = sort {$a<=>$b} ($feature_end5, $feature_end3); #print "Feature: $feature_name, $lend => $rend ($orient)\n"; my $feature_struct = { name => $feature_name, lend => $lend, rend => $rend, orient => $orient, glyph => $glyph, }; push (@{$self->{features}}, $feature_struct); return; } #### sub get_features { my $self = shift; return (@{$self->{features}}); } #### sub illustrate { my $self = shift; my ($mol_lend, $mol_rend) = @_; unless ($mol_lend && $mol_rend) { confess "invalid params"; } my $illustration_length = $self->{illustration_length}; my $text = sprintf("%+20s ", "$mol_lend-$mol_rend") . "[" . ("=" x ($illustration_length-2)) . "]\t" . $self->{name} . "\n"; foreach my $feature ($self->get_features()) { my ($name, $lend, $rend, $orient, $glyph) = ($feature->{name}, $feature->{lend}, $feature->{rend}, $feature->{orient}, $feature->{glyph}); my @illustration_array; ## init to clean palette for (my $i = 0; $i < $illustration_length; $i++) { $illustration_array[$i] = " "; } my ($pos_lend, $pos_rend) = $self->_compute_palette_position([$lend, $rend], [$mol_lend, $mol_rend]); # draw for (my $i = $pos_lend; $i <= $pos_rend; $i++) { $illustration_array[$i] = $glyph; } if ($orient eq '+') { $illustration_array[$pos_rend] = '>'; } elsif ($orient eq '-') { $illustration_array[$pos_lend] = '<'; } else { confess "Don't recognize orient:$orient"; } $text .= sprintf ("%+20s$orient ", "$lend-$rend") . join ("", @illustration_array) . "\t$name\n"; } return ($text); } #### sub _compute_palette_position { my $self = shift; my ($feature_coords_aref, $mol_coords_aref) = @_; my $illustration_length = $self->{illustration_length}; my ($feature_lend, $feature_rend) = @$feature_coords_aref; my ($mol_lend, $mol_rend) = @$mol_coords_aref; unless ($feature_lend <= $mol_rend && $feature_rend >= $mol_lend) { ## no overlap return (-1, -1); } if ($feature_lend < $mol_lend) { $feature_lend = $mol_lend; } if ($feature_rend > $mol_rend) { $feature_rend = $mol_rend; } my $mol_region_length = $mol_rend - $mol_lend + 1; my $delta_left = $feature_lend - $mol_lend + 1; my $delta_right = $feature_rend - $mol_lend + 1; my $pos_left = int($delta_left / $mol_region_length * $illustration_length + 0.5) - 1; $pos_left = 0 if $pos_left < 0; my $pos_right = int($delta_right / $mol_region_length * $illustration_length + 0.5) - 1; $pos_right = 0 if $pos_right < 0; return ($pos_left, $pos_right); } 1; #EOM