[Bio] / FigKernelPackages / gjonewicklib.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/gjonewicklib.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13, Wed Jul 1 00:08:52 2009 UTC revision 1.15, Sun Sep 6 22:38:32 2009 UTC
# Line 203  Line 203 
203  #  $n_changed = newick_set_all_branches( $node, $x )  #  $n_changed = newick_set_all_branches( $node, $x )
204  #  $n_changed = newick_fix_negative_branches( $tree )  #  $n_changed = newick_fix_negative_branches( $tree )
205  #  $node      = newick_rescale_branches( $node, $factor )  #  $node      = newick_rescale_branches( $node, $factor )
206    #  $node      = newick_modify_branches( $node, \&function )
207    #  $node      = newick_modify_branches( $node, \&function, \@func_parms )
208  #  #
209  #  Modify comments:  #  Modify comments:
210  #  #
# Line 345  Line 347 
347          newick_set_all_branches          newick_set_all_branches
348          newick_fix_negative_branches          newick_fix_negative_branches
349          newick_rescale_branches          newick_rescale_branches
350            newick_modify_branches
351    
352          newick_strip_comments          newick_strip_comments
353    
# Line 1535  Line 1538 
1538    
1539    
1540  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
1541    #  Modify all branch lengths by a function.
1542    #
1543    #     $node = newick_modify_branches( $node, \&function )
1544    #     $node = newick_modify_branches( $node, \&function, \@func_parms )
1545    #
1546    #  Function must have form
1547    #
1548    #     $x2 = &$function( $x1 )
1549    #     $x2 = &$function( $x1, @$func_parms )
1550    #
1551    #-------------------------------------------------------------------------------
1552    sub newick_modify_branches {
1553        my ( $node, $func, $parm ) = @_;
1554    
1555        set_newick_x( $node, &$func( newick_x( $node ), ( $parm ? @$parm : () ) ) );
1556        foreach ( newick_desc_list( $node ) )
1557        {
1558            newick_modify_branches( $_, $func, $parm )
1559        }
1560    
1561        $node;
1562    }
1563    
1564    
1565    #-------------------------------------------------------------------------------
1566  #  Set negative branches to zero.  The original tree is modfied.  #  Set negative branches to zero.  The original tree is modfied.
1567  #  #
1568  #  $n_changed = newick_fix_negative_branches( $tree )  #  $n_changed = newick_fix_negative_branches( $tree )
# Line 1972  Line 2000 
2000      #  Trim the common prefix, saving it:      #  Trim the common prefix, saving it:
2001    
2002      my @prefix = ();      my @prefix = ();
2003      while ( $path1[1] == $path2[1] )      while ( defined( $path1[1] ) && defined( $path2[1] ) && ( $path1[1] == $path2[1] ) )
2004      {      {
2005          push @prefix, splice( @path1, 0, 2 );          push @prefix, splice( @path1, 0, 2 );
2006          splice( @path2, 0, 2 );          splice( @path2, 0, 2 );
# Line 3362  Line 3390 
3390  }  }
3391    
3392    
3393    #===============================================================================
3394    #  Character sets for printer plot trees:
3395  #-------------------------------------------------------------------------------  #-------------------------------------------------------------------------------
3396  #  Character sets for tree:  
 #-------------------------------------------------------------------------------  
 my $default_chars = 'text1';  
