[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.1, Mon Jun 22 18:46:20 2009 UTC revision 1.4, Sat Feb 6 23:01:21 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 1;
61            return $has_jpg if defined $has_jpg;
62            return $has_jpg = $has{ jpg } if keys %has;
63            my $image = new GD::Image( 1, 1 );
64            $image->colorAllocate( 255, 255, 255 );
65            $has_jpg = 0;
66            eval { $image->jpeg; $has_jpg = 1; };
67            $has_jpg;
68        }
69    
70        sub gd_formats
71        {
72            if ( ! keys %has )
73            {
74                my $image = new GD::Image( 1, 1 );
75                $image->colorAllocate( 255, 255, 255 );
76                foreach my $fmt ( qw( jpg png gd ) )
77                {
78                    $has{$fmt} = 0;
79                    eval { $image->$fmt; $has{$fmt} = 1; };
80                }
81            }
82            \%has;
83        }
84    }
85    
86    
87  #===============================================================================  #===============================================================================
88  #  newick_gd_png( $node, \%options )  #  newick_gd_png( $tree, \%options )
89  #===============================================================================  #===============================================================================
90  sub newick_gd_png  sub newick_gd_png
91  {  {
92      my ( $tree, $options ) = @_;      my ( $tree, $options ) = @_;
93    
94        $options ||= {};
95        my $file = $options->{ file };
96        my $fh;
97        if    ( ! $file )                { $fh = \*STDOUT }
98        elsif ( ref( $file ) eq 'GLOB' ) { $fh = $file }
99        else
100        {
101            open( $fh, ">$file" )
102                or print STERR "Could not open $file.\n" and return 0;
103        }
104    
105        my $image = gd_plot_newick( $tree, $options );
106    
107        print $fh $image->png;
108    
109        close( $fh ) if $file && ! ref( $file );
110        return 1;
111    }
112    
113    
114    #===============================================================================
115    #  newick_gd_jpg( $tree, \%options )
116    #===============================================================================
117    sub newick_gd_jpg
118    {
119        my ( $tree, $options ) = @_;
120    
121        $options ||= {};
122        my $file = $options->{ file };
123        my $fh;
124        if    ( ! $file )                { $fh = \*STDOUT }
125        elsif ( ref( $file ) eq 'GLOB' ) { $fh = $file }
126        else
127        {
128            open( $fh, ">$file" )
129                or print STERR "Could not open $file.\n" and return 0;
130        }
131    
132      my $image = gd_plot_newick( $tree, $options );      my $image = gd_plot_newick( $tree, $options );
133    
134      binmode STDOUT;      print $fh $image->jpg;
135      print $image->png;  
136        close( $fh ) if $file && ! ref( $file );
137        return 1;
138  }  }
139    
140    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3