#!/usr/bin/env perl   

#  -*- perl -*-

use strict;
use warnings FATAL => qw ( all );
use Data::Dumper;
use Formats;
use Errors;

# STEMSHADE
# This program will shade an RNA alignment according to the
# assigned structures for each sequence. Basically, it converts the large-
# small-letter annotation that is used in the col-format to assign r, g and b
# color columns. 
# Ebbe Sloth Andersen, December 2004.

# >>>>>>>>>>>>>>>>>> RUN PROGRAM <<<<<<<<<<<<<<<<<<<<

my ( $entries, $file, $header );

( $file ) = @ARGV;

( $header, $entries ) = &Formats::read_col ( $file );
&Errors::check_col ( $entries, { "TYPE" => ["RNA"] } );
$entries = &stem_shade ( $entries );
$header .= "; stem_shade was run on this file.";
&Formats::write_col ( $header, $entries );

# >>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<

sub stem_shade
{
    # STEM_SHADE
    # Colors all positions that contain upper case letters.
    # Lower case letters are colored light grey. Gaps are white.
    # Ebbe Sloth Andersen, December 2004.

    my ( $entries ) = @_;

    # Returns an array of hashes.

    my ( @rna,
	 $rna,
	 @rnas,
	 $pm,
	 @pms,
	 @bps,
	 $bp,
         $entry,
         );

# add colors to rnas
    @rnas = grep { $_->{'TYPE'} eq "RNA" } @{ $entries };
    foreach $rna ( @rnas ) {
	@bps = ( );
	@bps = split(/,/, $rna->{'residue'});

        $rna->{'color_r'} = "";
        $rna->{'color_g'} = "";
        $rna->{'color_b'} = "";
        
	foreach $bp ( @bps ) {
	    if ( $bp =~ /^(T|A|U|G|C)/ ) {
		$rna->{'color_r'} .= "0.50,";  # green stem
		$rna->{'color_g'} .= "1.00,";
		$rna->{'color_b'} .= "0.50,";
	    } elsif ( $bp =~ /^(t|a|u|g|c)/ ) {
		$rna->{'color_r'} .= "0.70,";  # grey loops
		$rna->{'color_g'} .= "0.70,";
		$rna->{'color_b'} .= "0.70,";
	    } else {
		$rna->{'color_r'} .= "1.00,";
		$rna->{'color_g'} .= "1.00,";
		$rna->{'color_b'} .= "1.00,";
	    }
	}
    }
    return $entries;
}
