convert2html.pl

EM算法的改进

    }
    if ($stype eq 's' && $strand eq "-") {
      $seqno = $SEQNO{"-".$name};		# negative DNA strand
    } else {
      $seqno = $SEQNO{$name};
    }

    if (defined($SKIP[$seqno])) {
      if (!defined($SKIP[$seqno-1])) { $out .= "<TR><TD COLSPAN=5>$ELIPSIS\n"; }
      next;				# skip this sequence
    } 

    # start row of table
    $out .= "<TR>\n ";

    if ($make_buttons) {
      $evalue = "$evalue";
      if ( $name =~ /\|/ ) {
	$button = make_button_panel("!", \%buttons, 
	  $db."entrez!$name", "score!$seqno", "align!$seqno", "help" );
      } else { 
	$button = make_button_panel("!", \%buttons, 
	  "score!$seqno", "align!$seqno", "help" );
      }
      $out .= "<TD>$button\n";
    } # make_buttons

    # write name of sequence 
    if ($no_gi_names) {
      $name =~ s/^gi\|\d+\|//;			# leading gi|123 removed
    }
    $link = "<A NAME=d$seqno></A>$name";
    $out .= " <TD>$link\n";
    $META .= "$name";

    if ($stype eq "s") {
      $out .= " <TD ALIGN=CENTER>$strand\n";
    }
    $out .= " <TD ALIGN=RIGHT NOWRAP>$evalue\n";
    $META .= " $evalue $nocc[$lno] $seqlen[$lno]";
    $out .= " <TD><TABLE SUMMARY='diagram $seqno' WIDTH=$max_width BORDER=0 ALIGN=LEFT CELLSPACING=0 CELLPADDING=0><TR ALIGN=CENTER>\n";
    @field = split( '[ _]', $diagram );
    $fsize = $THIN_LINE;		# font size for spacer line
    if ($scale1[$seqno] != $scale) { $fsize = $FAT_LINE; }
    $tail = $max_width;
    $position = 0;				# position in sequence
    foreach $f (@field) {
      if ( $f =~ /[<>\[\]]/ ) {			# motif occurence
	($st, $motif, $frame, $pv) = $f =~ 
          /[<\[]([+-]?)(\d+)([abc]?)($re_en)?[>\]]/;
        ($pv) = $pv =~ /\(([^)]+)\)/;
	$wide = int($mscale*$width{$motif}/$scale1[$seqno]+0.5);
	if ($wide < $MIN_WIDTH) { $wide = $MIN_WIDTH; }
        if ($motif eq ""){
          $color = "gray";
          $motif = "&nbsp";
        } else {
          $col = ( $motif - 1 ) % $ncolors; 
          $color = $MOTIF_COLORS[$col];
        }
	# set color and size of motif label;
	# weak motifs have font size $WEAK_FONT
	$font = "";
        $endfont = "";
        $class = ($f =~ /</) ? "cw$col" : "c$col"; 
	$out .= "  <TD CLASS='$class' WIDTH=$wide>$st$motif$frame\n";
        $META .= "  $st$motif $position $pv";	# for meta-meme
        $position += $width{$motif};		# letter position in sequence
      } else {					# spacer
	$wide = $f/$scale1[$seqno];
	$wide = int($wide + 0.5);		# round to integer
	$out .= 
	 "  <TD WIDTH=$wide><HR SIZE=$fsize NOSHADE>\n";
        $position += $f;			# letter position in sequence
      }
      $tail -= $wide;
    }
    if ($tail > 0) { $out .= "  <TD WIDTH=$tail>\n"; }
    $out .= " </TABLE>\n";
    $META .= "\n";				# metameme data
    $lno++;					# line number
  } # line

  #
  # print a scale
  #
  $dist = 50;					# pixel distance between rules
  $w2 = $dist - 1.0/$scale;			# distance to second rule
  $ncol--;					# number of columns scale spans
  $out .= "<TR><TH CLASS='blue' COLSPAN=$ncol ROWSPAN=2 ALIGN=LEFT>SCALE\n";
  $out .= "  <TD><TABLE SUMMARY='scale' WIDTH=$max_width BORDER=0 ALIGN=LEFT CELLSPACING=0 CELLPADDING=0><TR ALIGN=CENTER>\n";
  $out .= "    <TD CLASS='blue' WIDTH=$w2 ALIGN=LEFT>|</TD>\n";
  for ($i=$dist; $i<$max_width; $i+=$dist) {
    $loc = $i * $scale;
    last if ($i > $max_width-50);	# make sure number will fit
    $out .= "    <TD CLASS='blue' WIDTH=$dist ALIGN=LEFT>|</TD>\n";
  }
  $out .= "  <TR><TD CLASS='blue' WIDTH=$w2 ALIGN=LEFT>1</TD>\n";
  for ($i=$dist; $i<$max_width; $i+=$dist) {
    $loc = $i * $scale;
    last if ($i > $max_width-50);	# make sure number will fit
    $out .= "    <TD CLASS='blue' WIDTH=$dist ALIGN=LEFT>$loc</TD>\n";
  }
  $out .= "  </TABLE>\n";

  # end the table
  $out .= "</TABLE>\n";

  return( $out );
} # format_diagrams

