1#!perl 2use Config; 3use File::Basename qw(&basename &dirname); 4use Cwd; 5 6my $DEFINES = ''; 7my $VERSION = ''; 8if (open F,".config.cache") { 9 chomp($DEFINES = <F>); 10 close F; 11} 12 13my $origdir = cwd; 14chdir dirname($0); 15my $file = 'Image.pm'; 16 17open OUT,">",$file or die "Can't create $file: $!"; 18 19print "Extracting $file (with variable substitutions)\n"; 20 21print OUT <<"!GROK!THIS!"; 22# DO NOT EDIT! THIS FILE IS AUTOGENERATED BY $0 23!GROK!THIS! 24 25print OUT << '!NO!SUBS!'; 26package GD::Image; 27 28use strict; 29use GD; 30use Symbol 'gensym','qualify_to_ref'; 31use vars '$VERSION'; 32$VERSION = '2.73'; 33 34=head1 NAME 35 36GD::Image - Image class for the GD image library 37 38=head1 SYNOPSIS 39 40See L<GD> 41 42=head1 DESCRIPTION 43 44See L<GD> 45 46=head1 AUTHOR 47 48The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is 49distributed under the same terms as Perl itself. See the "Artistic 50License" in the Perl source code distribution for licensing terms. 51 52The latest versions of GD.pm are available on CPAN: 53 54 http://www.cpan.org 55 56=head1 SEE ALSO 57 58L<GD> 59L<GD::Polyline>, 60L<GD::SVG>, 61L<GD::Simple>, 62L<Image::Magick> 63 64=cut 65 66# Copyright 1995 Lincoln D. Stein. See accompanying README file for 67# usage information 68 69*stringTTF = \&GD::Image::stringFT; 70 71sub _make_filehandle { 72 shift; # get rid of class 73 no strict 'refs'; 74 my $thing = shift; 75 return $thing if defined(fileno $thing); 76 77 # otherwise try qualifying it into caller's package 78 my $fh; 79 { 80 local $^W = 0; # to avoid uninitialized variable warning from Symbol.pm 81 $fh = qualify_to_ref($thing,caller(2)); 82 } 83 return $fh if defined(fileno $fh); 84 85 # otherwise treat it as a file to open 86 $fh = gensym; 87 if (!open($fh,$thing)) { 88 die "$thing not found: $!"; 89 return undef; 90 } 91 return $fh; 92} 93 94sub new { 95 my $pack = shift; 96 if (@_ == 1) { 97 if (my $type = _image_type($_[0])) { 98 my $method = "newFrom${type}Data"; 99 return unless $pack->can($method); 100 return $pack->$method($_[0]); 101 } 102 return unless my $fh = $pack->_make_filehandle($_[0]); 103 my $magic; 104 return unless read($fh,$magic,4); 105 return unless my $type = _image_type($magic); 106 seek($fh,0,0); 107 my $method = "newFrom${type}"; 108 return $pack->$method($fh); 109 } 110 return $pack->_new(@_); 111} 112 113sub newTrueColor { 114 my $pack = shift; 115 return $pack->_new(@_, 1); 116} 117 118sub newPalette { 119 my $pack = shift; 120 return $pack->_new(@_, 0); 121} 122 123sub newFromGd { 124 croak("Usage: newFromGd(class,filehandle)") unless @_==2; 125 my($class,$f) = @_; 126 my $fh = $class->_make_filehandle($f); 127 binmode($fh); 128 $class->_newFromGd($fh); 129} 130 131sub newFromGd2 { 132 croak("Usage: newFromGd2(class,filehandle)") unless @_==2; 133 my($class,$f) = @_; 134 my $fh = $class->_make_filehandle($f); 135 binmode($fh); 136 $class->_newFromGd2($fh); 137} 138 139sub newFromGd2Part { 140 croak("Usage: newFromGd2(class,filehandle,srcX,srcY,width,height)") unless @_==6; 141 my($class,$f) = splice(@_,0,2); 142 my $fh = $class->_make_filehandle($f); 143 binmode($fh); 144 $class->_newFromGd2Part($fh,@_); 145} 146 147sub ellipse ($$$$$) { 148 my ($self,$cx,$cy,$width,$height,$color) = @_; 149 $self->arc($cx,$cy,$width,$height,0,360,$color); 150} 151 152# draws closed polygon with the specified color 153sub polygon { 154 my $self = shift; 155 my($p,$c) = @_; 156 $self->openPolygon($p, $c); 157 $self->line( @{$p->{'points'}->[0]}, 158 @{$p->{'points'}->[$p->{'length'}-1]}, $c); 159} 160 161sub width { 162 my $self = shift; 163 my @bounds = $self->getBounds; 164 $bounds[0]; 165} 166 167sub height { 168 my $self = shift; 169 my @bounds = $self->getBounds; 170 $bounds[1]; 171} 172 173sub _image_type { 174 my $data = shift; 175 my $magic = substr($data,0,4); 176 return 'Png' if $magic eq "\x89PNG"; 177 return 'Jpeg' if ((substr($data,0,3) eq "\377\330\377") && 178 ord(substr($data,3,1)) >= 0xc0); 179 return 'Gif' if $magic eq "GIF8"; 180 return 'Gd2' if $magic eq "gd2\000"; 181 return 'Xpm' if substr($data,0,9) eq "/* XPM */"; 182 return; 183} 184 185 186sub clone { 187 croak("Usage: clone(\$image)") unless @_ == 1; 188 my $self = shift; 189 my ($x,$y) = $self->getBounds; 190 my $new = $self->new($x,$y); 191 return unless $new; 192 $new->copy($self,0,0,0,0,$x,$y); 193 return $new; 194} 195 196!NO!SUBS! 197 198if ($DEFINES =~ /HAVE_PNG/) { 199 print OUT <<'!NO!SUBS!' 200sub newFromPng { 201 croak("Usage: newFromPng(class,filehandle,[truecolor])") unless @_>=2; 202 my($class) = shift; 203 my($f) = shift; 204 my $fh = $class->_make_filehandle($f); 205 binmode($fh); 206 $class->_newFromPng($fh,@_); 207} 208 209!NO!SUBS! 210} 211 212if ($DEFINES =~ /HAVE_JPEG/) { 213 print OUT <<'!NO!SUBS!' 214sub newFromJpeg { 215 croak("Usage: newFromJpeg(class,filehandle,[truecolor])") unless @_>=2; 216 my($class) = shift; 217 my($f) = shift; 218 my $fh = $class->_make_filehandle($f); 219 binmode($fh); 220 $class->_newFromJpeg($fh,@_); 221} 222 223!NO!SUBS! 224} 225 226if ($DEFINES =~ /HAVE_GIF/) { 227 print OUT <<'!NO!SUBS!' 228sub newFromGif { 229 croak("Usage: newFromGif(class,filehandle,[truecolor])") unless @_>=2; 230 my($class) = shift; 231 my($f) = shift; 232 my $fh = $class->_make_filehandle($f); 233 binmode($fh); 234 $class->_newFromGif($fh,@_); 235} 236 237!NO!SUBS! 238} 239 240if ($DEFINES =~ /HAVE_XBM/) { 241 print OUT <<'!NO!SUBS!' 242sub newFromXbm { 243 croak("Usage: newFromXbm(class,filehandle)") unless @_==2; 244 my($class,$f) = @_; 245 my $fh = $class->_make_filehandle($f); 246 binmode($fh); 247 $class->_newFromXbm($fh); 248} 249 250!NO!SUBS! 251} 252 253print OUT <<'!NO!SUBS!'; 254sub newFromWBMP { 255 croak("Usage: newFromWBMP(class,filehandle,[truecolor])") unless @_>=2; 256 my($class) = shift; 257 my($f) = shift; 258 my $fh = $class->_make_filehandle($f); 259 binmode($fh); 260 $class->_newFromWBMP($fh,@_); 261} 262 263!NO!SUBS! 264 265print OUT <<'!NO!SUBS!'; 266# Autoload methods go after __END__, and are processed by the autosplit program. 2671; 268__END__ 269!NO!SUBS! 270 271close OUT or die "Can't close $file: $!"; 272chdir $origdir; 273