binaries/src/ViennaRNA/Utils/rotate_ss.pl

   1 #!/usr/bin/perl -w
   2 # -*-Perl-*-
   3 # Last changed Time-stamp: <2004-08-09 16:50:14 ivo>
   4 # $Id: rotate_ss.pl,v 1.4 2006/02/28 14:44:14 ivo Exp $
   5
   6 use Getopt::Long;
   7 use strict;
   8 use vars qw/$ss_ps $opt_a $opt_m/;
   9 use constant PI => 3.14159265;
  10
  11 my $ss_ps = { Header  => [],
  12               Coords  => [],
  13               BPairs  => [],
  14               Tailer  => [] };
  15 $opt_a = 0;
  16 usage() unless GetOptions("a=f" => \$opt_a, "m");
  17
  18 swallow_ss_ps();
  19 my $ar = to_Array($ss_ps->{Coords});
  20 my $mp = get_Midpt($ar);
  21 $ar = flip_Array($mp, $ar) if $opt_m;
  22 $ar = rot_Array($mp, $ar) if $opt_a;
  23 print_ss_ps($ar);
  24
  25 #---
  26 sub usage {
  27   printf STDERR "\nusage: $0 [-a ANGLE] [-m] FOO_ss.ps > BAR_ss.ps\n";
  28   exit(1);
  29 }
  30
  31 #---
  32 sub swallow_ss_ps {
  33   local $_;
  34   my $toggle = 0;
  35
  36   while (<>) {
  37     $toggle = 1 if m/^\/coor/;
  38     push @{$ss_ps->{Header}}, $_ if $toggle == 0;
  39     push @{$ss_ps->{Coords}}, $_ if $toggle == 1;
  40     push @{$ss_ps->{BPairs}}, $_ if $toggle == 2;
  41     push @{$ss_ps->{Tailer}}, $_ if $toggle >  2;
  42     $toggle++ if m/\]\s+def/;
  43   }
  44 }
  45
  46 #---
  47 sub to_Array {
  48   my $aref = shift;
  49   return [ map {chomp; s/\[//; s/\]//; [split] } @$aref[$[+1 .. $#$aref-1] ];
  50 }
  51
  52 #---
  53 sub get_Midpt {
  54   local $_;
  55   my $aref = shift;
  56   my ($xl, $yl, $xu, $yu) = ( 100000, 100000, -100000, -100000 );
  57   for ( @$aref ) {
  58     $xl = ($_->[0] < $xl) ? $_->[0] : $xl;
  59     $yl = ($_->[1] < $yl) ? $_->[1] : $yl;
  60     $xu = ($_->[0] > $xu) ? $_->[0] : $xu;
  61     $yu = ($_->[1] > $yu) ? $_->[1] : $yu;
  62   }
  63   return [($xl+$xu)/2, ($yl+$yu)/2, $xl, $yl, $xu, $yu];
  64 }
  65
  66 #---
  67 sub rot_Array {
  68   my ($mp, $ar) = @_;
  69   my $a = $opt_a/360*2*PI;
  70   my ($ca, $sa) = (cos($a), sin($a));
  71   return
  72       [
  73        map { [ ($ca*($_->[0]-$mp->[0]) + (-$sa*($_->[1]-$mp->[1])))+$mp->[0],
  74                ($sa*($_->[0]-$mp->[0]) +   $ca*($_->[1]-$mp->[1])) +$mp->[1]
  75                ] } @$ar ];
  76 }
  77 #---
  78 sub flip_Array {
  79   my ($mp, $ar) = @_;
  80   return
  81       [ map { [ ($mp->[0]-$_->[0]), $_->[1]] } @$ar ];
  82 }
  83
  84 #---
  85 sub print_ss_ps {
  86   local $_;
  87   my $ar = shift;
  88   for (qw/Header Coords BPairs Tailer/) {
  89     if ($_ eq 'Coords') {
  90       print "/coor [\n";
  91       for my $xy (@$ar) {
  92         print sprintf("[%7.3f %7.3f]\n", $xy->[0], $xy->[1]);
  93       }
  94       print "] def\n";
  95       next;
  96     }
  97     print join "", @{$ss_ps->{$_}};
  98   }
  99 }
 100
 101 =head1 NAME
 102
 103 rotate_ss - rotate or mirror coordinates of secondary structure plot
 104
 105 =head1 SYNOPSIS
 106
 107    rotate_ss.pl [-a angle] [-m] old_ss.ps > new_ss.ps
 108
 109 =head1 DESCRIPTION
 110
 111 B<rotate_ss> reads a PostScript RNA secondary structure plot, as
 112 produced by B<RNAfold> or B<RNAplot>, rotates and/or mirrors the
 113 coordinates, and writes the new plot to STDOUT.
 114
 115 =head1 OPTIONS
 116
 117 =over 4
 118
 119 =item B<-a> I<angle>
 120
 121 Rotate the plot counter-clockwise by I<angle> degrees.
 122
 123 =item B<-m>
 124
 125 Mirror the coordinates in the plot, i.e. convert from a
 126 couter-clockwise to clockwise layout. Note that, if both B<-m> and
 127 B<-a> are given, the plot is first mirrored, then rotated.
 128
 129 =back
 130
 131 =head1 AUTHORS
 132
 133 Ivo L. Hofacker <ivo@tbi.univie.ac.at>,
 134 Christoph Flamm <xtof@tbi.univie.ac.at>
 135
 136 =cut
 137
 138 __END__