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

Diff of /FigKernelPackages/gd_tree_0.pm

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

revision 1.2, Thu Jun 25 01:19:29 2009 UTC revision 1.3, Sat Feb 6 01:30:44 2010 UTC
# Line 25  Line 25 
25  use gjonewicklib;  use gjonewicklib;
26  use strict;  use strict;
27    
28  # my $string = '((A:1,B:2):3,(C:2,M:4):2);';  #  $string = '((A:1,B:2):3,(C:2,M:4):2);';
29  # my $tree = parse_newick_tree_str( $string );  #  $tree = parse_newick_tree_str( $string );
30  # newick_gd_png( $tree, { bkg_color => [255,255,0] } );  #
31    #  $gd_image = gd_tree::gd_plot_newick( $tree, { bkg_color => [255,255,0] } );
32    #  print $gd_image->png;
33    #  print $gd_image->jpg;
34    #
35    #  gd_tree::newick_gd_png( $tree, { bkg_color => [255,255,0] } );  #  \*STDOUT
36    #  gd_tree::newick_gd_jpg( $tree, { bkg_color => [255,255,0] } );
37    #
38    #  $bool = gd_tree::gd_has_png()
39    #  $bool = gd_tree::gd_has_jpg()
40    #  \%fmt = gd_tree::gd_formats()  # hash keys: gd, jpg and png
41    
42    {
43        my $has_png;
44        my $has_jpg;
45        my %has = ();
46    
47        sub gd_has_png
48        {
49            return $has_png if defined $has_png;
50            return $has_png = $has{ png } if keys %has;
51            my $image = new GD::Image( 1, 1 );
52            $image->colorAllocate( 255, 255, 255 );
53            $has_png = 0;
54            eval { $image->png; $has_png = 1; };
55            $has_png;
56        }
57    
58        sub gd_has_jpg
59        {
60            return $has_jpg if defined $has_jpg;
61            return $has_jpg = $has{ jpg } if keys %has;
62            my $image = new GD::Image( 1, 1 );
63            $image->colorAllocate( 255, 255, 255 );
64            $has_jpg = 0;
65            eval { $image->jpg; $has_jpg = 1; };
66            $has_jpg;
67        }
68    
69        sub gd_formats
70        {
71            if ( ! keys %has )
72            {
73                my $image = new GD::Image( 1, 1 );
74                $image->colorAllocate( 255, 255, 255 );
75                foreach my $fmt ( qw( jpg png gd ) )
76                {
77                    $has{$fmt} = 0;
78                    eval { $image->$fmt; $has{$fmt} = 1; };
79                }
80            }
81            \%has;
82        }
83    }
84    
85    
86  #===============================================================================  #===============================================================================
87  #  newick_gd_png( $node, \%options )  #  newick_gd_png( $tree, \%options )
88  #===============================================================================  #===============================================================================
89  sub newick_gd_png  sub newick_gd_png
90  {  {
# Line 57  Line 111 
111    
112    
113  #===============================================================================  #===============================================================================
114    #  newick_gd_jpg( $tree, \%options )
115    #===============================================================================
116    sub newick_gd_jpg
117    {
118        my ( $tree, $options ) = @_;
119    
120        $options ||= {};
121        my $file = $options->{ file };
122        my $fh;
123        if    ( ! $file )                { $fh = \*STDOUT }
124        elsif ( ref( $file ) eq 'GLOB' ) { $fh = $file }
125        else
126        {
127            open( $fh, ">$file" )
128                or print STERR "Could not open $file.\n" and return 0;
129        }
130    
131        my $image = gd_plot_newick( $tree, $options );
132    
133        print $fh $image->jpg;
134    
135        close( $fh ) if $file && ! ref( $file );
136        return 1;
137    }
138    
139    
140    #===============================================================================
141  #  Make a GD plot of a tree:  #  Make a GD plot of a tree:
142  #  #
143  #    $gd_image          = gd_plot_newick( $node, \%options );  #    $gd_image          = gd_plot_newick( $node, \%options );

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3