3397  my %char_set =  my %char_set =
3398    ( text1     => { space  => ' ',    ( text1     => { space  => ' ',
3399                     horiz  => '-',                     horiz  => '-',
# Line 3384  Line 3412 
3412                     half_d => '|',                     half_d => '|',
3413                     cross  => '+',                     cross  => '+',
3414                   },                   },
     html1     => { space  => ' ',  
                    horiz  => '-',  
                    vert   => '|',  
                    el_d_r => '/',  
                    el_u_r => '\\',  
                    el_d_l => '\\',  
                    el_u_l => '/',  
                    tee_l  => '+',  
                    tee_r  => '+',  
                    tee_u  => '+',  
                    tee_d  => '+',  
                    half_l => '-',  
                    half_r => '-',  
                    half_u => '|',  
                    half_d => '|',  
                    cross  => '+',  
                  },  
3415      text2     => { space  => ' ',      text2     => { space  => ' ',
3416                     horiz  => '-',                     horiz  => '-',
3417                     vert   => '|',                     vert   => '|',
# Line 3418  Line 3429 
3429                     half_d => '|',                     half_d => '|',
3430                     cross  => '+',                     cross  => '+',
3431                   },                   },
3432      html2     => { space  => ' ',      html_box  => { space  => ' ',
                    horiz  => '-',  
                    vert   => '|',  
                    el_d_r => '+',  
                    el_u_r => '+',  
                    el_d_l => '+',  
                    el_u_l => '+',  
                    tee_l  => '+',  
                    tee_r  => '+',  
                    tee_u  => '+',  
                    tee_d  => '+',  
                    half_l => '-',  
                    half_r => '-',  
                    half_u => '|',  
                    half_d => '|',  
                    cross  => '+',  
                  },  
     utf8_symb => { space  => ' ',  
                    horiz  => chr(226) . chr(148) . chr(128),  
                    vert   => chr(226) . chr(148) . chr(130),  
                    el_d_r => chr(226) . chr(148) . chr(140),  
                    el_u_r => chr(226) . chr(148) . chr(148),  
                    el_d_l => chr(226) . chr(148) . chr(144),  
                    el_u_l => chr(226) . chr(148) . chr(152),  
                    tee_l  => chr(226) . chr(148) . chr(164),  
                    tee_r  => chr(226) . chr(148) . chr(156),  
                    tee_u  => chr(226) . chr(148) . chr(180),  
                    tee_d  => chr(226) . chr(148) . chr(172),  
                    half_l => chr(226) . chr(149) . chr(180),  
                    half_r => chr(226) . chr(149) . chr(182),  
                    half_u => chr(226) . chr(149) . chr(181),  
                    half_d => chr(226) . chr(149) . chr(183),  
                    cross  => chr(226) . chr(148) . chr(188),  
                  },  
     html_symb => { space  => ' ',  
3433                     horiz  => '─',                     horiz  => '─',
3434                     vert   => '│',                     vert   => '│',
3435                     el_d_r => '┌',                     el_d_r => '┌',
# Line 3469  Line 3446 
3446                     half_d => '╷',                     half_d => '╷',
3447                     cross  => '┼',                     cross  => '┼',
3448                   },                   },
3449      html_tbl  => { space  => '<TD>&nbsp;</TD>',      utf8_box  => { space  => ' ',
3450                     horiz  => '<TD>&#9472;</TD>',                     horiz  => chr(226) . chr(148) . chr(128),
3451                     vert   => '<TD>&#9474;</TD>',                     vert   => chr(226) . chr(148) . chr(130),
3452                     el_d_r => '<TD>&#9484;</TD>',                     el_d_r => chr(226) . chr(148) . chr(140),
3453                     el_u_r => '<TD>&#9492;</TD>',                     el_u_r => chr(226) . chr(148) . chr(148),
3454                     el_d_l => '<TD>&#9488;</TD>',                     el_d_l => chr(226) . chr(148) . chr(144),
3455                     el_u_l => '<TD>&#9496;</TD>',                     el_u_l => chr(226) . chr(148) . chr(152),
3456                     tee_l  => '<TD>&#9508;</TD>',                     tee_l  => chr(226) . chr(148) . chr(164),
3457                     tee_r  => '<TD>&#9500;</TD>',                     tee_r  => chr(226) . chr(148) . chr(156),
3458                     tee_u  => '<TD>&#9524;</TD>',                     tee_u  => chr(226) . chr(148) . chr(180),
3459                     tee_d  => '<TD>&#9516;</TD>',                     tee_d  => chr(226) . chr(148) . chr(172),
3460                     half_l => '<TD>&#9588;</TD>',                     half_l => chr(226) . chr(149) . chr(180),
3461                     half_r => '<TD>&#9590;</TD>',                     half_r => chr(226) . chr(149) . chr(182),
3462                     half_u => '<TD>&#9589;</TD>',                     half_u => chr(226) . chr(149) . chr(181),
3463                     half_d => '<TD>&#9591;</TD>',                     half_d => chr(226) . chr(149) . chr(183),
3464                     cross  => '<TD>&#9532;</TD>',                     cross  => chr(226) . chr(148) . chr(188),
3465                   },                   },
3466    );    );
3467    
3468    %{ $char_set{ html1 } } = %{ $char_set{ text1 } };
3469    $char_set{ html1 }->{ space } = '&nbsp;';
3470    
3471    %{ $char_set{ html2 } } = %{ $char_set{ text2 } };
3472    $char_set{ html2 }->{ space } = '&nbsp;';
3473    
3474  #  Define some synonyms  #  Define some synonyms
3475  $char_set{ html } = $char_set{ html_symb };  
3476  $char_set{ line } = $char_set{ html_symb };  $char_set{ html } = $char_set{ html_box };
3477  $char_set{ symb } = $char_set{ html_symb };  $char_set{ line } = $char_set{ utf8_box };
3478    $char_set{ symb } = $char_set{ utf8_box };
3479  $char_set{ text } = $char_set{ text1 };  $char_set{ text } = $char_set{ text1 };
3480  $char_set{ utf8 } = $char_set{ utf8_symb };  $char_set{ utf8 } = $char_set{ utf8_box };
3481    
3482    #  Define tree formats and synonyms
3483    
3484    my %tree_format =
3485        ( text         => 'text',
3486          tree_tab_lbl => 'tree_tab_lbl',
3487          tree_lbl     => 'tree_lbl',
3488          chrlist_lbl  => 'chrlist_lbl',
3489          raw          => 'chrlist_lbl',
3490        );
3491    
3492  #===============================================================================  #===============================================================================
3493  #  Make a text plot of a tree:  #  Make a text plot of a tree:
# Line 3509  Line 3502 
3502  #  #
3503  #  Options:  #  Options:
3504  #  #
3505    #    chars  => keyword       # the output character set for the tree
3506  #    dy     => nat_number    # the vertical space per taxon  #    dy     => nat_number    # the vertical space per taxon
3507  #    chars  => key           # line drawing character set:  #    format => keyword       # output format of each line
 #                            #     html_unicode  
 #                            #     text (default)  