#------------------------------------------------------------------------------
#	find_line
#------------------------------------------------------------------------------
sub find_line {

    local( $key ) = @_;
    local( $line );

    LINE:
    while ( $line = <STDIN> ) {

        unless ( $line =~ /$key/ ) {
            next LINE;
        }
        last;
    }
    return( $line );
} # find_line

#------------------------------------------------------------------------------
# make_button_panel:
#
# Use the input associative array, and the specified keys to create a HTML
# table with labeled buttons.
#
# The buttons are defined in the associative array passed in the second
# parameter.  This array is indexed by the key, and contains three fields
# separated by the divider specified in the 1st parameter.  The fields 
# are the tag template, the background color, and the font color.  Note that
# a tag template that is a link will override the font color.
#
# The tag template is a string that, optionally, can have the key substituted
# into it at all positions marked by $MBPSUB (this is a symbol to avoid 
# collisions with arbitrary strings).
#
# Note that each line containing a button panel should be followed with a
# <BR CLEAR=LEFT> to prevent the next line from being indented to the position
# following the panel.  This is because, even though the panel uses a -1 font,
# it is still taller than the text and therefore creates an apparent indent in
# the same way a drop capital would.
#
# USAGE:
#	<string>  = &make_button_panel( <div>, <button def>, [<key1>,<key2>...] );
#
# button def:
# button defs have three elements separated by the divider (div) :
#	Element 1: template for text that will appear on the button.  This 
#	can be static text, or contain a place hold where key information will
#	be inserted ($MBPSUB).
#	Element 2: background color for the button.
#	Element 3: foreground color for the button.  Note if button is a link, 
#	this color will be overridden by the link color.
#
# key:
# keys have one or two elements separated by the divider:
#	Element 1: mandatory.  this is the button type and is used to look up
#			   the button definition.
#	Element 2: optional.  If present, this is the key information that will
#	be substituted for $MBPSUB.  If absent, the button type is used.
#
# default behavior:
# if a button type is undefined, a black and white button will be displayed 
# using the key information as the label on the button. 
#
# EXAMPLE
#	$MBPSUB = "XXXXXXX";
#	
#	%p1 = ( 
#         'aaa', 
#         '<A HREF=http://www.sdsc.edu/~gribskov>$MBPSUB</A>&#FFAAAA&white', 
#	  'b', 'B&#DDDDFF&white', 
#	  'c', 'C&white&black' 
#	);
#	
#	%p2 = ( 'fff', 'F green white',
#	        'ggg', 'G blue white' );
#	
#	$bpanel = &make_button_panel( "&", \%def, "a&?", "c" );
#	print "$bpanel text following the buttons goes here<BR CLEAR=LEFT>\n";
#	$bpanel =  &make_button_panel( " ",  \%p2, "fff", "ggg", "hhh" );
#	print "$bpanel A second panel with text<BR CLEAR=LEFT>\n";
#
#	19 November 1997     Michael Gribskov
#------------------------------------------------------------------------------
sub make_button_panel {

        local ($div, *def, @parm) = @_;
        local ($p, $n, $type, $text, $tag, $bkg, $bcolor, $font, $fcolor, $out);

        $out = "<TABLE SUMMARY='buttons' ALIGN=LEFT CELLSPACING=0><TR>";
        foreach $p ( @parm ) {

            # split the key into the tag (type) and text
            $n = ($type, $text) = split /$div/, $p;
            if ( $n > 1 ) {
                $key = $text;
            } else { $type=$p; $key = $p; }

            #look up the button definition using the type as key
            ($tag, $bcolor, $fcolor) = split /$div/, $def{$type};

            unless ( defined($tag) ) { $tag = $key; }
            unless ( defined($bcolor) ) { $bcolor = "white"; }
            unless ( defined($fcolor) ) { $fcolor = "black"; }

            # replace all occurrences of $MBPSUB with the key
            while ( $tag =~ s/$MBPSUB/$key/ ){};

            $out .= "\n  <TD BGCOLOR='$bcolor'>$tag";
            $c++;
        }
        $out .= "</TABLE>";

        return( $out );
} # make_button_panel

