view release on metacpan or  search on metacpan

Bio/Prospect/Thread.pm  view on Meta::CPAN

  print $out $self->{'parser'}->XMLout( $self->{'dom'}, 'rootname' => 'threading' );
}


#-------------------------------------------------------------------------------
# output_rasmol_script()
#-------------------------------------------------------------------------------

=head2 output_rasmol_script()

 Name:      output_rasmol_script
 Purpose:   return a rasmol script for displaying a threaded structure
 Arguments: Bio::Structure::IO::Entry object
 Returns:   rasmol script

=cut

sub output_rasmol_script {
  my $self = shift;
  my $struc = shift;

  my $stringio;

  # transform the pdb structure using the threaded alignment
  $self->thread_structure( $struc );

  #----------------------------------------------------------------------
  # use pdbBackbone for pdb coordinates - prefer using convertProspect
  # pdb files instead (they include deletions in the template structure).
  # leave this code here for now.
  #
  # if coordinates are not defined then we can't output a proper
  # rasmol script
  #my $coord = $self->pdb_model();
  #if ( ! defined $coord )  {
    #throw Bio::Prospect::RuntimeError(
      #'No 3D coordinates available for this threading',
      #'No 3D coordinates available in the prospect output for this threading',
      #'Re-run prospect using the -3d flag'
    #);
  #}
  #$self->_parse_structure( $coord );
  #----------------------------------------------------------------------

  my $retval;
  $stringio = IO::String->new($retval);

  $stringio->print("echo 'Generated by:'\n",
           'echo \'  $Id: Thread.pm,v 1.28 2003/11/18 19:45:45 rkh Exp $\'', "\n", # '
           "echo\n"
          );

  ## generate the alignment and echo it in the RasMol window
  my $alignment = $self->alignment();
  chomp($alignment);
  $alignment =~ s/^.*$/echo '$&'/gm;
  $stringio->print("echo 'Alignment:'\n",
           $alignment, "\n");

  ## color the identities, similarities, mismatches
  ## simultaneously selects/colors and echos the legend
  $stringio->print("load pdb inline\n",    # must load before selecting
           "echo \n",
           "echo 'Legend:'\n",
           "echo '  set names in quotes may be used with select'\n");
  my @select_me;
  if ( @select_me = $self->get_identities() ) {
    my @deco = ('cartoons','color blue');
    $stringio->print( $self->_format_select( @select_me ),
            "define identities selected\n",
            map { "$_\n" } 'wireframe off',@deco );
    $stringio->printf("echo '  %d \"identities\" decorated {%s}'\n",
            $#select_me+1, join(',',@deco));
  }

  if ( @select_me = $self->get_similarities() ) {
    my @deco = ('cartoons','color cyan');
    $stringio->print( $self->_format_select( @select_me ),
            "define similarities selected\n",
            map { "$_\n" } 'wireframe off',@deco );
    $stringio->printf("echo '  %d \"similarities\" decorated {%s}'\n",
            $#select_me+1, join(',',@deco));
  }

  if ( @select_me = $self->get_mismatches() ) {
    my @deco = ('cartoons','color red');
    $stringio->print( $self->_format_select( @select_me ),
            "define mismatches selected\n",
            map { "$_\n" } 'wireframe off',@deco );
    $stringio->printf("echo '  %d \"mismatches\" decorated {%s}'\n",
            $#select_me+1, join(',',@deco));
  }

  if ( @select_me = $self->get_deletions() ) {
    my @deco = ('trace','color grey');
    $stringio->print( $self->_format_select( @select_me ),
            "define deletions selected\n",
            map { "$_\n" } 'wireframe off',@deco );
    $stringio->printf( "echo '  %d query \"deletions\" (template insertions) decorated {%s}'\n",
            $#select_me+1, join(',',@deco) );
  }

  if ( @select_me = $self->get_inserts() ) {
    my @deco = ('strands','color green');
    $stringio->print( $self->_format_select( @select_me ),
            "define insertions selected\n",
            "select selected and *.CA\n",
            map { "$_\n" } 'wireframe off',@deco );
    $stringio->printf( "echo '  %d query \"insertions\" (template deletions) decorated {%s}'\n",
             $#select_me+1, join(',',@deco) );

  # label the inserts
  #wrong: $stringio->printf("echo '  %d inserts at QUERY positions {%s}'\n", 
  #wrong:          $#select_me+1, join(',',@select_me));
  foreach my $ires_i (@select_me) {
    my (@I) = $self->get_inserted_residues($ires_i);
    my $I = join('',@I);
    $I =~ s/\d//g;            # remove residue numbers
    if (length($I) > 20) {
    $I = substr($I,0,10) . ' ... ' . substr($I,-10,10);
    }