3508  #    min_dx => whole_number  # the minimum horizontal branch length  #    min_dx => whole_number  # the minimum horizontal branch length
3509  #    width  => whole_number  # approximate tree width without labels  #    width  => whole_number  # approximate tree width without labels
3510  #  #
3511    #  Character sets:
3512    #
3513    #    html       #  synonym of html1
3514    #    html_box   #  html encoding of unicode box drawing characters
3515    #    html1      #  text1 with nonbreaking spaces
3516    #    html2      #  text2 with nonbreaking spaces
3517    #    line       #  synonym of utf8_box
3518    #    raw        #  pass out the internal representation
3519    #    symb       #  synonym of utf8_box
3520    #    text       #  synonym of text1 (Default)
3521    #    text1      #  ascii characters: - + | / \ and space
3522    #    text2      #  ascii characters: - + | + + and space
3523    #    utf8       #  synonym of utf8_box
3524    #    utf8_box   #  utf8 encoding of unicode box drawing characters
3525    #
3526    #  Formats for row lines:
3527    #
3528    #    text           #    $textstring              # Default
3529    #    tree_tab_lbl   #    $treestr \t $labelstr
3530    #    tree_lbl       # [  $treestr,  $labelstr ]
3531    #    chrlist_lbl    # [ \@treechar, $labelstr ]   # Forced with raw chars
3532    #    raw            #  synonym of chrlist_lbl
3533    #
3534  #===============================================================================  #===============================================================================
3535  sub text_plot_newick  sub text_plot_newick
3536  {  {
3537      my $node = shift @_;      my $node = shift @_;
3538      array_ref( $node ) || die "Bad node passed to text_plot_newick\n";      array_ref( $node ) || die "Bad node passed to text_plot_newick\n";
3539    
3540      my ( $opts, $width, $min_dx, $dy, $chars, $cells );      my ( $opts, $width, $min_dx, $dy, $chars, $fmt );
3541      if ( $_[0] && ref $_[0] eq 'HASH' )      if ( $_[0] && ref $_[0] eq 'HASH' )
3542      {      {
3543          $opts = shift;          $opts = shift;
3544      }      }
3545      else      else
3546      {      {
         $opts = {};  
3547          ( $width, $min_dx, $dy ) = @_;          ( $width, $min_dx, $dy ) = @_;
3548            $opts = {};
3549      }      }
3550    
3551      $chars  = $opts->{ chars  } if defined $opts->{ chars  };      $chars = $opts->{ chars } || '';
3552      $dy     = $opts->{ dy     } if defined $opts->{ dy     };      my $charH;
3553      $min_dx = $opts->{ min_dx } if defined $opts->{ min_dx };      $charH = $char_set{ $chars } || $char_set{ 'text1' } if ( $chars ne 'raw' );
3554      $width  = $opts->{ width  } if defined $opts->{ width  };      my $is_box = $charH eq $char_set{ html_box }
3555      $cells  = $opts->{ cells  } if defined $opts->{ cells  };                || $charH eq $char_set{ utf8_box }
3556                  || $chars eq 'raw';
3557      defined( $chars ) and ( $char_set{ $chars } ) or $chars = $default_chars;  
3558      my $ch = $char_set{ $chars };      $fmt = ( $chars eq 'raw' ) ? 'chrlist_lbl' : $opts->{ format };
3559        $fmt = $tree_format{ $fmt || '' } || 'text';
3560      defined(     $dy ) and (     $dy >=  1 ) or     $dy =  1;  
3561      defined( $min_dx ) and ( $min_dx >=  0 ) or $min_dx =  2;      $dy    ||= $opts->{ dy     } ||  1;
3562      defined(  $width ) and (  $width >=  1 ) or  $width = 68;      $width ||= $opts->{ width  } || 68;
3563        $min_dx  = $opts->{ min_dx } if ( ! defined $min_dx || $min_dx < 0 );
3564        $min_dx  = $is_box ? 1 : 2   if ( ! defined $min_dx || $min_dx < 0 );
3565    
3566        #  Layout the tree:
3567    
3568      $min_dx = int( $min_dx );      $min_dx = int( $min_dx );
3569      $dy     = int( $dy );      $dy     = int( $dy );
# Line 3553  Line 3572 
3572      my $hash = {};      my $hash = {};
3573      layout_printer_plot( $node, $hash, 0, -0.5 * $dy, $x_scale, $min_dx, $dy );      layout_printer_plot( $node, $hash, 0, -0.5 * $dy, $x_scale, $min_dx, $dy );
3574    
3575      # dump_tree_hash( $node, $hash ); exit;      #  Generate the lines of the tree-one by-one:
   
     #  Generate the lines of the tree one by one:  
3576    
3577      my ( $y1, $y2 ) = @{ $hash->{ $node } };      my ( $y1, $y2 ) = @{ $hash->{ $node } };
3578        my @lines;
3579      my @lines = map { text_tree_row( $node, $hash, $_, [], $ch->{tee_l} , $ch ) } ( $y1 .. $y2 );      foreach ( ( $y1 .. $y2 ) )
     if ( $cells )  
     {  
         my $nmax = 0;  
         foreach ( @lines ) { $nmax = @$_ if @$_ > $nmax }  
         foreach ( @lines )  
3580          {          {
3581              @$_ = map { "<TD>$_</TD>" } @$_;          my $line = text_tree_row( $node, $hash, $_, [], 'tee_l' );
3582              my $span = $nmax - @$_ + 1;          my $lbl  = '';
3583              $_->[-1] =~ s/^<TD>/<TD NoWrap ColSpan=$span>/;          if ( @$line )
3584          }          {
3585      }              if ( $line->[-1] eq '' ) { pop @$line; $lbl = pop @$line }
3586                #  Translate tree characters
3587                @$line = map { $charH->{ $_ } } @$line if $chars ne 'raw';
3588            }
3589    
3590            # Convert to requested output format:
3591    
3592            push @lines, $fmt eq 'text'         ? join( '', @$line, ( $lbl ? " $lbl" : () ) )
3593                       : $fmt eq 'text_tab_lbl' ? join( '', @$line, "\t", $lbl )
3594                       : $fmt eq 'tree_lbl'     ? [ join( '', @$line ), $lbl ]
3595                       : $fmt eq 'chrlist_lbl'  ? [ $line, $lbl ]
3596                       :                          ();
3597        }
3598    
3599        # if ( $cells )
3600        # {
3601        #     my $nmax = 0;
3602        #     foreach ( @lines ) { $nmax = @$_ if @$_ > $nmax }
3603        #     foreach ( @lines )
3604        #     {
3605        #         @$_ = map { "<TD>$_</TD>" } @$_;
3606        #         my $span = $nmax - @$_ + 1;
3607        #         $_->[-1] =~ s/^<TD>/<TD NoWrap ColSpan=$span>/;
3608        #     }
3609        # }
3610        # elsif ( $tables )
3611        # {
3612        #     my $nmax = 0;
3613        #     foreach ( @lines ) { $nmax = @$_ if @$_ > $nmax }
3614        #     foreach ( @lines )
3615        #     {
3616        #         @$_ = map { "<TD>$_</TD>" } @$_;
3617        #         my $span = $nmax - @$_ + 1;
3618        #         $_->[-1] =~ s/^<TD>/<TD NoWrap ColSpan=$span>/;
3619        #     }
3620        # }
3621    
3622      map { join '', @$_ } @lines;      wantarray ? @lines : \@lines;
3623  }  }
3624    
3625    
3626  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3627  #  ( $xmax, $ymax, $root_y ) = layout_printer_plot( $node, $hash, $x0, $y0, $x_scale, $min_dx, $dy )  #  ( $xmax, $ymax, $root_y ) = layout_printer_plot( $node, $hash, $x0, $y0, $x_scale, $min_dx, $dy, $yrnd )
3628  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3629  sub layout_printer_plot  sub layout_printer_plot
3630  {  {
3631      my ( $node, $hash, $x0, $y0, $x_scale, $min_dx, $dy ) = @_;      my ( $node, $hash, $x0, $y0, $x_scale, $min_dx, $dy, $yrnd ) = @_;
3632      array_ref( $node ) || die "Bad node ref passed to layout_printer_plot\n";      array_ref( $node ) || die "Bad node ref passed to layout_printer_plot\n";
3633      hash_ref(  $hash ) || die "Bad hash ref passed to layout_printer_plot\n";      hash_ref(  $hash ) || die "Bad hash ref passed to layout_printer_plot\n";
3634    
3635      my $dx = newick_x( $node );      my $dx = newick_x( $node );
3636      if ( defined( $dx ) ) {      if ( defined( $dx ) ) {
3637          $dx *= $x_scale;          $dx *= $x_scale;
3638          $dx >= $min_dx or $dx = $min_dx;          $dx = $min_dx if $dx < $min_dx;
3639      }      }
3640      else {      else {
3641          $dx = ( $x0 > 0 ) ? $min_dx : 0;          $dx = ( $x0 > 0 ) ? $min_dx : 0;
# Line 3614  Line 3662 
3662          $ymax = $y0;          $ymax = $y0;
3663    
3664          foreach ( @dl ) {          foreach ( @dl ) {
3665              ( $xmaxi, $ymax, $yi ) = layout_printer_plot( $_, $hash, $x, $ymax, $x_scale, $min_dx, $dy );              ( $xmaxi, $ymax, $yi ) = layout_printer_plot( $_, $hash, $x, $ymax, $x_scale, $min_dx, $dy,
3666                                                              ( 2*@ylist < @dl ? 0.5001 : 0.4999 )
3667                                                            );
3668              push @ylist, $yi;              push @ylist, $yi;
3669              if ( $xmaxi > $xmax ) { $xmax = $xmaxi }              if ( $xmaxi > $xmax ) { $xmax = $xmaxi }
3670          }          }
# Line 3624  Line 3674 
3674    
3675          $yn1 = $ylist[ 0];          $yn1 = $ylist[ 0];
3676          $yn2 = $ylist[-1];          $yn2 = $ylist[-1];
3677          $y = int( 0.5 * ( $yn1 + $yn2 ) + 0.4999 );          $y = int( 0.5 * ( $yn1 + $yn2 ) + ( $yrnd || 0.4999 ) );
3678      }      }
3679    
3680      $y2 = int( $ymax - 0.5 * $dy + 0.4999 );      $y2 = int( $ymax - 0.5 * $dy + 0.4999 );
# Line 3634  Line 3684 
3684  }  }
3685    
3686    
3687    #  What symbol do we get if we add a leftward line to some other symbol?
3688    
3689    my %with_left_line = ( space  => 'half_l',
3690                           horiz  => 'horiz',
3691                           vert   => 'tee_l',
3692                           el_d_r => 'tee_d',
3693                           el_u_r => 'tee_u',
3694                           el_d_l => 'el_d_l',
3695                           el_u_l => 'el_u_l',
3696                           tee_l  => 'tee_l',
3697                           tee_r  => 'cross',
3698                           tee_u  => 'tee_u',
3699                           tee_d  => 'tee_d',
3700                           half_l => 'half_l',
3701                           half_r => 'horiz',
3702                           half_u => 'el_u_l',
3703                           half_d => 'el_d_l',
3704                           cross  => 'cross',
3705                         );
3706    
3707  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3708  #  \@line = text_tree_row( $node, $hash, $row, \@line, $symb, \%chars )  #  Produce a description of one line of a printer plot tree.
3709    #
3710    #  \@line = text_tree_row( $node, $hash, $row, \@line, $symb )
3711    #
3712    #     \@line is the character descriptions accumulated so far, one per array
3713    #          element, except for a label, which can be any number of characters.
3714    #          Labels are followed by an empty string, so if $line->[-1] eq '',
3715    #          then $line->[-2] is a label. The calling program translates the
3716    #          symbol names to output characters.
3717    #
3718    #     \@node is a newick tree node
3719    #     \%hash contains tree layout information
3720    #      $row  is the row number (y value) that we are building
3721    #      $symb is the plot symbol proposed for the current x and y position
3722    #
3723  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3724  sub text_tree_row  sub text_tree_row
3725  {  {
3726      my ( $node, $hash, $row, $line, $symb, $ch ) = @_;      my ( $node, $hash, $row, $line, $symb ) = @_;
3727    
3728      my ( $y1, $y2, $x0, $x, $y, $yn1, $yn2 ) = @{ $hash->{ $node } };      my ( $y1, $y2, $x0, $x, $y, $yn1, $yn2 ) = @{ $hash->{ $node } };
3729      if ( $row < $y1 || $row > $y2 ) { return $line }      if ( $row < $y1 || $row > $y2 ) { return $line }
3730    
3731      if ( @$line < $x0 ) { push @$line, ($ch->{space}) x ( $x0 - @$line ) }      if ( @$line < $x0 ) { push @$line, ('space') x ( $x0 - @$line ) }
3732    
3733      if ( $row == $y ) {      if ( $row == $y ) {
3734          @$line = ( @$line[ 0 .. $x0-1 ],          while ( @$line > $x0 ) { pop @$line }  # Actually 0-1 times
3735                     $symb,          push @$line, $symb,
3736                     ( ( $x > $x0 ) ? ($ch->{horiz}) x ($x - $x0) : () )                       ( ( $x > $x0 ) ? ('horiz') x ($x - $x0) : () );
                  );  
3737      }      }
3738    
3739      elsif ( $row > $yn1 && $row < $yn2 ) {      elsif ( $row > $yn1 && $row < $yn2 ) {
3740          if ( @$line < $x ) { push @$line, ($ch->{space}) x ( $x - @$line ), $ch->{vert} }          if ( @$line < $x ) { push @$line, ('space') x ( $x - @$line ), 'vert' }
3741          else               { $line->[$x] = $ch->{vert} }          else               { $line->[$x] = 'vert' }
3742      }      }
3743    
3744      my @dl = newick_desc_list( $node );      my @dl = newick_desc_list( $node );
3745    
3746      if ( @dl < 1 ) {      if ( @dl < 1 ) { push @$line, ( newick_lbl( $node ) || '' ), '' }
         push @$line, $ch->{space}, newick_lbl( $node );  
     }  
3747    
3748      else {      else {
3749          my @list = map { [ $_, $ch->{tee_r} ] } @dl;  # Line to the right          my @list = map { [ $_, 'tee_r' ] } @dl;  # Line to the right
3750          $list[ 0]->[1] = $ch->{el_d_r};          if ( @list > 1 ) { #  Fix top and bottom sympbols
3751          $list[-1]->[1] = $ch->{el_u_r};              $list[ 0]->[1] = 'el_d_r';
3752                $list[-1]->[1] = 'el_u_r';
3753            }
3754            elsif ( @list ) {  # Only one descendent
3755                $list[ 0]->[1] = 'half_r';
3756            }
3757          foreach ( @list ) {          foreach ( @list ) {
3758              my ( $n, $s ) = @$_;              my ( $n, $s ) = @$_;
3759              if ( $row >= $hash->{ $n }->[0] && $row <= $hash->{ $n }->[1] ) {              if ( $row >= $hash->{ $n }->[0] && $row <= $hash->{ $n }->[1] ) {
3760                  $line = text_tree_row( $n, $hash, $row, $line, $s, $ch );                  $line = text_tree_row( $n, $hash, $row, $line, $s );
3761              }              }
3762           }           }
3763    
3764          if ( $row == $y )          if ( $row == $y ) {
3765          {              $line->[$x] = ( $line->[$x] eq 'horiz' ) ? 'tee_l'
3766              if ( $line->[$x] eq $ch->{horiz} )                                                       : $with_left_line{ $line->[$x] };
             {  
                 $line->[$x] = $ch->{tee_l};  
             }  
             else  
             {  
                 $line->[$x] = add_left_line( $ch, $line->[$x] );  
             }  
3767          }          }
3768      }      }
3769    
# Line 3693  Line 3771 
3771  }  }
3772    
3773    
 #  To correctly resolve an ambuiguity, order matters:  
   
 my @symbs = qw( space   horiz   vert    cross  
                 el_d_l  el_u_l  el_d_r  el_u_r  
                 tee_l   tee_r   tee_u   tee_d  
                 half_l  half_r  half_u  half_d  
               );  
   
 my %with_left = ( space  => 'half_l',  
                   horiz  => 'horiz',  
                   vert   => 'tee_l',  
                   el_d_r => 'tee_d',  
                   el_u_r => 'tee_u',  
                   el_d_l => 'el_d_l',  
                   el_u_l => 'el_u_l',  
                   tee_l  => 'tee_l',  
                   tee_r  => 'cross',  
                   tee_u  => 'tee_u',  
                   tee_d  => 'tee_d',  
                   half_l => 'half_l',  
                   half_r => 'horiz',  
                   half_u => 'el_u_l',  
                   half_d => 'el_d_l',  
                   cross  => 'cross',  
                 );  
   
 my %add_left;  
   
 sub add_left_line  
 {  
     my ( $ch, $c ) = @_;  
   
     #  Build the translation table for the character set, if necessary:  
     if ( ! $add_left{ $ch } )  
     {  
         %{ $add_left{ $ch } } = map { $ch->{ $_ } => $ch->{ $with_left{ $_ } } }  
                                 @symbs;  
     }  
   
     return $add_left{ $ch }->{ $c };  
 }  
   
   
3774  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3775  #  Debug routine  #  Debug routine
3776  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  #- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.15

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3