################################################################################
#	get_color
#
#	Get the name of the color for the given DNA or Protein letter. 
#	Colors are similar to those used by CLUSTAL.
#
################################################################################
sub get_color {
  local ($type, $letter) = @_;

  $_ = $letter;

  if ($type =~ /DNA|dna/) {
    if (/[Aa]/) {
      $color = "red";
    } elsif (/[Cc]/) {
      $color = "blue";
    } elsif (/[Gg]/) {
      $color = "orange";
    } elsif (/[Tt]/) {
      $color = "green";
    } else {
      $color = "black";
    }
  } elsif ($type =~ /PROTEIN|protein/) {
    if (/[ACFILMVWacfilmvw]/) {
      $color = "blue";
    } elsif (/[NQSTnqst]/) {
      $color = "green";
    } elsif (/[DEde]/) {
      $color = "magenta";
    } elsif (/[KRkr]/) {
      $color = "red";
    } elsif (/[Hh]/) {
      $color = "pink";
    } elsif (/[Gg]/) {
      $color = "orange";
    } elsif (/[Pp]/) {
      $color = "yellow";
    } elsif (/[Yy]/) {
      $color = "turquoise";
    } else {
      $color = "black";
    }
  }
  $color;
} # get_color 

#------------------------------------------------------------------------------
# Cleanup any temporary files
#------------------------------------------------------------------------------
sub cleanup {
  #system "rm $pgm.$$.*.tmp";
  if ($_[0] eq "INT") { exit(1); } else { exit($_[0]); }
} # cleanup

#
# Haoyuan added some functions here in order to convert mhmm result from 
# plain text to html (mhmm2html)
#

#-----------------------------------------------------------------------------
# format_subtile
# Add HTML sub_title, <hr><b><center> .... </center></b><hr>.
# 
# USAGE: $new_text = &format_subtitle(text)
#-----------------------------------------------------------------------------
sub format_subtitle {
    my ($line) = @_;
    my ($out);
    $out = "<HR>\n<CENTER><B>$line</B></CENTER>\n<HR>\n";
    return($out);
} #format_subtitle

#----------------------------------------------------------------------------
# format_hidden
# Add HTML Hidden Field
#
# USAGE: $new_text = &format_hidden(textname,textfield)
#----------------------------------------------------------------------------
sub format_hidden {
  my ($name, $field) = @_;
  my ($out);

  # replace confounding characters (">) that won't work in HIDDEN values
  $field =~ s/\"/&quot;/g;
  $field =~ s/\>/&gt;/g;

  $out = "<INPUT TYPE = \"HIDDEN\" NAME = \"$name\"".
    " VALUE = \"\n".
    "$field".
    " \">\n";
} #format_hidden

#----------------------------------------------------------------------------
# delete_first_letter
# Delete the first letter of a sentence
# In mhmm2html file, it is used to chop "#"
# USAGE: $new_text = &delete_first_letter(text)
#----------------------------------------------------------------------------
sub delete_first_letter{
    my ($line) = @_;
    my ($out);
    if (length($line) == 0){
	print (STDERR "Error: The length of your input is 0\n");
	exit(0);
    }
    else{
	my($length) = length($line);
	$out = substr($line,1,$length-1);
    }
    return($out);
}

#--------------------------------------------------------------------------
# make_end
# Add some "last" info. to the html output page
#
# USAGE: $end = &make_end()
#--------------------------------------------------------------------------
sub make_end{
    my ($out, $button);

    # button to take user to top of form
    $button = make_button_panel("!", \%buttons, "top");
    # finish form, body and documument
    $out = "<HR>$button<BR>\n</FORM>\n</BODY>\n</HTML>\n";
    return ($out);
}

#-------------------------------------------------------------------------
# format_table
# format html table from input plain text
#
# USAGE: $new_text = &format_table($text,$num_col)
#-------------------------------------------------------------------------
sub format_table{
    my ($out,@temp1,$i,@temp2,$end_mark,$j);
    my ($line,$num_col) = @_;
    print "<table border = \"1\">\n";
    @temp1 = split("\n",$line);
    for ($i=0;$i<=$#temp1;$i++){
	@temp2 = split(" ",$temp1[$i]);
	if ($num_col eq "0"){
	    $end_mark = $#temp2;
	}
	else{
	    $end_mark = $num_col-1;
	    for ($j=$num_col;$j<=$#temp2;$j++){
		$temp2[$num_col-1] = $temp2[$num_col-1]." ".$temp2[$j];
	    }
	}
	print "<tr>\n";
	for ($j=0;$j<=$end_mark;$j++){
	    print "<td>";
	    print "$temp2[$j]";
	    print "</td>";
	}
	print "\n</tr>\n";
    }
    print "</table>\n";
}

#######################################################################
# Add Entrez link
#######################################################################
sub add_entrez_link{
  my ($line, $alphabet) = @_;
  my($return_value);

  $return_value = 
    "<A HREF=\'http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?db=";
  if ($alphabet eq "dna"){
    $return_value .= "Nucleotide";
  } else {
    $return_value .= "Protein";
  }
  $return_value .= "&amp;cmd=Search&amp;term=$line&amp;doptcmdl=GenBank\' TARGET =\'_blank\'>$line</a>";

  return($return_value);
} # add_entrez_link