20251125

2025-11-25 00:28:51 +08:00
commit eb3f16c30e
406 changed files with 91653 additions and 0 deletions
@@ -0,0 +1,157 @@
+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