line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package PDF::Builder::Resource::XObject::Image::PNG; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
1566
|
use base 'PDF::Builder::Resource::XObject::Image'; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
630
|
|
4
|
|
|
|
|
|
|
|
5
|
2
|
|
|
2
|
|
13
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
42
|
|
6
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
109
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '3.023'; # VERSION |
9
|
|
|
|
|
|
|
our $LAST_UPDATE = '3.019'; # manually update whenever code is changed |
10
|
|
|
|
|
|
|
|
11
|
2
|
|
|
2
|
|
14
|
use Compress::Zlib; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
710
|
|
12
|
2
|
|
|
2
|
|
15
|
use POSIX qw(ceil floor); |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
17
|
|
13
|
|
|
|
|
|
|
|
14
|
2
|
|
|
2
|
|
182
|
use IO::File; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
364
|
|
15
|
2
|
|
|
2
|
|
15
|
use PDF::Builder::Util; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
325
|
|
16
|
2
|
|
|
2
|
|
14
|
use PDF::Builder::Basic::PDF::Utils; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
158
|
|
17
|
2
|
|
|
2
|
|
14
|
use Scalar::Util qw(weaken); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
5064
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 NAME |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
PDF::Builder::Resource::XObject::Image::PNG - support routines for PNG image |
22
|
|
|
|
|
|
|
library (using pure Perl code). |
23
|
|
|
|
|
|
|
Inherits from L |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head1 METHODS |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
=over |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=item $res = PDF::Builder::Resource::XObject::Image::PNG->new($pdf, $file, $name, %opts) |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=item $res = PDF::Builder::Resource::XObject::Image::PNG->new($pdf, $file, $name) |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=item $res = PDF::Builder::Resource::XObject::Image::PNG->new($pdf, $file) |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=back |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
Returns a PNG-image object. C<$pdf> is the PDF object being added to, C<$file> |
38
|
|
|
|
|
|
|
is the input PNG file, and the optional C<$name> of the new parent image object |
39
|
|
|
|
|
|
|
defaults to PxAAA. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
If the Image::PNG::Libpng package is installed, the PNG_IPL library will be |
42
|
|
|
|
|
|
|
used instead of the PNG library. In such a case, use of the PNG library may be |
43
|
|
|
|
|
|
|
forced via the C<-nouseIPL> flag (see Builder documentation for C). |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
opts: -notrans |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
No transparency -- ignore tRNS chunk if provided, ignore Alpha channel |
48
|
|
|
|
|
|
|
if provided. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head2 Supported PNG types |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
(0) Gray scale of depth 1, 2, 4, or 8 bits per pixel (2, 4, 16, or 256 |
53
|
|
|
|
|
|
|
gray levels). 16 bpp is not currently supported (a PNG with 16 bpp |
54
|
|
|
|
|
|
|
is a fatal error). Full transparency (of one 8-bit gray value) via |
55
|
|
|
|
|
|
|
the tRNS chunk is allowed, unless the -notrans option specifies |
56
|
|
|
|
|
|
|
that it be ignored. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
(2) RGB 24-bit truecolor with 8 bits per sample (16.7 million colors). |
59
|
|
|
|
|
|
|
16 bps is not currently supported (a PNG with 16 bps is a fatal |
60
|
|
|
|
|
|
|
error). Full transparency (of one 3x8-bit RGB color value) via the |
61
|
|
|
|
|
|
|
tRNS chunk is allowed, unless the -notrans option specifies that it |
62
|
|
|
|
|
|
|
be ignored. |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
(3) Palette color with 1, 2, 4, or 8 bits per pixel (2, 4, 16, or 256 |
65
|
|
|
|
|
|
|
color table/palette entries). 16 bpp is not currently supported by |
66
|
|
|
|
|
|
|
PNG or PDF. Partial transparency (8-bit Alpha) for each palette |
67
|
|
|
|
|
|
|
entry via the tRNS chunk is allowed, unless the -notrans option |
68
|
|
|
|
|
|
|
specifies that it be ignored (all entries fully opaque). |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
(4) Gray scale of depth 8 bits per pixel plus 8-bit Alpha channel (256 |
71
|
|
|
|
|
|
|
gray levels and 256 levels of transparency). 16 bpp is not |
72
|
|
|
|
|
|
|
currently supported (a PNG with 16 bpp is a fatal error). The Alpha |
73
|
|
|
|
|
|
|
channel is ignored if the -notrans option is given. The tRNS chunk |
74
|
|
|
|
|
|
|
is not permitted. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
(6) RGB 24-bit truecolor with 8 bits per sample (16.7 million colors) |
77
|
|
|
|
|
|
|
plus 8-bit Alpha channel (256 levels of transparency). 16 bps is not |
78
|
|
|
|
|
|
|
currently supported (a PNG with 16 bps is a fatal error). The Alpha |
79
|
|
|
|
|
|
|
channel is ignored if the -notrans option is given. The tRNS chunk |
80
|
|
|
|
|
|
|
is not permitted. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
In all cases, 16 bits per sample are not implemented. A fatal error will be |
83
|
|
|
|
|
|
|
returned if a PNG image with 16-bps data is supplied. The code is assuming |
84
|
|
|
|
|
|
|
standard "network" bit ordering (Big Endian). Interlaced (progressive) display |
85
|
|
|
|
|
|
|
images are not supported. Use the PNG_IPL version if you need to support 16 bps |
86
|
|
|
|
|
|
|
or interlaced images. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The transparency chunk (tRNS) will specify one gray level entry or one RGB |
89
|
|
|
|
|
|
|
entry to be treated as transparent (Alpha = 0). For palette color, up to |
90
|
|
|
|
|
|
|
256 palette entry 8-bit Alpha values are specified (256 levels of transparency, |
91
|
|
|
|
|
|
|
from 0 = transparent to 255 = opaque). |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Only a limited number of chunks are handled: IHDR, IDAT (internally), PLTE, |
94
|
|
|
|
|
|
|
tRNS, and IEND (internally). All other chunks are ignored at this time. Certain |
95
|
|
|
|
|
|
|
filters and compressions applied to data will be handled, but there may be |
96
|
|
|
|
|
|
|
unsupported methods. |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=cut |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
# TBD: gAMA (gamma) chunk, perhaps some others? |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
sub new { |
103
|
3
|
|
|
3
|
1
|
10
|
my ($class, $pdf, $file, $name, %opts) = @_; |
104
|
|
|
|
|
|
|
|
105
|
3
|
|
|
|
|
6
|
my $self; |
106
|
|
|
|
|
|
|
|
107
|
3
|
50
|
|
|
|
8
|
$class = ref($class) if ref($class); |
108
|
|
|
|
|
|
|
|
109
|
3
|
|
33
|
|
|
16
|
$self = $class->SUPER::new($pdf, $name || 'Px'.pdfkey()); |
110
|
3
|
50
|
|
|
|
7
|
$pdf->new_obj($self) unless $self->is_obj($pdf); |
111
|
|
|
|
|
|
|
|
112
|
3
|
|
|
|
|
8
|
$self->{' apipdf'} = $pdf; |
113
|
3
|
|
|
|
|
9
|
weaken $self->{' apipdf'}; |
114
|
|
|
|
|
|
|
|
115
|
3
|
|
|
|
|
12
|
my $fh = IO::File->new(); |
116
|
3
|
100
|
|
|
|
110
|
if (ref($file)) { |
117
|
1
|
|
|
|
|
3
|
$fh = $file; |
118
|
|
|
|
|
|
|
} else { |
119
|
2
|
100
|
|
|
|
96
|
open $fh, '<', $file or die "$!: $file"; |
120
|
|
|
|
|
|
|
} |
121
|
2
|
|
|
|
|
13
|
binmode($fh, ':raw'); |
122
|
|
|
|
|
|
|
|
123
|
2
|
|
|
|
|
4
|
my ($buf, $l, $crc, $w,$h, $bpc, $cs, $cm, $fm, $im, $palette, $trns); |
124
|
2
|
|
|
|
|
18
|
seek($fh, 8, 0); |
125
|
2
|
|
|
|
|
8
|
$self->{' stream'} = ''; |
126
|
2
|
|
|
|
|
7
|
$self->{' nofilt'} = 1; |
127
|
2
|
|
|
|
|
52
|
while (!eof($fh)) { |
128
|
8
|
|
|
|
|
20
|
read($fh, $buf, 4); |
129
|
8
|
|
|
|
|
20
|
$l = unpack('N', $buf); |
130
|
8
|
|
|
|
|
14
|
read($fh, $buf, 4); |
131
|
8
|
100
|
|
|
|
28
|
if ($buf eq 'IHDR') { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
132
|
2
|
|
|
|
|
4
|
read($fh, $buf, $l); |
133
|
2
|
|
|
|
|
10
|
($w, $h, $bpc, $cs, $cm, $fm, $im) = unpack('NNCCCCC', $buf); |
134
|
2
|
50
|
|
|
|
5
|
die "Unsupported Compression($cm) Method" if $cm; |
135
|
2
|
50
|
|
|
|
5
|
die "Unsupported Interlace($im) Method" if $im; |
136
|
2
|
50
|
|
|
|
5
|
die "Unsupported Filter($fm) Method" if $fm; |
137
|
|
|
|
|
|
|
} elsif ($buf eq 'PLTE') { |
138
|
2
|
|
|
|
|
3
|
read($fh, $buf, $l); |
139
|
2
|
|
|
|
|
4
|
$palette = $buf; |
140
|
|
|
|
|
|
|
} elsif ($buf eq 'IDAT') { |
141
|
2
|
|
|
|
|
4
|
read($fh, $buf, $l); |
142
|
2
|
|
|
|
|
6
|
$self->{' stream'} .= $buf; |
143
|
|
|
|
|
|
|
} elsif ($buf eq 'tRNS') { |
144
|
0
|
|
|
|
|
0
|
read($fh, $buf, $l); |
145
|
0
|
|
|
|
|
0
|
$trns = $buf; |
146
|
|
|
|
|
|
|
} elsif ($buf eq 'IEND') { |
147
|
2
|
|
|
|
|
3
|
last; |
148
|
|
|
|
|
|
|
} else { |
149
|
|
|
|
|
|
|
# skip ahead |
150
|
0
|
|
|
|
|
0
|
seek($fh, $l, 1); |
151
|
|
|
|
|
|
|
} |
152
|
6
|
|
|
|
|
12
|
read($fh, $buf, 4); |
153
|
6
|
|
|
|
|
13
|
$crc = $buf; |
154
|
|
|
|
|
|
|
} |
155
|
2
|
|
|
|
|
28
|
close($fh); |
156
|
|
|
|
|
|
|
|
157
|
2
|
|
|
|
|
63
|
$self->width($w); |
158
|
2
|
|
|
|
|
8
|
$self->height($h); |
159
|
|
|
|
|
|
|
|
160
|
2
|
50
|
|
|
|
11
|
if ($cs == 0){ # greyscale (1,2,4,8 bps, 16 not supported here) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# transparency via tRNS chunk allowed |
162
|
|
|
|
|
|
|
# scanline = ceil(bpc * comp / 8)+1 |
163
|
0
|
0
|
|
|
|
0
|
if ($bpc > 8) { |
164
|
0
|
|
|
|
|
0
|
die ">8 bits of greylevel in PNG is not supported."; |
165
|
|
|
|
|
|
|
} else { |
166
|
0
|
|
|
|
|
0
|
$self->filters('FlateDecode'); |
167
|
0
|
|
|
|
|
0
|
$self->colorspace('DeviceGray'); |
168
|
0
|
|
|
|
|
0
|
$self->bits_per_component($bpc); |
169
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
170
|
0
|
|
|
|
|
0
|
$self->{'DecodeParms'} = PDFArray($dict); |
171
|
0
|
|
|
|
|
0
|
$dict->{'Predictor'} = PDFNum(15); |
172
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
173
|
0
|
|
|
|
|
0
|
$dict->{'Colors'} = PDFNum(1); |
174
|
0
|
|
|
|
|
0
|
$dict->{'Columns'} = PDFNum($w); |
175
|
0
|
0
|
0
|
|
|
0
|
if (defined $trns && !$opts{'-notrans'}) { |
176
|
0
|
|
|
|
|
0
|
my $m = mMax(unpack('n*', $trns)); |
177
|
0
|
|
|
|
|
0
|
my $n = mMin(unpack('n*', $trns)); |
178
|
0
|
|
|
|
|
0
|
$self->{'Mask'} = PDFArray(PDFNum($n), PDFNum($m)); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
} elsif ($cs == 2) { # RGB 8 bps (16 not supported here) |
182
|
|
|
|
|
|
|
# transparency via tRNS chunk allowed |
183
|
0
|
0
|
|
|
|
0
|
if ($bpc > 8) { |
184
|
0
|
|
|
|
|
0
|
die ">8 bits of RGB in PNG is not supported."; |
185
|
|
|
|
|
|
|
} else { |
186
|
0
|
|
|
|
|
0
|
$self->filters('FlateDecode'); |
187
|
0
|
|
|
|
|
0
|
$self->colorspace('DeviceRGB'); |
188
|
0
|
|
|
|
|
0
|
$self->bits_per_component($bpc); |
189
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
190
|
0
|
|
|
|
|
0
|
$self->{'DecodeParms'} = PDFArray($dict); |
191
|
0
|
|
|
|
|
0
|
$dict->{'Predictor'} = PDFNum(15); |
192
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
193
|
0
|
|
|
|
|
0
|
$dict->{'Colors'} = PDFNum(3); |
194
|
0
|
|
|
|
|
0
|
$dict->{'Columns'} = PDFNum($w); |
195
|
0
|
0
|
0
|
|
|
0
|
if (defined $trns && !$opts{'-notrans'}) { |
196
|
0
|
|
|
|
|
0
|
my @v = unpack('n*', $trns); |
197
|
0
|
|
|
|
|
0
|
my (@cr,@cg,@cb, $m, $n); |
198
|
0
|
|
|
|
|
0
|
while (scalar @v > 0) { |
199
|
0
|
|
|
|
|
0
|
push(@cr, shift(@v)); |
200
|
0
|
|
|
|
|
0
|
push(@cg, shift(@v)); |
201
|
0
|
|
|
|
|
0
|
push(@cb, shift(@v)); |
202
|
|
|
|
|
|
|
} |
203
|
0
|
|
|
|
|
0
|
@v = (); |
204
|
0
|
|
|
|
|
0
|
$m = mMax(@cr); |
205
|
0
|
|
|
|
|
0
|
$n = mMin(@cr); |
206
|
0
|
|
|
|
|
0
|
push @v, $n,$m; |
207
|
0
|
|
|
|
|
0
|
$m = mMax(@cg); |
208
|
0
|
|
|
|
|
0
|
$n = mMin(@cg); |
209
|
0
|
|
|
|
|
0
|
push @v, $n,$m; |
210
|
0
|
|
|
|
|
0
|
$m = mMax(@cb); |
211
|
0
|
|
|
|
|
0
|
$n = mMin(@cb); |
212
|
0
|
|
|
|
|
0
|
push @v, $n,$m; |
213
|
0
|
|
|
|
|
0
|
$self->{'Mask'} = PDFArray(map { PDFNum($_) } @v); |
|
0
|
|
|
|
|
0
|
|
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
} elsif ($cs == 3) { # palette 1,2,4,8 bpp depth (is 16 legal?) |
217
|
|
|
|
|
|
|
# transparency via tRNS chunk allowed |
218
|
2
|
50
|
|
|
|
4
|
if ($bpc > 8) { |
219
|
0
|
|
|
|
|
0
|
die ">8 bits of palette in PNG is not supported."; |
220
|
|
|
|
|
|
|
} else { |
221
|
2
|
|
|
|
|
7
|
my $dict = PDFDict(); |
222
|
2
|
|
|
|
|
9
|
$pdf->new_obj($dict); |
223
|
2
|
|
|
|
|
6
|
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
224
|
2
|
|
|
|
|
7
|
$dict->{' stream'} = $palette; |
225
|
2
|
|
|
|
|
5
|
$palette = ""; |
226
|
2
|
|
|
|
|
12
|
$self->filters('FlateDecode'); |
227
|
2
|
|
|
|
|
5
|
$self->colorspace(PDFArray(PDFName('Indexed'), PDFName('DeviceRGB'), PDFNum(int(length($dict->{' stream'})/3)-1), $dict)); |
228
|
2
|
|
|
|
|
9
|
$self->bits_per_component($bpc); |
229
|
2
|
|
|
|
|
7
|
$dict = PDFDict(); |
230
|
2
|
|
|
|
|
4
|
$self->{'DecodeParms'} = PDFArray($dict); |
231
|
2
|
|
|
|
|
6
|
$dict->{'Predictor'} = PDFNum(15); |
232
|
2
|
|
|
|
|
4
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
233
|
2
|
|
|
|
|
5
|
$dict->{'Colors'} = PDFNum(1); |
234
|
2
|
|
|
|
|
12
|
$dict->{'Columns'} = PDFNum($w); |
235
|
2
|
50
|
33
|
|
|
6
|
if (defined $trns && !$opts{'-notrans'}) { |
236
|
0
|
|
|
|
|
0
|
$trns .= "\xFF" x 256; # pad out with opaque entries to |
237
|
|
|
|
|
|
|
# ensure at least 256 entries available |
238
|
0
|
|
|
|
|
0
|
$dict = PDFDict(); |
239
|
0
|
|
|
|
|
0
|
$pdf->new_obj($dict); |
240
|
0
|
|
|
|
|
0
|
$dict->{'Type'} = PDFName('XObject'); |
241
|
0
|
|
|
|
|
0
|
$dict->{'Subtype'} = PDFName('Image'); |
242
|
0
|
|
|
|
|
0
|
$dict->{'Width'} = PDFNum($w); |
243
|
0
|
|
|
|
|
0
|
$dict->{'Height'} = PDFNum($h); |
244
|
0
|
|
|
|
|
0
|
$dict->{'ColorSpace'} = PDFName('DeviceGray'); |
245
|
0
|
|
|
|
|
0
|
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
246
|
|
|
|
|
|
|
# $dict->{'Filter'} = PDFArray(PDFName('ASCIIHexDecode')); |
247
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum(8); |
248
|
0
|
|
|
|
|
0
|
$self->{'SMask'} = $dict; |
249
|
|
|
|
|
|
|
# length of row (scanline) in bytes, plus 1 |
250
|
0
|
|
|
|
|
0
|
my $scanline = 1 + ceil($bpc * $w/8); |
251
|
|
|
|
|
|
|
# bytes per pixel (always 1) |
252
|
0
|
|
|
|
|
0
|
my $bpp = ceil($bpc/8); |
253
|
|
|
|
|
|
|
# uncompressed and unfiltered image data (stream of 1,2,4, or |
254
|
|
|
|
|
|
|
# 8 bit indices into palette) |
255
|
0
|
|
|
|
|
0
|
my $clearstream = unprocess($bpc, $bpp, 1, $w,$h, $scanline, \$self->{' stream'}); |
256
|
0
|
|
|
|
|
0
|
foreach my $n (0 .. ($h*$w)-1) { |
257
|
|
|
|
|
|
|
# dict->stream initially empty. fill with Alpha value for |
258
|
|
|
|
|
|
|
# each pixel, indexed by pixel value |
259
|
0
|
|
|
|
|
0
|
vec($dict->{' stream'}, $n, 8) = # each Alpha 8 bits |
260
|
|
|
|
|
|
|
vec($trns, # the table of Alphas corresponding to palette |
261
|
|
|
|
|
|
|
vec($clearstream, $n, $bpc), #1-8 bit index to palette |
262
|
|
|
|
|
|
|
8); # Alpha is 8 bits |
263
|
|
|
|
|
|
|
# print STDERR vec($trns,vec($clearstream,$n,$bpc),8)."=".vec($clearstream,$n,$bpc).","; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
# print STDERR "\n"; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
} elsif ($cs == 4) { # greyscale+alpha 8 bps (16 not supported here) |
269
|
|
|
|
|
|
|
# transparency via tRNS chunk NOT allowed |
270
|
0
|
0
|
|
|
|
0
|
if ($bpc > 8) { |
271
|
0
|
|
|
|
|
0
|
die ">8 bits of greylevel+alpha in PNG is not supported."; |
272
|
|
|
|
|
|
|
} else { |
273
|
0
|
|
|
|
|
0
|
$self->filters('FlateDecode'); |
274
|
0
|
|
|
|
|
0
|
$self->colorspace('DeviceGray'); |
275
|
0
|
|
|
|
|
0
|
$self->bits_per_component($bpc); |
276
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
277
|
0
|
|
|
|
|
0
|
$self->{'DecodeParms'} = PDFArray($dict); |
278
|
|
|
|
|
|
|
# $dict->{'Predictor'} = PDFNum(15); |
279
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
280
|
0
|
|
|
|
|
0
|
$dict->{'Colors'} = PDFNum(1); |
281
|
0
|
|
|
|
|
0
|
$dict->{'Columns'} = PDFNum($w); |
282
|
|
|
|
|
|
|
|
283
|
0
|
|
|
|
|
0
|
$dict = PDFDict(); |
284
|
0
|
0
|
|
|
|
0
|
unless ($opts{'-notrans'}) { |
285
|
0
|
|
|
|
|
0
|
$pdf->new_obj($dict); |
286
|
0
|
|
|
|
|
0
|
$dict->{'Type'} = PDFName('XObject'); |
287
|
0
|
|
|
|
|
0
|
$dict->{'Subtype'} = PDFName('Image'); |
288
|
0
|
|
|
|
|
0
|
$dict->{'Width'} = PDFNum($w); |
289
|
0
|
|
|
|
|
0
|
$dict->{'Height'} = PDFNum($h); |
290
|
0
|
|
|
|
|
0
|
$dict->{'ColorSpace'} = PDFName('DeviceGray'); |
291
|
0
|
|
|
|
|
0
|
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
292
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
293
|
0
|
|
|
|
|
0
|
$self->{'SMask'} = $dict; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
# as with cs=3, create SMask of Alpha entry for each pixel. this |
296
|
|
|
|
|
|
|
# time, separating Alpha from grayscale and putting in dict->stream |
297
|
0
|
|
|
|
|
0
|
my $scanline = 1 + ceil($bpc*2 * $w/8); |
298
|
0
|
|
|
|
|
0
|
my $bpp = ceil($bpc*2 / 8); |
299
|
0
|
|
|
|
|
0
|
my $clearstream = unprocess($bpc, $bpp, 2, $w,$h, $scanline, \$self->{' stream'}); |
300
|
0
|
|
|
|
|
0
|
delete $self->{' nofilt'}; |
301
|
|
|
|
|
|
|
#delete $self->{' stream'}; |
302
|
0
|
|
|
|
|
0
|
$dict->{' stream'} = ''; |
303
|
0
|
|
|
|
|
0
|
$self->{' stream'} = ''; |
304
|
|
|
|
|
|
|
# dict->stream is the outer dict if -notrans, and the Alpha data |
305
|
|
|
|
|
|
|
# moved to it is simply unused |
306
|
|
|
|
|
|
|
# dict->stream is the inner dict (created if !-notrans), and the |
307
|
|
|
|
|
|
|
# Alpha data moved to it becomes the SMask |
308
|
|
|
|
|
|
|
# rebuild self->stream from the gray data in clearstream |
309
|
0
|
|
|
|
|
0
|
foreach my $n (0 .. $h*$w-1) { |
310
|
0
|
|
|
|
|
0
|
vec($dict->{' stream'}, $n, $bpc) = vec($clearstream, $n*2+1, $bpc); |
311
|
0
|
|
|
|
|
0
|
vec($self->{' stream'}, $n, $bpc) = vec($clearstream, $n*2, $bpc); |
312
|
|
|
|
|
|
|
} |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} elsif ($cs == 6) { # RGB+alpha 8 bps (16 not supported here) |
315
|
|
|
|
|
|
|
# transparency via tRNS chunk NOT allowed |
316
|
0
|
0
|
|
|
|
0
|
if ($bpc > 8) { |
317
|
0
|
|
|
|
|
0
|
die ">8 bits of RGB+alpha in PNG is not supported."; |
318
|
|
|
|
|
|
|
} else { |
319
|
0
|
|
|
|
|
0
|
$self->filters('FlateDecode'); |
320
|
0
|
|
|
|
|
0
|
$self->colorspace('DeviceRGB'); |
321
|
0
|
|
|
|
|
0
|
$self->bits_per_component($bpc); |
322
|
0
|
|
|
|
|
0
|
my $dict = PDFDict(); |
323
|
0
|
|
|
|
|
0
|
$self->{'DecodeParms'} = PDFArray($dict); |
324
|
|
|
|
|
|
|
# $dict->{'Predictor'} = PDFNum(15); |
325
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
326
|
0
|
|
|
|
|
0
|
$dict->{'Colors'} = PDFNum(3); |
327
|
0
|
|
|
|
|
0
|
$dict->{'Columns'} = PDFNum($w); |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
0
|
$dict = PDFDict(); |
330
|
0
|
0
|
|
|
|
0
|
unless ($opts{'-notrans'}) { |
331
|
0
|
|
|
|
|
0
|
$pdf->new_obj($dict); |
332
|
0
|
|
|
|
|
0
|
$dict->{'Type'} = PDFName('XObject'); |
333
|
0
|
|
|
|
|
0
|
$dict->{'Subtype'} = PDFName('Image'); |
334
|
0
|
|
|
|
|
0
|
$dict->{'Width'} = PDFNum($w); |
335
|
0
|
|
|
|
|
0
|
$dict->{'Height'} = PDFNum($h); |
336
|
0
|
|
|
|
|
0
|
$dict->{'ColorSpace'} = PDFName('DeviceGray'); |
337
|
0
|
|
|
|
|
0
|
$dict->{'Filter'} = PDFArray(PDFName('FlateDecode')); |
338
|
0
|
|
|
|
|
0
|
$dict->{'BitsPerComponent'} = PDFNum($bpc); |
339
|
0
|
|
|
|
|
0
|
$self->{'SMask'} = $dict; |
340
|
|
|
|
|
|
|
} |
341
|
|
|
|
|
|
|
# bytes per pixel (4 samples) and length of row scanline in bytes |
342
|
0
|
|
|
|
|
0
|
my $scanline = 1 + ceil($bpc*4 * $w/8); |
343
|
0
|
|
|
|
|
0
|
my $bpp = ceil($bpc*4 /8); |
344
|
|
|
|
|
|
|
# unpacked, uncompressed, unfiltered image data |
345
|
0
|
|
|
|
|
0
|
my $clearstream = unprocess($bpc, $bpp, 4, $w,$h, $scanline, \$self->{' stream'}); |
346
|
0
|
|
|
|
|
0
|
delete $self->{' nofilt'}; |
347
|
|
|
|
|
|
|
#delete $self->{' stream'}; |
348
|
0
|
|
|
|
|
0
|
$dict->{' stream'} = ''; |
349
|
0
|
|
|
|
|
0
|
$self->{' stream'} = ''; |
350
|
|
|
|
|
|
|
# as with cs=4, create SMask of Alpha entry for each pixel. this |
351
|
|
|
|
|
|
|
# time, separating Alpha from RGB triplet and put in dict->stream |
352
|
|
|
|
|
|
|
# dict->stream is the outer dict if -notrans, and the Alpha data |
353
|
|
|
|
|
|
|
# moved to it is simply unused |
354
|
|
|
|
|
|
|
# dict->stream is the inner dict (created if !-notrans), and the |
355
|
|
|
|
|
|
|
# Alpha data moved to it becomes the SMask |
356
|
|
|
|
|
|
|
# rebuild self->stream from the RGB data in clearstream 1/3 smaller |
357
|
0
|
|
|
|
|
0
|
foreach my $n (0 .. ($h*$w)-1) { |
358
|
|
|
|
|
|
|
# pull out Alpha data bpc bits into new dict SMask |
359
|
0
|
|
|
|
|
0
|
vec($dict->{' stream'}, $n, $bpc) = vec($clearstream, $n*4+3, $bpc); |
360
|
|
|
|
|
|
|
# transfer RGB triplet into self->stream |
361
|
0
|
|
|
|
|
0
|
vec($self->{' stream'}, $n*3, $bpc) = vec($clearstream, $n*4, $bpc); |
362
|
0
|
|
|
|
|
0
|
vec($self->{' stream'}, $n*3+1, $bpc) = vec($clearstream, $n*4+1, $bpc); |
363
|
0
|
|
|
|
|
0
|
vec($self->{' stream'}, $n*3+2, $bpc) = vec($clearstream, $n*4+2, $bpc); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} else { |
367
|
0
|
|
|
|
|
0
|
die "unsupported PNG-color type (cs=$cs)."; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
2
|
|
|
|
|
10
|
return($self); |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
=over |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=item $mode = $png->usesLib() |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
Returns 1 if Image::PNG::Libpng installed and used, 0 if not installed, or -1 |
378
|
|
|
|
|
|
|
if installed but not used (-nouseIPL option given to C). |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
B this method can only be used I the image object has been |
381
|
|
|
|
|
|
|
created. It can't tell you whether Image::PNG::Libpng is available in |
382
|
|
|
|
|
|
|
advance of actually using it, in case you want to use some functionality |
383
|
|
|
|
|
|
|
available only in PNG_IPL. See the L LA_IPL() call if you |
384
|
|
|
|
|
|
|
need to know in advance. |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=back |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
=cut |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub usesLib { |
391
|
2
|
|
|
2
|
1
|
12
|
my ($self) = shift; |
392
|
|
|
|
|
|
|
# should be 0 for Image::PNG::Libpng not installed, or -1 for is installed, |
393
|
|
|
|
|
|
|
# but not using it |
394
|
2
|
|
|
|
|
5
|
return $self->{'usesIPL'}->val(); |
395
|
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
sub PaethPredictor { |
398
|
0
|
|
|
0
|
0
|
|
my ($a, $b, $c) = @_; |
399
|
0
|
|
|
|
|
|
my $p = $a + $b - $c; |
400
|
0
|
|
|
|
|
|
my $pa = abs($p - $a); |
401
|
0
|
|
|
|
|
|
my $pb = abs($p - $b); |
402
|
0
|
|
|
|
|
|
my $pc = abs($p - $c); |
403
|
0
|
0
|
0
|
|
|
|
if (($pa <= $pb) && ($pa <= $pc)) { |
|
|
0
|
|
|
|
|
|
404
|
0
|
|
|
|
|
|
return $a; |
405
|
|
|
|
|
|
|
} elsif ($pb <= $pc) { |
406
|
0
|
|
|
|
|
|
return $b; |
407
|
|
|
|
|
|
|
} else { |
408
|
0
|
|
|
|
|
|
return $c; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
sub unprocess { |
413
|
0
|
|
|
0
|
0
|
|
my ($bpc, $bpp, $comp, $width,$height, $scanline, $sstream) = @_; |
414
|
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
|
my $stream = uncompress($$sstream); |
416
|
0
|
|
|
|
|
|
my $prev = ''; |
417
|
0
|
|
|
|
|
|
my $clearstream = ''; |
418
|
0
|
|
|
|
|
|
foreach my $n (0 .. $height-1) { |
419
|
|
|
|
|
|
|
# print STDERR "line $n:"; |
420
|
0
|
|
|
|
|
|
my $line = substr($stream, $n*$scanline, $scanline); |
421
|
0
|
|
|
|
|
|
my $filter = vec($line, 0, 8); |
422
|
0
|
|
|
|
|
|
my $clear = ''; |
423
|
0
|
|
|
|
|
|
$line = substr($line, 1); |
424
|
|
|
|
|
|
|
# print STDERR " filter=$filter"; |
425
|
0
|
0
|
|
|
|
|
if ($filter == 0) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
426
|
0
|
|
|
|
|
|
$clear = $line; |
427
|
|
|
|
|
|
|
} elsif ($filter == 1) { |
428
|
0
|
|
|
|
|
|
foreach my $x (0 .. length($line)-1) { |
429
|
0
|
|
|
|
|
|
vec($clear, $x, 8) = (vec($line, $x, 8) + vec($clear, $x-$bpp, 8))%256; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
} elsif ($filter == 2) { |
432
|
0
|
|
|
|
|
|
foreach my $x (0 .. length($line)-1) { |
433
|
0
|
|
|
|
|
|
vec($clear, $x, 8) = (vec($line, $x, 8) + vec($prev, $x, 8))%256; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
} elsif ($filter == 3) { |
436
|
0
|
|
|
|
|
|
foreach my $x (0 .. length($line)-1) { |
437
|
0
|
|
|
|
|
|
vec($clear, $x, 8) = (vec($line, $x, 8) + floor((vec($clear, $x-$bpp, 8) + vec($prev, $x, 8))/2))%256; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} elsif ($filter == 4) { |
440
|
0
|
|
|
|
|
|
foreach my $x (0 .. length($line)-1) { |
441
|
0
|
|
|
|
|
|
vec($clear, $x, 8) = (vec($line, $x, 8) + PaethPredictor(vec($clear, $x-$bpp, 8), vec($prev, $x, 8), vec($prev, $x-$bpp, 8)))%256; |
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
} |
444
|
0
|
|
|
|
|
|
$prev = $clear; |
445
|
0
|
|
|
|
|
|
foreach my $x (0 .. ($width*$comp)-1) { |
446
|
0
|
|
|
|
|
|
vec($clearstream, ($n*$width*$comp)+$x, $bpc) = vec($clear, $x, $bpc); |
447
|
|
|
|
|
|
|
# print STDERR "".vec($clear,$x,$bpc).","; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
# print STDERR "\n"; |
450
|
|
|
|
|
|
|
} |
451
|
0
|
|
|
|
|
|
return $clearstream; |
452
|
|
|
|
|
|
|
} |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
1; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
__END__ |