line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Image::GIF::Encoder::PP; |
2
|
|
|
|
|
|
|
# Copyright (c) 2021-2022 Gavin Hayes, see LICENSE in the root of the project |
3
|
1
|
|
|
1
|
|
2413
|
use version; our $VERSION = version->declare("v0.1.0"); |
|
1
|
|
|
|
|
1589
|
|
|
1
|
|
|
|
|
4
|
|
4
|
1
|
|
|
1
|
|
78
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
15
|
|
5
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
544
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub write_num { |
8
|
516
|
|
|
516
|
0
|
761
|
my ($fh, $val) = @_; |
9
|
516
|
|
|
|
|
982
|
print $fh pack('v', $val); |
10
|
|
|
|
|
|
|
} |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub new_node { |
13
|
12160
|
|
|
12160
|
0
|
15212
|
my ($key, $degree) = @_; |
14
|
12160
|
|
|
|
|
25281
|
my %node = ( |
15
|
|
|
|
|
|
|
'key' => $key, |
16
|
|
|
|
|
|
|
'children' => [] |
17
|
|
|
|
|
|
|
); |
18
|
|
|
|
|
|
|
|
19
|
12160
|
|
|
|
|
24226
|
return \%node; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
sub new_trie { |
23
|
102
|
|
|
102
|
0
|
223
|
my ($degree, $nkeys) = @_; |
24
|
102
|
|
|
|
|
260
|
my $root = new_node(0, $degree); |
25
|
|
|
|
|
|
|
# Create nodes for single pixels. |
26
|
102
|
|
|
|
|
352
|
for($$nkeys = 0; $$nkeys < $degree; $$nkeys += 1) { |
27
|
432
|
|
|
|
|
729
|
$root->{'children'}[$$nkeys] = new_node($$nkeys, $degree); |
28
|
|
|
|
|
|
|
} |
29
|
102
|
|
|
|
|
223
|
$$nkeys += 2; #skip clear code and stop code |
30
|
102
|
|
|
|
|
194
|
return $root; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
102
|
0
|
|
sub del_trie { |
34
|
|
|
|
|
|
|
# nothing needed to free in perl |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub put_loop { |
38
|
2
|
|
|
2
|
0
|
5
|
my ($gif, $loop) = @_; |
39
|
2
|
|
|
|
|
4
|
print {$gif->{'fh'}} pack('CCC', 0x21, 0xFF, 0x0B); |
|
2
|
|
|
|
|
17
|
|
40
|
2
|
|
|
|
|
5
|
print {$gif->{'fh'}} "NETSCAPE2.0"; |
|
2
|
|
|
|
|
4
|
|
41
|
2
|
|
|
|
|
3
|
print {$gif->{'fh'}} pack('CC', 0x03, 0x01); |
|
2
|
|
|
|
|
4
|
|
42
|
2
|
|
|
|
|
6
|
write_num($gif->{'fh'}, $loop); |
43
|
2
|
|
|
|
|
4
|
print {$gif->{'fh'}} "\0"; |
|
2
|
|
|
|
|
3
|
|
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
# Add packed key to buffer, updating offset and partial. |
47
|
|
|
|
|
|
|
# $gif->{'offset'} holds position to put next *bit* |
48
|
|
|
|
|
|
|
# $gif->{'partial'} holds bits to include in next byte |
49
|
|
|
|
|
|
|
sub put_key { |
50
|
11932
|
|
|
11932
|
0
|
15714
|
my ($gif, $key, $key_size) = @_; |
51
|
|
|
|
|
|
|
|
52
|
11932
|
|
|
|
|
17022
|
my $byte_offset = int($gif->{'offset'} / 8); |
53
|
11932
|
|
|
|
|
13856
|
my $bit_offset = $gif->{'offset'} % 8; |
54
|
11932
|
|
|
|
|
14477
|
$gif->{'partial'} |= ($key << $bit_offset); |
55
|
11932
|
|
|
|
|
13590
|
my $bits_to_write = $bit_offset + $key_size; |
56
|
11932
|
|
|
|
|
18493
|
while ($bits_to_write >= 8) { |
57
|
10253
|
|
|
|
|
19153
|
vec($gif->{'buffer'}, $byte_offset++, 8) = $gif->{'partial'} & 0xFF; |
58
|
10253
|
100
|
|
|
|
18088
|
if ($byte_offset == 0xFF) { |
59
|
3
|
|
|
|
|
8
|
print {$gif->{'fh'}} "\xFF"; |
|
3
|
|
|
|
|
16
|
|
60
|
3
|
50
|
|
|
|
9
|
length($gif->{'buffer'}) == 0xFF or die("misport"); |
61
|
3
|
|
|
|
|
5
|
print {$gif->{'fh'}} $gif->{'buffer'}; |
|
3
|
|
|
|
|
56
|
|
62
|
3
|
|
|
|
|
6
|
$byte_offset = 0; |
63
|
|
|
|
|
|
|
} |
64
|
10253
|
|
|
|
|
11697
|
$gif->{'partial'} >>= 8; |
65
|
10253
|
|
|
|
|
14878
|
$bits_to_write -= 8; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
11932
|
|
|
|
|
17372
|
$gif->{'offset'} = ($gif->{'offset'} + $key_size) % (0xFF * 8); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub end_key { |
72
|
102
|
|
|
102
|
0
|
199
|
my ($gif) = @_; |
73
|
102
|
|
|
|
|
201
|
my $byte_offset = int($gif->{'offset'} / 8); |
74
|
102
|
100
|
|
|
|
234
|
if ($gif->{'offset'} % 8) { |
75
|
101
|
|
|
|
|
276
|
vec($gif->{'buffer'}, $byte_offset++, 8) = $gif->{'partial'} & 0xFF; |
76
|
|
|
|
|
|
|
} |
77
|
102
|
50
|
|
|
|
219
|
if ($byte_offset) { |
78
|
102
|
|
|
|
|
140
|
print {$gif->{'fh'}} pack('C', $byte_offset); |
|
102
|
|
|
|
|
443
|
|
79
|
102
|
|
|
|
|
167
|
print {$gif->{'fh'}} substr($gif->{'buffer'}, 0, $byte_offset); |
|
102
|
|
|
|
|
281
|
|
80
|
|
|
|
|
|
|
} |
81
|
102
|
|
|
|
|
129
|
print {$gif->{'fh'}} "\0"; |
|
102
|
|
|
|
|
165
|
|
82
|
102
|
|
|
|
|
233
|
$gif->{'offset'} = $gif->{'partial'} = 0; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
use constant { |
86
|
1
|
|
|
|
|
615
|
FRAME_CUR => 0, |
87
|
|
|
|
|
|
|
FRAME_LAST => 1 |
88
|
1
|
|
|
1
|
|
6
|
}; |
|
1
|
|
|
|
|
2
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
sub put_image { |
91
|
102
|
|
|
102
|
0
|
239
|
my ($gif, $frameindex, $w, $h, $x, $y) = @_; |
92
|
102
|
50
|
|
|
|
331
|
my $frameref = ($frameindex == FRAME_CUR) ? \$gif->{'frame'} : \$gif->{'back'}; |
93
|
102
|
|
|
|
|
226
|
my $degree = 1 << $gif->{'depth'}; |
94
|
|
|
|
|
|
|
|
95
|
102
|
|
|
|
|
177
|
print {$gif->{'fh'}} ","; |
|
102
|
|
|
|
|
212
|
|
96
|
102
|
|
|
|
|
269
|
write_num($gif->{'fh'}, $x); |
97
|
102
|
|
|
|
|
238
|
write_num($gif->{'fh'}, $y); |
98
|
102
|
|
|
|
|
238
|
write_num($gif->{'fh'}, $w); |
99
|
102
|
|
|
|
|
241
|
write_num($gif->{'fh'}, $h); |
100
|
102
|
|
|
|
|
224
|
print {$gif->{'fh'}} pack('CC', 0x0, $gif->{'depth'}); |
|
102
|
|
|
|
|
284
|
|
101
|
102
|
|
|
|
|
141
|
my $nkeys; |
102
|
102
|
|
|
|
|
350
|
my $node = new_trie($degree, \$nkeys); |
103
|
102
|
|
|
|
|
172
|
my $root = $node; |
104
|
102
|
|
|
|
|
208
|
my $key_size = $gif->{'depth'} + 1; |
105
|
|
|
|
|
|
|
|
106
|
102
|
|
|
|
|
367
|
put_key($gif, $degree, $key_size); # clear code |
107
|
|
|
|
|
|
|
|
108
|
102
|
|
|
|
|
321
|
for (my $i = $y; $i < $y+$h; $i++) { |
109
|
4272
|
|
|
|
|
6484
|
for (my $j = $x; $j < $x+$w; $j++) { |
110
|
232982
|
|
|
|
|
293970
|
my $pixel = vec($$frameref, $i*$gif->{'w'}+$j, 8) & ($degree - 1); |
111
|
232982
|
|
|
|
|
260235
|
my $child = $node->{'children'}[$pixel]; |
112
|
232982
|
100
|
|
|
|
273268
|
if ($child) { |
113
|
221356
|
|
|
|
|
341052
|
$node = $child; |
114
|
|
|
|
|
|
|
} else { |
115
|
11626
|
|
|
|
|
19476
|
put_key($gif, $node->{'key'}, $key_size); |
116
|
11626
|
50
|
|
|
|
15430
|
if ($nkeys < 0x1000) { |
117
|
11626
|
100
|
|
|
|
16774
|
if ($nkeys == (1 << $key_size)) { |
118
|
263
|
|
|
|
|
323
|
$key_size++; |
119
|
|
|
|
|
|
|
} |
120
|
11626
|
|
|
|
|
15685
|
$node->{'children'}[$pixel] = new_node($nkeys++, $degree); |
121
|
|
|
|
|
|
|
} else { |
122
|
0
|
|
|
|
|
0
|
put_key($gif, $degree, $key_size); # clear code |
123
|
0
|
|
|
|
|
0
|
del_trie($root, $degree); |
124
|
0
|
|
|
|
|
0
|
$root = $node = new_trie($degree, \$nkeys); |
125
|
0
|
|
|
|
|
0
|
$key_size = $gif->{'depth'} + 1; |
126
|
|
|
|
|
|
|
} |
127
|
11626
|
|
|
|
|
22866
|
$node = $root->{'children'}[$pixel]; |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
} |
131
|
102
|
|
|
|
|
264
|
put_key($gif, $node->{'key'}, $key_size); |
132
|
102
|
|
|
|
|
289
|
put_key($gif, $degree + 1, $key_size); # stop code |
133
|
102
|
|
|
|
|
342
|
end_key($gif); |
134
|
102
|
|
|
|
|
272
|
del_trie($root, $degree); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
sub get_bbox { |
138
|
100
|
|
|
100
|
0
|
293
|
my ($gif, $w, $h, $x, $y) = @_; |
139
|
100
|
|
|
|
|
207
|
my $left = $gif->{'w'}; my $right = 0; |
|
100
|
|
|
|
|
160
|
|
140
|
100
|
|
|
|
|
193
|
my $top = $gif->{'h'}; my $bottom = 0; |
|
100
|
|
|
|
|
148
|
|
141
|
100
|
|
|
|
|
165
|
my $k = 0; |
142
|
100
|
|
|
|
|
342
|
for (my $i = 0; $i < $gif->{'h'}; $i++) { |
143
|
9964
|
|
|
|
|
14670
|
for (my $j = 0; $j < $gif->{'w'}; $j++, $k++) { |
144
|
994096
|
100
|
|
|
|
1859074
|
if (vec($gif->{'frame'}, $k, 8) != vec($gif->{'back'}, $k, 8)) { |
145
|
163092
|
100
|
|
|
|
219965
|
if ($j < $left) { |
146
|
109
|
|
|
|
|
167
|
$left = $j; |
147
|
|
|
|
|
|
|
} |
148
|
163092
|
100
|
|
|
|
212842
|
if ($j > $right) { |
149
|
2152
|
|
|
|
|
2244
|
$right = $j; |
150
|
|
|
|
|
|
|
} |
151
|
163092
|
100
|
|
|
|
213084
|
if ($i < $top) { |
152
|
100
|
|
|
|
|
162
|
$top = $i; |
153
|
|
|
|
|
|
|
} |
154
|
163092
|
100
|
|
|
|
293661
|
if ($i > $bottom) { |
155
|
4107
|
|
|
|
|
6325
|
$bottom = $i; |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
} |
160
|
100
|
50
|
33
|
|
|
656
|
if ($left != $gif->{'w'} && $top != $gif->{'h'}) { |
161
|
100
|
|
|
|
|
168
|
$$x = $left; $$y = $top; |
|
100
|
|
|
|
|
197
|
|
162
|
100
|
|
|
|
|
242
|
$$w = $right - $left + 1; |
163
|
100
|
|
|
|
|
175
|
$$h = $bottom - $top + 1; |
164
|
100
|
|
|
|
|
490
|
return 1; |
165
|
|
|
|
|
|
|
} else { |
166
|
0
|
|
|
|
|
0
|
return 0; |
167
|
|
|
|
|
|
|
} |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
use constant { |
171
|
1
|
|
|
|
|
1369
|
DM_UNSPEC => 0 << 2, |
172
|
|
|
|
|
|
|
DM_DND => 1 << 2, # Do Not Dispose |
173
|
|
|
|
|
|
|
DM_RTB => 2 << 2, # Restore To Background (clear pixel) |
174
|
|
|
|
|
|
|
DM_RTP => 3 << 2 # Restore To Previous (not currently used) |
175
|
1
|
|
|
1
|
|
7
|
}; |
|
1
|
|
|
|
|
2
|
|
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub add_graphics_control_extension { |
178
|
102
|
|
|
102
|
0
|
258
|
my ($gif, $d, $dm) = @_; |
179
|
102
|
|
|
|
|
619
|
my $out = "!\xF9\x04".pack('C', $dm); |
180
|
102
|
50
|
|
|
|
298
|
if($gif->{'transparent_index'} != -1) { |
181
|
102
|
|
|
|
|
639
|
vec($out, 3, 8) |= 0x1; # transparent color flag |
182
|
|
|
|
|
|
|
} |
183
|
102
|
|
|
|
|
327
|
print {$gif->{'fh'}} $out; |
|
102
|
|
|
|
|
453
|
|
184
|
102
|
|
|
|
|
406
|
write_num($gif->{'fh'}, $d); |
185
|
102
|
|
|
|
|
282
|
vec($out, 0, 8) = 0x0; |
186
|
102
|
|
|
|
|
264
|
vec($out, 1, 8) = 0x0; |
187
|
102
|
50
|
|
|
|
280
|
if($gif->{'transparent_index'} != -1) { |
188
|
102
|
|
|
|
|
275
|
vec($out, 0, 8) = $gif->{'transparent_index'}; |
189
|
|
|
|
|
|
|
} |
190
|
102
|
|
|
|
|
169
|
print {$gif->{'fh'}} substr($out, 0, 2); |
|
102
|
|
|
|
|
299
|
|
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
# external interface |
195
|
|
|
|
|
|
|
sub new { |
196
|
2
|
|
|
2
|
1
|
903
|
my ($class, $filename, $width, $height, $palette, $depth, $loop, $transparent_index) = @_; |
197
|
2
|
|
|
|
|
19
|
my $gif = { |
198
|
|
|
|
|
|
|
'w' => $width, |
199
|
|
|
|
|
|
|
'h' => $height, |
200
|
|
|
|
|
|
|
'depth' => 0, |
201
|
|
|
|
|
|
|
'transparent_index' => $transparent_index, |
202
|
|
|
|
|
|
|
'has_unencoded_frame' => 0, |
203
|
|
|
|
|
|
|
'fd' => undef, |
204
|
|
|
|
|
|
|
'offset' => 0, |
205
|
|
|
|
|
|
|
'nframes' => 0, |
206
|
|
|
|
|
|
|
#'frame' => '', |
207
|
|
|
|
|
|
|
#'back' => '', |
208
|
|
|
|
|
|
|
'partial' => 0, |
209
|
|
|
|
|
|
|
#'buffer' => '' |
210
|
|
|
|
|
|
|
}; |
211
|
2
|
|
|
|
|
28
|
vec($gif->{'frame'}, $width*$height-1, 8) = 0; |
212
|
2
|
|
|
|
|
27
|
vec($gif->{'back'}, $width*$height-1, 8) = 0; |
213
|
2
|
|
|
|
|
9
|
vec($gif->{'buffer'}, 0xFF-1, 8) = 0; |
214
|
2
|
50
|
|
|
|
7
|
if($filename) { |
215
|
2
|
50
|
|
|
|
153
|
open($gif->{'fh'}, '>', $filename) or return undef; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
else { |
218
|
0
|
|
|
|
|
0
|
$gif->{'fh'} = *STDOUT; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
2
|
|
|
|
|
12
|
bless $gif, $class; |
222
|
|
|
|
|
|
|
|
223
|
2
|
|
|
|
|
4
|
print {$gif->{'fh'}} "GIF89a"; |
|
2
|
|
|
|
|
33
|
|
224
|
2
|
|
|
|
|
11
|
write_num($gif->{'fh'}, $width); |
225
|
2
|
|
|
|
|
6
|
write_num($gif->{'fh'}, $height); |
226
|
2
|
|
|
|
|
8
|
my $store_gct; my $custom_gct; |
227
|
2
|
50
|
|
|
|
8
|
if ($palette) { |
228
|
2
|
50
|
|
|
|
7
|
if ($depth < 0) { |
229
|
0
|
|
|
|
|
0
|
$store_gct = 1; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
else { |
232
|
2
|
|
|
|
|
4
|
$custom_gct = 1; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
} |
235
|
2
|
50
|
|
|
|
5
|
if ($depth < 0) { |
236
|
0
|
|
|
|
|
0
|
$depth = -$depth; |
237
|
|
|
|
|
|
|
} |
238
|
2
|
100
|
|
|
|
8
|
$gif->{'depth'} = $depth > 1 ? $depth : 2; |
239
|
2
|
|
|
|
|
2
|
print {$gif->{'fh'}} pack('CCC', (0xF0 | ($depth-1)), 0x00, 0x00); |
|
2
|
|
|
|
|
8
|
|
240
|
2
|
50
|
|
|
|
6
|
if ($custom_gct) { |
241
|
2
|
|
|
|
|
3
|
print {$gif->{'fh'}} substr($palette, 0, 3 << $depth); |
|
2
|
|
|
|
|
6
|
|
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
else { |
244
|
0
|
|
|
|
|
0
|
warn("unimplemented mode"); |
245
|
0
|
|
|
|
|
0
|
return undef; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
2
|
50
|
33
|
|
|
17
|
if ($loop >= 0 && $loop <= 0xFFFF) { |
249
|
2
|
|
|
|
|
8
|
put_loop($gif, $loop); |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
2
|
|
|
|
|
8
|
return $gif; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
sub add_frame_with_transparency { |
256
|
102
|
|
|
102
|
0
|
238
|
my ($gif, $has_new_frame) = @_; |
257
|
102
|
|
|
|
|
347
|
$gif->{'has_unencoded_frame'} = 0; |
258
|
102
|
|
|
|
|
248
|
my $dm = DM_DND; |
259
|
102
|
|
|
|
|
209
|
my $w = $gif->{'unencoded_w'}; |
260
|
102
|
|
|
|
|
192
|
my $h = $gif->{'unencoded_h'}; |
261
|
102
|
|
|
|
|
194
|
my $x = $gif->{'unencoded_x'}; |
262
|
102
|
|
|
|
|
179
|
my $y = $gif->{'unencoded_y'}; |
263
|
102
|
100
|
|
|
|
332
|
if($has_new_frame) |
264
|
|
|
|
|
|
|
{ |
265
|
|
|
|
|
|
|
# if the new frame has any new transparent pixels (not already transparent) RTB is required |
266
|
100
|
|
|
|
|
304
|
for(my $i = 0; $i < $gif->{'h'}; $i++) |
267
|
|
|
|
|
|
|
{ |
268
|
9964
|
|
|
|
|
15846
|
for(my $j = 0; $j < $gif->{w}; $j++) |
269
|
|
|
|
|
|
|
{ |
270
|
994096
|
100
|
100
|
|
|
2623107
|
if((vec($gif->{frame}, ($i*$gif->{w}) + $j, 8) == $gif->{'transparent_index'}) && |
271
|
|
|
|
|
|
|
(vec($gif->{back}, ($i*$gif->{w}) + $j, 8) != $gif->{'transparent_index'})) { |
272
|
650
|
|
|
|
|
775
|
$dm = DM_RTB; |
273
|
|
|
|
|
|
|
# adjust the BB so the pixel will be cleared on RTB |
274
|
650
|
50
|
|
|
|
962
|
if($i < $y) |
275
|
|
|
|
|
|
|
{ |
276
|
0
|
|
|
|
|
0
|
my $delta = $y-$i; |
277
|
0
|
|
|
|
|
0
|
$y = $i; |
278
|
0
|
|
|
|
|
0
|
$h += $delta; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
650
|
50
|
|
|
|
898
|
if($j < $x) |
282
|
|
|
|
|
|
|
{ |
283
|
0
|
|
|
|
|
0
|
my $delta = $x-$j; |
284
|
0
|
|
|
|
|
0
|
$x = $j; |
285
|
0
|
|
|
|
|
0
|
$w += $delta; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
650
|
50
|
|
|
|
964
|
if($i >= ($y+$gif->{h})) |
289
|
|
|
|
|
|
|
{ |
290
|
0
|
|
|
|
|
0
|
$h += ($i-($y+$gif->{h})+1); |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
650
|
50
|
|
|
|
1231
|
if($j >= ($x+$gif->{w})) |
294
|
|
|
|
|
|
|
{ |
295
|
0
|
|
|
|
|
0
|
$w += ($j-($x+$gif->{w})+1); |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
} |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
} |
302
|
102
|
|
|
|
|
552
|
add_graphics_control_extension($gif, $gif->{'unencoded_delay'}, $dm); |
303
|
102
|
|
|
|
|
361
|
put_image($gif, FRAME_LAST, $w, $h, $x, $y); |
304
|
|
|
|
|
|
|
|
305
|
102
|
100
|
|
|
|
311
|
if($dm == DM_RTB) |
306
|
|
|
|
|
|
|
{ |
307
|
|
|
|
|
|
|
# RTB our internal model, used by get_bbox |
308
|
51
|
|
|
|
|
159
|
for(my $i = $y; $i < ($y+$h); $i++) |
309
|
|
|
|
|
|
|
{ |
310
|
4080
|
|
|
|
|
6146
|
for(my $j = $x; $j < ($x+$w); $j++) |
311
|
|
|
|
|
|
|
{ |
312
|
225560
|
|
|
|
|
464257
|
vec($gif->{back}, $i*$gif->{w} + $j, 8) = $gif->{'transparent_index'}; |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
sub add_frame { |
319
|
102
|
|
|
102
|
1
|
8328906
|
my ($gif, $delay) = @_; |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
# encode an old frame if needed |
322
|
102
|
100
|
|
|
|
488
|
if($gif->{'has_unencoded_frame'}) { |
323
|
100
|
|
|
|
|
373
|
add_frame_with_transparency($gif, 1); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# determine the changed area since the last frame |
327
|
102
|
|
|
|
|
251
|
my ($w, $h, $x, $y); |
328
|
102
|
100
|
|
|
|
553
|
if (($gif->{nframes} == 0)) { |
|
|
50
|
|
|
|
|
|
329
|
2
|
|
|
|
|
5
|
$w = $gif->{'w'}; |
330
|
2
|
|
|
|
|
5
|
$h = $gif->{'h'}; |
331
|
2
|
|
|
|
|
6
|
$x = $y = 0; |
332
|
|
|
|
|
|
|
} elsif (!get_bbox($gif, \$w, \$h, \$x, \$y)) { |
333
|
|
|
|
|
|
|
# image's not changed; save one pixel just to add delay |
334
|
0
|
|
|
|
|
0
|
$w = $h = 1; |
335
|
0
|
|
|
|
|
0
|
$x = $y = 0; |
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
# encode the frame now if transparency isn't used at all |
339
|
102
|
50
|
|
|
|
420
|
if($gif->{'transparent_index'} == -1) { |
340
|
0
|
0
|
|
|
|
0
|
if($delay) { |
341
|
0
|
|
|
|
|
0
|
add_graphics_control_extension($gif, $delay, DM_DND); |
342
|
|
|
|
|
|
|
} |
343
|
0
|
|
|
|
|
0
|
put_image($gif, FRAME_CUR, $w, $h, $x, $y); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
else { |
346
|
102
|
|
|
|
|
192
|
$gif->{'has_unencoded_frame'} = 1; |
347
|
102
|
|
|
|
|
206
|
$gif->{'unencoded_w'} = $w; |
348
|
102
|
|
|
|
|
232
|
$gif->{'unencoded_h'} = $h; |
349
|
102
|
|
|
|
|
215
|
$gif->{'unencoded_x'} = $x; |
350
|
102
|
|
|
|
|
185
|
$gif->{'unencoded_y'} = $y; |
351
|
102
|
|
|
|
|
177
|
$gif->{'unencoded_delay'} = $delay; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
# move on to the next frame, swap the buffers |
355
|
102
|
|
|
|
|
158
|
$gif->{'nframes'}++; |
356
|
102
|
|
|
|
|
233
|
my $tmp = $gif->{'back'}; |
357
|
102
|
|
|
|
|
179
|
$gif->{'back'} = $gif->{'frame'}; |
358
|
102
|
|
|
|
|
596
|
$gif->{'frame'} = $tmp; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
sub _finish { |
362
|
2
|
|
|
2
|
|
6
|
my ($gif) = @_; |
363
|
|
|
|
|
|
|
# encode an old frame if needed |
364
|
2
|
50
|
|
|
|
7
|
if($gif->{'has_unencoded_frame'}) { |
365
|
2
|
|
|
|
|
7
|
add_frame_with_transparency($gif, 0); |
366
|
|
|
|
|
|
|
} |
367
|
2
|
|
|
|
|
7
|
print {$gif->{'fh'}} ';'; |
|
2
|
|
|
|
|
196
|
|
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
sub DESTROY { |
371
|
2
|
|
|
2
|
|
35
|
$_[0]->_finish(); |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# helper functions |
375
|
|
|
|
|
|
|
sub expand_frame { |
376
|
0
|
|
|
0
|
1
|
0
|
my ($data, $srcbitsperpixel, $desiredbitsperpixel) = @_; |
377
|
0
|
0
|
|
|
|
0
|
(length($data) % $srcbitsperpixel) == 0 or return undef; |
378
|
0
|
|
|
|
|
0
|
my $count = (length($data) * 8) / $srcbitsperpixel; |
379
|
0
|
|
|
|
|
0
|
my $dest; |
380
|
0
|
|
|
|
|
0
|
vec($dest, $count-1, $desiredbitsperpixel) = 0; |
381
|
0
|
|
|
|
|
0
|
for(my $i = 0; $i < $count; $i++) { |
382
|
0
|
|
|
|
|
0
|
vec($dest, $i, $desiredbitsperpixel) = vec($data, $i, $srcbitsperpixel); |
383
|
|
|
|
|
|
|
} |
384
|
0
|
|
|
|
|
0
|
return $dest; |
385
|
|
|
|
|
|
|
} |
386
|
|
|
|
|
|
|
|
387
|
|
|
|
|
|
|
sub _scaleUp { |
388
|
2
|
|
|
2
|
|
7
|
my ($dest, $data, $w, $h, $times) = @_; |
389
|
2
|
|
|
|
|
2
|
my $desti = 0; |
390
|
2
|
|
|
|
|
6
|
for(my $y = 0; $y < $h; $y++) { |
391
|
32
|
|
|
|
|
40
|
my $ystop = $desti + ($w * $times * $times); |
392
|
32
|
|
|
|
|
41
|
while($desti < $ystop) { |
393
|
128
|
|
|
|
|
183
|
for(my $x = 0; $x < $w; $x++) { |
394
|
2048
|
|
|
|
|
2265
|
my $stop = $desti + $times; |
395
|
2048
|
|
|
|
|
2770
|
while($desti < $stop) { |
396
|
8192
|
|
|
|
|
16482
|
vec($$dest, $desti++, 8) = vec($data, ($y * $w) + $x, 8); |
397
|
|
|
|
|
|
|
} |
398
|
|
|
|
|
|
|
} |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
} |
401
|
|
|
|
|
|
|
|
402
|
2
|
|
|
|
|
11
|
return 1; |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
sub _scaleDown { |
406
|
0
|
|
|
0
|
|
0
|
my ($dest, $data, $w, $h, $every) = @_; |
407
|
0
|
|
|
|
|
0
|
my $desti = 0; |
408
|
0
|
|
|
|
|
0
|
for(my $y = 0; $y < $h; $y += $every) { |
409
|
0
|
|
|
|
|
0
|
for(my $x = 0; $x < $w; $x += $every) { |
410
|
0
|
|
|
|
|
0
|
vec($$dest, $desti++, 8) = vec($data, ($y * $w) + $x, 8); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
0
|
|
|
|
|
0
|
return 1; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
sub scale { |
418
|
2
|
|
|
2
|
1
|
38
|
my ($data, $w, $h, $times, $dest) = @_; |
419
|
2
|
50
|
33
|
|
|
12
|
($times == int($times)) && ($times != 0) or return undef; |
420
|
2
|
|
|
|
|
3
|
my ($neww, $newh); |
421
|
2
|
50
|
|
|
|
5
|
if($times > 0) { |
422
|
2
|
|
|
|
|
5
|
$neww = $w * $times; |
423
|
2
|
|
|
|
|
2
|
$newh = $h * $times; |
424
|
2
|
|
|
|
|
14
|
return _scaleUp($dest, $data, $w, $h, $times); |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
else { |
427
|
0
|
|
|
|
|
|
my $div = -$times; |
428
|
0
|
|
|
|
|
|
$neww = $w / $div; |
429
|
0
|
|
|
|
|
|
$newh = $h / $div; |
430
|
0
|
0
|
0
|
|
|
|
($neww == int($neww)) && ($newh == int($newh)) or return undef; |
431
|
0
|
|
|
|
|
|
return _scaleDown($dest, $data, $w, $h, -$times); |
432
|
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
1; |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
__END__ |