--- /dev/null
+#!/usr/bin/perl
+
+=head1 NAME
+
+prettify.pl
+
+=head1 SYNOPSYS
+
+prettify.pl [--blc I<path>] [--alscript I<path>] --postscript I<path>
+
+=head1 DESCRIPTION
+
+This program uses a BLC file to create an Alscript command file.
+
+=head1 TODO
+
+Add more options, make prettier Alscript command files.
+
+=head1 BUGS
+
+Alscript can't count properly and so we have to add one to some of the indicies to make it work.
+
+=head1 AUTHORS
+
+Started by Patrick Audley <paudley@compbio.dundee.ac.uk>
+Extended by Jonathan Barber <jon@compbio.dundee.ac.uk>
+
+=cut
+
+use strict;
+use warnings;
+use Getopt::Long;
+use BLC;
+
+my $prefix = "seq.protein";
+my $bin = "/software/submit_all";
+
+my $blc = '-';
+my $alscript = '-';
+my $psout;
+
+GetOptions(
+ "blc:s" => \$blc,
+ "alscript:s" => \$alscript,
+ "postscript=s" => \$psout,
+) or die "$!\n";
+
+die "--postscript option required\n" unless $psout;
+
+my $data = new BLC;
+$data->read_file($blc);
+
+# Find which entries for secondary structure are in the sequence data
+my @jpred = map { /^(?:jnet|jhmm|jalign|jpssm|lupas_14|lupas_21|lupas_28)$/ or 0 } $data->get_seq_ids;
+
+# Replace space characters with '-' for the FSM
+my @sequences = map { my $c = $_; $c =~ s/ /-/g; $c } $data->get_sequences;
+
+# Find the positions of the secondary structure in the BLC file
+my ($top, $bottom, $alignEnd);
+foreach (0 .. $#jpred) { $top = $_ and last if $jpred[$_] }
+foreach (reverse(0 .. $#jpred)) { $bottom = $_ and last if $jpred[$_] }
+my $end = length $sequences[0];
+
+# ... and then add 1 to them as Alscript can't count properly
+$alignEnd = $top;
+$top++;
+$bottom++;
+
+# alscript bits
+open ALSOUT, ">$alscript" or die "$alscript: Can't open the Alscript command file\n";
+
+# Commands for Alscript
+# Add one as Alscript can't count, and make sure it's over a minimum otherwise
+# it cores...
+my $foo = @sequences > 50 ? @sequences + 1 : 50;
+my $MAX_NSEQ = "MAX_NSEQ ".$foo;
+# Buffer size for reading the BLC file needs to be at least the size of alignment +2
+# This also needs to be larger than the longest line in the Alscript command file
+# If any lines are longer than MAX_INPUT_LEN then Alscript is likely to fail with 'success'
+my $MAX_INPUT_LEN = "MAX_INPUT_LEN ".($foo > 50 ? $foo + 2 : 50);
+my $BLOCK_FILE = '#';
+unless ($blc eq '-') { $BLOCK_FILE = "BLOCK_FILE $blc"; }
+my $OUTPUT_FILE = "OUTPUT_FILE $psout";
+
+# Print the header
+print ALSOUT <<END;
+SILENT_MODE
+$BLOCK_FILE
+$MAX_NSEQ
+$MAX_INPUT_LEN
+$OUTPUT_FILE
+PORTRAIT
+POINTSIZE 8
+IDENT_WIDTH 12
+X_OFFSET 2
+Y_OFFSET 2
+DEFINE_FONT 0 Helvetica DEFAULT
+DEFINE_FONT 1 Helvetica REL 0.75
+DEFINE_FONT 7 Helvetica REL 0.6
+DEFINE_FONT 3 Helvetica-Bold DEFAULT
+DEFINE_FONT 4 Times-Bold DEFAULT
+DEFINE_FONT 5 Helvetica-BoldOblique DEFAULT
+#
+DEFINE_COLOUR 3 1 0.62 0.67 # Turquiose
+DEFINE_COLOUR 4 1 1 0 # Yellow
+DEFINE_COLOUR 5 1 0 0 # Red
+DEFINE_COLOUR 7 1 0 1 # Purple
+DEFINE_COLOUR 8 0 0 1 # Blue
+DEFINE_COLOUR 9 0 1 0 # Green
+DEFINE_COLOUR 10 0.41 0.64 1.00 # Pale blue
+DEFINE_COLOUR 11 0.41 0.82 0.67 # Pale green
+DEFINE_COLOUR 50 0.69 0.18 0.37 # Pink (helix)
+DEFINE_COLOUR 51 1.00 0.89 0.00 # Gold (strand)
+NUMBER_INT 10
+SETUP
+#
+# Highlight specific residues.
+# Avoid highlighting Lupas 'C' predictions by
+# limiting the highlighting to the alignments
+Scol_CHARS C 1 1 $end $alignEnd 4
+Ccol_CHARS H ALL 5
+Ccol_CHARS P ALL 8
+SURROUND_CHARS LIV ALL
+#
+# Replace known structure types with whitespace
+SUB_CHARS 1 $top $end $bottom H SPACE
+SUB_CHARS 1 $top $end $bottom E SPACE
+SUB_CHARS 1 $top $end $bottom - SPACE
+END
+
+# Find the range of each of the secondary structure elements
+foreach (0..$#jpred) {
+ if ($jpred[$_]) { # Then it's a secondary structure definition
+ my $fsm = fsm($sequences[$_], qw(- E H c C));
+ my $line = $_ + 1;
+
+ foreach (@{$fsm->{'E'}}) {
+ my ($start, $end) = @{$_};
+ my $colour = 51;
+ print ALSOUT "STRAND $start $line $end\n";
+ print ALSOUT "COLOUR_TEXT_REGION $start $line $end $line $colour\n";
+ }
+
+ foreach (@{$fsm->{'H'}}) {
+ my ($start, $end) = @{$_};
+ my $colour = 50;
+ print ALSOUT "HELIX $start $line $end\n";
+ print ALSOUT "COLOUR_TEXT_REGION $start $line $end $line $colour\n";
+ }
+ }
+}
+
+# Munge out the jpred predictions using a basic FSM
+# Pass the sequence and the states that are present.
+# Returns HoA's, keys are the states, arrays are start and end
+# points of the states.
+# Idea taken from Patrick Audley
+sub fsm {
+ my ($sequence, @states) = @_;
+ my $state; # The state we're in
+ my $start = 0; # The start position of the current state
+ my %res; # Hash to store results in
+ my $pos = 0; # The position in the FSM
+
+ $state = substr $sequence, 0, 1;
+ foreach my $char (split //, $sequence) {
+ $pos++;
+ next if $char eq $state; # Same state
+
+ # Otherwise we've changed states
+ my $flag = 0;
+ foreach (@states) {
+ if ($_ eq $char) {
+ push @{$res{$state}}, [ $start, $pos - 1 ];
+ $state = $char;
+ $start = $pos;
+ $flag = 1;
+ last;
+ }
+ }
+ unless ($flag) {
+ warn "'$char' not a defined state at position $pos.\n";
+ }
+ }
+
+ return \%res;
+}
git://source.jalview.org / jpred.git / blobdiff