Mercurial > repos > dereeper > sniploid2

comparison GD/Image.pm @ 0:e94de0ea3351 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author dereeper
date Wed, 11 Sep 2013 09:08:15 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:e94de0ea3351
1 # DO NOT EDIT! THIS FILE IS AUTOGENERATED BY GD/Image.pm.PLS
2 package GD::Image;
3
4 use strict;
5 use GD;
6 use Symbol 'gensym','qualify_to_ref';
7 use vars '$VERSION';
8 $VERSION = '2.38';
9
10 =head1 NAME
11
12 GD::Image - Image class for the GD image library
13
14 =head1 SYNOPSIS
15
16 See L<GD>
17
18 =head1 DESCRIPTION
19
20 See L<GD>
21
22 =head1 AUTHOR
23
24 The GD.pm interface is copyright 1995-2005, Lincoln D. Stein. It is
25 distributed under the same terms as Perl itself. See the "Artistic
26 License" in the Perl source code distribution for licensing terms.
27
28 The latest versions of GD.pm are available on CPAN:
29
30 http://www.cpan.org
31
32 =head1 SEE ALSO
33
34 L<GD>
35 L<GD::Polyline>,
36 L<GD::SVG>,
37 L<GD::Simple>,
38 L<Image::Magick>
39
40 =cut
41
42 # Copyright 1995 Lincoln D. Stein. See accompanying README file for
43 # usage information
44
45 *stringTTF = \&GD::Image::stringFT;
46
47 sub _make_filehandle {
48 shift; # get rid of class
49 no strict 'refs';
50 my $thing = shift;
51 return $thing if defined(fileno $thing);
52
53 # otherwise try qualifying it into caller's package
54 my $fh;
55 {
56 local $^W = 0; # to avoid uninitialized variable warning from Symbol.pm
57 $fh = qualify_to_ref($thing,caller(2));
58 }
59 return $fh if defined(fileno $fh);
60
61 # otherwise treat it as a file to open
62 $fh = gensym;
63 open($fh,$thing) || return;
64 return $fh;
65 }
66
67 sub new {
68 my $pack = shift;
69 if (@_ == 1) {
70 if (my $type = _image_type($_[0])) {
71 my $method = "newFrom${type}Data";
72 return unless $pack->can($method);
73 return $pack->$method($_[0]);
74 }
75 return unless my $fh = $pack->_make_filehandle($_[0]);
76 my $magic;
77 return unless read($fh,$magic,4);
78 return unless my $type = _image_type($magic);
79 seek($fh,0,0);
80 my $method = "newFrom${type}";
81 return $pack->$method($fh);
82 }
83 return $pack->_new(@_);
84 }
85
86 sub newTrueColor {
87 my $pack = shift;
88 return $pack->_new(@_, 1);
89 }
90
91 sub newPalette {
92 my $pack = shift;
93 return $pack->_new(@_, 0);
94 }
95
96 sub newFromGd {
97 croak("Usage: newFromGd(class,filehandle)") unless @_==2;
98 my($class,$f) = @_;
99 my $fh = $class->_make_filehandle($f);
100 binmode($fh);
101 $class->_newFromGd($fh);
102 }
103
104 sub newFromGd2 {
105 croak("Usage: newFromGd2(class,filehandle)") unless @_==2;
106 my($class,$f) = @_;
107 my $fh = $class->_make_filehandle($f);
108 binmode($fh);
109 $class->_newFromGd2($fh);
110 }
111
112 sub newFromGd2Part {
113 croak("Usage: newFromGd2(class,filehandle,srcX,srcY,width,height)") unless @_==6;
114 my($class,$f) = splice(@_,0,2);
115 my $fh = $class->_make_filehandle($f);
116 binmode($fh);
117 $class->_newFromGd2Part($fh,@_);
118 }
119
120 sub ellipse ($$$$$) {
121 my ($self,$cx,$cy,$width,$height,$color) = @_;
122 $self->arc($cx,$cy,$width,$height,0,360,$color);
123 }
124
125 # draws closed polygon with the specified color
126 sub polygon {
127 my $self = shift;
128 my($p,$c) = @_;
129 $self->openPolygon($p, $c);
130 $self->line( @{$p->{'points'}->[0]},
131 @{$p->{'points'}->[$p->{'length'}-1]}, $c);
132 }
133
134 sub width {
135 my $self = shift;
136 my @bounds = $self->getBounds;
137 $bounds[0];
138 }
139
140 sub height {
141 my $self = shift;
142 my @bounds = $self->getBounds;
143 $bounds[1];
144 }
145
146 sub _image_type {
147 my $data = shift;
148 my $magic = substr($data,0,4);
149 return 'Png' if $magic eq "\x89PNG";
150 return 'Jpeg' if $magic eq "\377\330\377\340";
151 return 'Jpeg' if $magic eq "\377\330\377\341";
152 return 'Jpeg' if $magic eq "\377\330\377\355";
153 return 'Jpeg' if $magic eq "\377\330\377\356";
154 return 'Gif' if $magic eq "GIF8";
155 return 'Gd2' if $magic eq "gd2\000";
156 return 'Xpm' if substr($data,0,9) eq "/* XPM */";
157 return;
158 }
159
160
161 sub clone {
162 croak("Usage: clone(\$image)") unless @_ == 1;
163 my $self = shift;
164 my ($x,$y) = $self->getBounds;
165 my $new = $self->new($x,$y);
166 return unless $new;
167 $new->copy($self,0,0,0,0,$x,$y);
168 return $new;
169 }
170
171 sub newFromPng {
172 croak("Usage: newFromPng(class,filehandle,[truecolor])") unless @_>=2;
173 my($class) = shift;
174 my($f) = shift;
175 my $fh = $class->_make_filehandle($f);
176 binmode($fh);
177 $class->_newFromPng($fh,@_);
178 }
179
180 sub newFromJpeg {
181 croak("Usage: newFromJpeg(class,filehandle,[truecolor])") unless @_>=2;
182 my($class) = shift;
183 my($f) = shift;
184 my $fh = $class->_make_filehandle($f);
185 binmode($fh);
186 $class->_newFromJpeg($fh,@_);
187 }
188
189 sub newFromGif {
190 croak("Usage: newFromGif(class,filehandle,[truecolor])") unless @_>=2;
191 my($class) = shift;
192 my($f) = shift;
193 my $fh = $class->_make_filehandle($f);
194 binmode($fh);
195 $class->_newFromGif($fh,@_);
196 }
197
198 # Autoload methods go after __END__, and are processed by the autosplit program.
199 1;
200 __END__