1 | #------------------------------------------------------------------------------
|
---|
2 | # File: BZZ.pm
|
---|
3 | #
|
---|
4 | # Description: Utility to decode BZZ compressed data
|
---|
5 | #
|
---|
6 | # Revisions: 09/22/2008 - P. Harvey Created
|
---|
7 | #
|
---|
8 | # References: 1) http://djvu.sourceforge.net/
|
---|
9 | # 2) http://www.djvu.org/
|
---|
10 | #
|
---|
11 | # Notes: This code based on ZPCodec and BSByteStream of DjVuLibre 3.5.21
|
---|
12 | # (see NOTES documentation below for license/copyright details)
|
---|
13 | #------------------------------------------------------------------------------
|
---|
14 |
|
---|
15 | package Image::ExifTool::BZZ;
|
---|
16 |
|
---|
17 | use strict;
|
---|
18 | use integer; # IMPORTANT!! use integer arithmetic throughout
|
---|
19 | require Exporter;
|
---|
20 | use vars qw($VERSION @ISA @EXPORT_OK);
|
---|
21 |
|
---|
22 | $VERSION = '1.00';
|
---|
23 | @ISA = qw(Exporter);
|
---|
24 | @EXPORT_OK = qw(Decode);
|
---|
25 |
|
---|
26 | # constants
|
---|
27 | sub FREQMAX { 4 }
|
---|
28 | sub CTXIDS { 3 }
|
---|
29 | sub MAXBLOCK { 4096 }
|
---|
30 |
|
---|
31 | # This table has been designed for the ZPCoder
|
---|
32 | # by running the following command in file 'zptable.sn':
|
---|
33 | # (fast-crude (steady-mat 0.0035 0.0002) 260)))
|
---|
34 | my @default_ztable_p = (
|
---|
35 | 0x8000, 0x8000, 0x8000, 0x6bbd, 0x6bbd, 0x5d45, 0x5d45, 0x51b9, 0x51b9, 0x4813,
|
---|
36 | 0x4813, 0x3fd5, 0x3fd5, 0x38b1, 0x38b1, 0x3275, 0x3275, 0x2cfd, 0x2cfd, 0x2825,
|
---|
37 | 0x2825, 0x23ab, 0x23ab, 0x1f87, 0x1f87, 0x1bbb, 0x1bbb, 0x1845, 0x1845, 0x1523,
|
---|
38 | 0x1523, 0x1253, 0x1253, 0x0fcf, 0x0fcf, 0x0d95, 0x0d95, 0x0b9d, 0x0b9d, 0x09e3,
|
---|
39 | 0x09e3, 0x0861, 0x0861, 0x0711, 0x0711, 0x05f1, 0x05f1, 0x04f9, 0x04f9, 0x0425,
|
---|
40 | 0x0425, 0x0371, 0x0371, 0x02d9, 0x02d9, 0x0259, 0x0259, 0x01ed, 0x01ed, 0x0193,
|
---|
41 | 0x0193, 0x0149, 0x0149, 0x010b, 0x010b, 0x00d5, 0x00d5, 0x00a5, 0x00a5, 0x007b,
|
---|
42 | 0x007b, 0x0057, 0x0057, 0x003b, 0x003b, 0x0023, 0x0023, 0x0013, 0x0013, 0x0007,
|
---|
43 | 0x0007, 0x0001, 0x0001, 0x5695, 0x24ee, 0x8000, 0x0d30, 0x481a, 0x0481, 0x3579,
|
---|
44 | 0x017a, 0x24ef, 0x007b, 0x1978, 0x0028, 0x10ca, 0x000d, 0x0b5d, 0x0034, 0x078a,
|
---|
45 | 0x00a0, 0x050f, 0x0117, 0x0358, 0x01ea, 0x0234, 0x0144, 0x0173, 0x0234, 0x00f5,
|
---|
46 | 0x0353, 0x00a1, 0x05c5, 0x011a, 0x03cf, 0x01aa, 0x0285, 0x0286, 0x01ab, 0x03d3,
|
---|
47 | 0x011a, 0x05c5, 0x00ba, 0x08ad, 0x007a, 0x0ccc, 0x01eb, 0x1302, 0x02e6, 0x1b81,
|
---|
48 | 0x045e, 0x24ef, 0x0690, 0x2865, 0x09de, 0x3987, 0x0dc8, 0x2c99, 0x10ca, 0x3b5f,
|
---|
49 | 0x0b5d, 0x5695, 0x078a, 0x8000, 0x050f, 0x24ee, 0x0358, 0x0d30, 0x0234, 0x0481,
|
---|
50 | 0x0173, 0x017a, 0x00f5, 0x007b, 0x00a1, 0x0028, 0x011a, 0x000d, 0x01aa, 0x0034,
|
---|
51 | 0x0286, 0x00a0, 0x03d3, 0x0117, 0x05c5, 0x01ea, 0x08ad, 0x0144, 0x0ccc, 0x0234,
|
---|
52 | 0x1302, 0x0353, 0x1b81, 0x05c5, 0x24ef, 0x03cf, 0x2b74, 0x0285, 0x201d, 0x01ab,
|
---|
53 | 0x1715, 0x011a, 0x0fb7, 0x00ba, 0x0a67, 0x01eb, 0x06e7, 0x02e6, 0x0496, 0x045e,
|
---|
54 | 0x030d, 0x0690, 0x0206, 0x09de, 0x0155, 0x0dc8, 0x00e1, 0x2b74, 0x0094, 0x201d,
|
---|
55 | 0x0188, 0x1715, 0x0252, 0x0fb7, 0x0383, 0x0a67, 0x0547, 0x06e7, 0x07e2, 0x0496,
|
---|
56 | 0x0bc0, 0x030d, 0x1178, 0x0206, 0x19da, 0x0155, 0x24ef, 0x00e1, 0x320e, 0x0094,
|
---|
57 | 0x432a, 0x0188, 0x447d, 0x0252, 0x5ece, 0x0383, 0x8000, 0x0547, 0x481a, 0x07e2,
|
---|
58 | 0x3579, 0x0bc0, 0x24ef, 0x1178, 0x1978, 0x19da, 0x2865, 0x24ef, 0x3987, 0x320e,
|
---|
59 | 0x2c99, 0x432a, 0x3b5f, 0x447d, 0x5695, 0x5ece, 0x8000, 0x8000, 0x5695, 0x481a,
|
---|
60 | 0x481a, 0, 0, 0, 0, 0
|
---|
61 | );
|
---|
62 | my @default_ztable_m = (
|
---|
63 | 0x0000, 0x0000, 0x0000, 0x10a5, 0x10a5, 0x1f28, 0x1f28, 0x2bd3, 0x2bd3, 0x36e3,
|
---|
64 | 0x36e3, 0x408c, 0x408c, 0x48fd, 0x48fd, 0x505d, 0x505d, 0x56d0, 0x56d0, 0x5c71,
|
---|
65 | 0x5c71, 0x615b, 0x615b, 0x65a5, 0x65a5, 0x6962, 0x6962, 0x6ca2, 0x6ca2, 0x6f74,
|
---|
66 | 0x6f74, 0x71e6, 0x71e6, 0x7404, 0x7404, 0x75d6, 0x75d6, 0x7768, 0x7768, 0x78c2,
|
---|
67 | 0x78c2, 0x79ea, 0x79ea, 0x7ae7, 0x7ae7, 0x7bbe, 0x7bbe, 0x7c75, 0x7c75, 0x7d0f,
|
---|
68 | 0x7d0f, 0x7d91, 0x7d91, 0x7dfe, 0x7dfe, 0x7e5a, 0x7e5a, 0x7ea6, 0x7ea6, 0x7ee6,
|
---|
69 | 0x7ee6, 0x7f1a, 0x7f1a, 0x7f45, 0x7f45, 0x7f6b, 0x7f6b, 0x7f8d, 0x7f8d, 0x7faa,
|
---|
70 | 0x7faa, 0x7fc3, 0x7fc3, 0x7fd7, 0x7fd7, 0x7fe7, 0x7fe7, 0x7ff2, 0x7ff2, 0x7ffa,
|
---|
71 | 0x7ffa, 0x7fff, 0x7fff, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
72 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
73 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
74 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
75 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
76 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
|
---|
77 | 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
|
---|
78 | );
|
---|
79 | my @default_ztable_up = (
|
---|
80 | 84, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
|
---|
81 | 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33,
|
---|
82 | 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
|
---|
83 | 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65,
|
---|
84 | 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
|
---|
85 | 82, 81, 82, 9, 86, 5, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
|
---|
86 | 82, 99, 76, 101, 70, 103, 66, 105, 106, 107, 66, 109, 60, 111, 56, 69,
|
---|
87 | 114, 65, 116, 61, 118, 57, 120, 53, 122, 49, 124, 43, 72, 39, 60, 33,
|
---|
88 | 56, 29, 52, 23, 48, 23, 42, 137, 38, 21, 140, 15, 142, 9, 144, 141,
|
---|
89 | 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 70, 157, 66, 81, 62, 75,
|
---|
90 | 58, 69, 54, 65, 50, 167, 44, 65, 40, 59, 34, 55, 30, 175, 24, 177,
|
---|
91 | 178, 179, 180, 181, 182, 183, 184, 69, 186, 59, 188, 55, 190, 51, 192, 47,
|
---|
92 | 194, 41, 196, 37, 198, 199, 72, 201, 62, 203, 58, 205, 54, 207, 50, 209,
|
---|
93 | 46, 211, 40, 213, 36, 215, 30, 217, 26, 219, 20, 71, 14, 61, 14, 57,
|
---|
94 | 8, 53, 228, 49, 230, 45, 232, 39, 234, 35, 138, 29, 24, 25, 240, 19,
|
---|
95 | 22, 13, 16, 13, 10, 7, 244, 249, 10, 89, 230, 0, 0, 0, 0, 0
|
---|
96 | );
|
---|
97 | my @default_ztable_dn = (
|
---|
98 | 145, 4, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
|
---|
99 | 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
|
---|
100 | 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
|
---|
101 | 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61,
|
---|
102 | 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
|
---|
103 | 78, 79, 80, 85, 226, 6, 176, 143, 138, 141, 112, 135, 104, 133, 100, 129,
|
---|
104 | 98, 127, 72, 125, 102, 123, 60, 121, 110, 119, 108, 117, 54, 115, 48, 113,
|
---|
105 | 134, 59, 132, 55, 130, 51, 128, 47, 126, 41, 62, 37, 66, 31, 54, 25,
|
---|
106 | 50, 131, 46, 17, 40, 15, 136, 7, 32, 139, 172, 9, 170, 85, 168, 248,
|
---|
107 | 166, 247, 164, 197, 162, 95, 160, 173, 158, 165, 156, 161, 60, 159, 56, 71,
|
---|
108 | 52, 163, 48, 59, 42, 171, 38, 169, 32, 53, 26, 47, 174, 193, 18, 191,
|
---|
109 | 222, 189, 218, 187, 216, 185, 214, 61, 212, 53, 210, 49, 208, 45, 206, 39,
|
---|
110 | 204, 195, 202, 31, 200, 243, 64, 239, 56, 237, 52, 235, 48, 233, 44, 231,
|
---|
111 | 38, 229, 34, 227, 28, 225, 22, 223, 16, 221, 220, 63, 8, 55, 224, 51,
|
---|
112 | 2, 47, 87, 43, 246, 37, 244, 33, 238, 27, 236, 21, 16, 15, 8, 241,
|
---|
113 | 242, 7, 10, 245, 2, 1, 83, 250, 2, 143, 246, 0, 0, 0, 0, 0
|
---|
114 | );
|
---|
115 |
|
---|
116 | #------------------------------------------------------------------------------
|
---|
117 | # New - create new BZZ object
|
---|
118 | # Inputs: 0) reference to BZZ object or BZZ class name
|
---|
119 | # Returns: blessed BZZ object ref
|
---|
120 | sub new
|
---|
121 | {
|
---|
122 | local $_;
|
---|
123 | my $that = shift;
|
---|
124 | my $class = ref($that) || $that || 'Image::ExifTool::BZZ';
|
---|
125 | return bless {}, $class;
|
---|
126 | }
|
---|
127 |
|
---|
128 | #------------------------------------------------------------------------------
|
---|
129 | # Initialize BZZ object
|
---|
130 | # Inputs: 0) BZZ object ref, 1) data ref, 2) true for DjVu compatibility
|
---|
131 | sub Init($$)
|
---|
132 | {
|
---|
133 | my ($self, $dataPt, $djvucompat) = @_;
|
---|
134 | # Create machine independent ffz table
|
---|
135 | my $ffzt = $$self{ffzt} = [ ];
|
---|
136 | my ($i, $j);
|
---|
137 | for ($i=0; $i<256; $i++) {
|
---|
138 | $$ffzt[$i] = 0;
|
---|
139 | for ($j=$i; $j&0x80; $j<<=1) {
|
---|
140 | $$ffzt[$i] += 1;
|
---|
141 | }
|
---|
142 | }
|
---|
143 | # Initialize table
|
---|
144 | $$self{p} = [ @default_ztable_p ];
|
---|
145 | $$self{'m'} = [ @default_ztable_m ];
|
---|
146 | $$self{up} = [ @default_ztable_up ];
|
---|
147 | $$self{dn} = [ @default_ztable_dn ];
|
---|
148 | # Patch table (and lose DjVu compatibility)
|
---|
149 | unless ($djvucompat) {
|
---|
150 | my ($p, $m, $dn) = ($$self{p}, $$self{'m'}, $$self{dn});
|
---|
151 | for ($j=0; $j<256; $j++) {
|
---|
152 | my $a = (0x10000 - $$p[$j]) & 0xffff;
|
---|
153 | while ($a >= 0x8000) { $a = ($a<<1) & 0xffff }
|
---|
154 | if ($$m[$j]>0 && $a+$$p[$j]>=0x8000 && $a>=$$m[$j]) {
|
---|
155 | $$dn[$j] = $default_ztable_dn[$default_ztable_dn[$j]];
|
---|
156 | }
|
---|
157 | }
|
---|
158 | }
|
---|
159 | $$self{ctx} = [ (0) x 300 ];
|
---|
160 | $$self{DataPt} = $dataPt;
|
---|
161 | $$self{Pos} = 0;
|
---|
162 | $$self{DataLen} = length $$dataPt;
|
---|
163 | $$self{a} = 0;
|
---|
164 | $$self{buffer} = 0;
|
---|
165 | $$self{fence} = 0;
|
---|
166 | $$self{blocksize} = 0;
|
---|
167 | # Read first 16 bits of code
|
---|
168 | if (length($$dataPt) >= 2) {
|
---|
169 | $$self{code} = unpack('n', $$dataPt);
|
---|
170 | $$self{Pos} += 2;
|
---|
171 | } elsif (length($$dataPt) >= 1) {
|
---|
172 | $$self{code} = (unpack('C', $$dataPt) << 8) | 0xff;
|
---|
173 | $$self{Pos}++;
|
---|
174 | } else {
|
---|
175 | $$self{code} = 0xffff;
|
---|
176 | }
|
---|
177 | $$self{byte} = $$self{code} & 0xff;
|
---|
178 | # Preload buffer
|
---|
179 | $$self{delay} = 25;
|
---|
180 | $$self{scount} = 0;
|
---|
181 | # Compute initial fence
|
---|
182 | $$self{fence} = $$self{code} >= 0x8000 ? 0x7fff : $$self{code};
|
---|
183 | }
|
---|
184 |
|
---|
185 | #------------------------------------------------------------------------------
|
---|
186 | # Decode data block
|
---|
187 | # Inputs: 0) optional BZZ object ref, 1) optional data ref
|
---|
188 | # Returns: decoded data or undefined on error
|
---|
189 | # Notes: If called without a data ref, an input BZZ object ref must be given and
|
---|
190 | # the BZZ object must have been initialized by a previous call to Init()
|
---|
191 | sub Decode($;$)
|
---|
192 | {
|
---|
193 | # Decode input stream
|
---|
194 | local $_;
|
---|
195 | my $self;
|
---|
196 | if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool::BZZ')) {
|
---|
197 | $self = shift;
|
---|
198 | } else {
|
---|
199 | $self = new Image::ExifTool::BZZ;
|
---|
200 | }
|
---|
201 | my $dataPt = shift;
|
---|
202 | if ($dataPt) {
|
---|
203 | $self->Init($dataPt, 1);
|
---|
204 | } else {
|
---|
205 | $dataPt = $$self{DataPt} or return undef;
|
---|
206 | }
|
---|
207 | # Decode block size
|
---|
208 | my $n = 1;
|
---|
209 | my $m = (1 << 24);
|
---|
210 | while ($n < $m) {
|
---|
211 | my $b = $self->decode_sub(0x8000 + ($$self{a}>>1));
|
---|
212 | $n = ($n<<1) | $b;
|
---|
213 | }
|
---|
214 | $$self{size} = $n - $m;
|
---|
215 |
|
---|
216 | return '' unless $$self{size};
|
---|
217 | return undef if $$self{size} > MAXBLOCK()*1024;
|
---|
218 | # Allocate
|
---|
219 | if ($$self{blocksize} < $$self{size}) {
|
---|
220 | $$self{blocksize} = $$self{size};
|
---|
221 | }
|
---|
222 | # Decode Estimation Speed
|
---|
223 | my $fshift = 0;
|
---|
224 | if ($self->decode_sub(0x8000 + ($$self{a}>>1))) {
|
---|
225 | $fshift += 1;
|
---|
226 | $fshift += 1 if $self->decode_sub(0x8000 + ($$self{a}>>1));
|
---|
227 | }
|
---|
228 | # Prepare Quasi MTF
|
---|
229 | my @mtf = (0..255);
|
---|
230 | my @freq = (0) x FREQMAX();
|
---|
231 | my $fadd = 4;
|
---|
232 | # Decode
|
---|
233 | my $mtfno = 3;
|
---|
234 | my $markerpos = -1;
|
---|
235 | my $cx = $$self{ctx};
|
---|
236 | my ($i, @dat);
|
---|
237 | byte: for ($i=0; $i<$$self{size}; $i++) {
|
---|
238 | # dummy loop avoids use of "goto" statement
|
---|
239 | dummy: for (;;) {
|
---|
240 | my $ctxid = CTXIDS() - 1;
|
---|
241 | $ctxid = $mtfno if $ctxid > $mtfno;
|
---|
242 | my $cp = 0;
|
---|
243 | my ($imtf, $bits);
|
---|
244 | for ($imtf=0; $imtf<2; ++$imtf) {
|
---|
245 | if ($self->decoder($$cx[$cp+$ctxid])) {
|
---|
246 | $mtfno = $imtf;
|
---|
247 | $dat[$i] = $mtf[$mtfno];
|
---|
248 | # (a "goto" here could give a segfault due to a Perl bug)
|
---|
249 | last dummy; # do rotation
|
---|
250 | }
|
---|
251 | $cp += CTXIDS();
|
---|
252 | }
|
---|
253 | for ($bits=1; $bits<8; ++$bits, $imtf<<=1) {
|
---|
254 | if ($self->decoder($$cx[$cp])) {
|
---|
255 | my $n = 1;
|
---|
256 | my $m = (1 << $bits);
|
---|
257 | while ($n < $m) {
|
---|
258 | my $b = $self->decoder($$cx[$cp+$n]);
|
---|
259 | $n = ($n<<1) | $b;
|
---|
260 | }
|
---|
261 | $mtfno = $imtf + $n - $m;
|
---|
262 | $dat[$i] = $mtf[$mtfno];
|
---|
263 | last dummy; # do rotation
|
---|
264 | }
|
---|
265 | $cp += $imtf;
|
---|
266 | }
|
---|
267 | $mtfno=256;
|
---|
268 | $dat[$i] = 0;
|
---|
269 | $markerpos=$i;
|
---|
270 | next byte; # no rotation necessary
|
---|
271 | }
|
---|
272 | # Rotate mtf according to empirical frequencies (new!)
|
---|
273 | # Adjust frequencies for overflow
|
---|
274 | $fadd = $fadd + ($fadd >> $fshift);
|
---|
275 | if ($fadd > 0x10000000) {
|
---|
276 | $fadd >>= 24;
|
---|
277 | $_ >>= 24 foreach @freq;
|
---|
278 | }
|
---|
279 | # Relocate new char according to new freq
|
---|
280 | my $fc = $fadd;
|
---|
281 | $fc += $freq[$mtfno] if $mtfno < FREQMAX();
|
---|
282 | my $k;
|
---|
283 | for ($k=$mtfno; $k>=FREQMAX(); $k--) {
|
---|
284 | $mtf[$k] = $mtf[$k-1];
|
---|
285 | }
|
---|
286 | for (; $k>0 && $fc>=$freq[$k-1]; $k--) {
|
---|
287 | $mtf[$k] = $mtf[$k-1];
|
---|
288 | $freq[$k] = $freq[$k-1];
|
---|
289 | }
|
---|
290 | $mtf[$k] = $dat[$i];
|
---|
291 | $freq[$k] = $fc;
|
---|
292 | # when "goto" was used, Perl 5.8.6 could segfault here
|
---|
293 | # unless "next" was explicitly stated
|
---|
294 | }
|
---|
295 | #
|
---|
296 | # Reconstruct the string
|
---|
297 | #
|
---|
298 | return undef if $markerpos<1 || $markerpos>=$$self{size};
|
---|
299 | # Allocate pointers
|
---|
300 | # Prepare count buffer
|
---|
301 | my @count = (0) x 256;
|
---|
302 | my @posn;
|
---|
303 | # Fill count buffer
|
---|
304 | no integer;
|
---|
305 | for ($i=0; $i<$markerpos; $i++) {
|
---|
306 | my $c = $dat[$i];
|
---|
307 | $posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
---|
308 | }
|
---|
309 | $posn[$i++] = 0; # (initialize marker entry just to be safe)
|
---|
310 | for ( ; $i<$$self{size}; $i++) {
|
---|
311 | my $c = $dat[$i];
|
---|
312 | $posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
---|
313 | }
|
---|
314 | use integer;
|
---|
315 | # Compute sorted char positions
|
---|
316 | my $last = 1;
|
---|
317 | for ($i=0; $i<256; $i++) {
|
---|
318 | my $tmp = $count[$i];
|
---|
319 | $count[$i] = $last;
|
---|
320 | $last += $tmp;
|
---|
321 | }
|
---|
322 | # Undo the sort transform
|
---|
323 | $i = 0;
|
---|
324 | $last = $$self{size}-1;
|
---|
325 | while ($last > 0) {
|
---|
326 | my $n = $posn[$i];
|
---|
327 | no integer;
|
---|
328 | my $c = $n >> 24;
|
---|
329 | use integer;
|
---|
330 | $dat[--$last] = $c;
|
---|
331 | $i = $count[$c] + ($n & 0xffffff);
|
---|
332 | }
|
---|
333 | # Final check and return decoded data
|
---|
334 | return undef if $i != $markerpos;
|
---|
335 | pop @dat; # (last byte isn't real)
|
---|
336 | return pack 'C*', @dat;
|
---|
337 | }
|
---|
338 |
|
---|
339 | #------------------------------------------------------------------------------
|
---|
340 | # Inputs: 0) BZZ object ref, 1) ctx
|
---|
341 | # Returns: decoded bit
|
---|
342 | sub decoder($$)
|
---|
343 | {
|
---|
344 | my ($self, $ctx) = @_;
|
---|
345 | my $z = $$self{a} + $self->{p}[$ctx];
|
---|
346 | if ($z <= $$self{fence}) {
|
---|
347 | $$self{a} = $z;
|
---|
348 | return ($ctx & 1);
|
---|
349 | }
|
---|
350 | # must pass $_[1] so subroutine can modify value (darned C++ pass-by-reference!)
|
---|
351 | return $self->decode_sub($z, $_[1]);
|
---|
352 | }
|
---|
353 |
|
---|
354 | #------------------------------------------------------------------------------
|
---|
355 | # Inputs: 0) BZZ object ref, 1) z, 2) ctx (or undef)
|
---|
356 | # Returns: decoded bit
|
---|
357 | sub decode_sub($$;$)
|
---|
358 | {
|
---|
359 | my ($self, $z, $ctx) = @_;
|
---|
360 |
|
---|
361 | # ensure that we have at least 16 bits of encoded data available
|
---|
362 | if ($$self{scount} < 16) {
|
---|
363 | # preload byte by byte until we have at least 24 bits
|
---|
364 | while ($$self{scount} <= 24) {
|
---|
365 | if ($$self{Pos} < $$self{DataLen}) {
|
---|
366 | $$self{byte} = ord(substr(${$$self{DataPt}}, $$self{Pos}, 1));
|
---|
367 | ++$$self{Pos};
|
---|
368 | } else {
|
---|
369 | $$self{byte} = 0xff;
|
---|
370 | if (--$$self{delay} < 1) {
|
---|
371 | # setting size to zero forces error return from Decode()
|
---|
372 | $$self{size} = 0;
|
---|
373 | return 0;
|
---|
374 | }
|
---|
375 | }
|
---|
376 | $$self{buffer} = ($$self{buffer}<<8) | $$self{byte};
|
---|
377 | $$self{scount} += 8;
|
---|
378 | }
|
---|
379 | }
|
---|
380 | # Save bit
|
---|
381 | my $a = $$self{a};
|
---|
382 | my ($bit, $code);
|
---|
383 | if (defined $ctx) {
|
---|
384 | $bit = ($ctx & 1);
|
---|
385 | # Avoid interval reversion
|
---|
386 | my $d = 0x6000 + (($z+$a)>>2);
|
---|
387 | $z = $d if $z > $d;
|
---|
388 | } else {
|
---|
389 | $bit = 0;
|
---|
390 | }
|
---|
391 | # Test MPS/LPS
|
---|
392 | if ($z > ($code = $$self{code})) {
|
---|
393 | $bit ^= 1;
|
---|
394 | # LPS branch
|
---|
395 | $z = 0x10000 - $z;
|
---|
396 | $a += $z;
|
---|
397 | $code += $z;
|
---|
398 | # LPS adaptation
|
---|
399 | $_[2] = $self->{dn}[$ctx] if defined $ctx;
|
---|
400 | # LPS renormalization
|
---|
401 | my $sft = $a>=0xff00 ? $self->{ffzt}[$a&0xff] + 8 : $self->{ffzt}[($a>>8)&0xff];
|
---|
402 | $$self{scount} -= $sft;
|
---|
403 | $$self{a} = ($a<<$sft) & 0xffff;
|
---|
404 | $code = (($code<<$sft) & 0xffff) | (($$self{buffer}>>$$self{scount}) & ((1<<$sft)-1));
|
---|
405 | } else {
|
---|
406 | # MPS adaptation
|
---|
407 | $_[2] = $self->{up}[$ctx] if defined $ctx and $a >= $self->{'m'}[$ctx];
|
---|
408 | # MPS renormalization
|
---|
409 | $$self{scount} -= 1;
|
---|
410 | $$self{a} = ($z<<1) & 0xffff;
|
---|
411 | $code = (($code<<1) & 0xffff) | (($$self{buffer}>>$$self{scount}) & 1);
|
---|
412 | }
|
---|
413 | # Adjust fence and save new code
|
---|
414 | $$self{fence} = $code >= 0x8000 ? 0x7fff : $code;
|
---|
415 | $$self{code} = $code;
|
---|
416 | return $bit;
|
---|
417 | }
|
---|
418 |
|
---|
419 | 1; # end
|
---|
420 |
|
---|
421 | __END__
|
---|
422 |
|
---|
423 | =head1 NAME
|
---|
424 |
|
---|
425 | Image::ExifTool::BZZ - Utility to decode BZZ compressed data
|
---|
426 |
|
---|
427 | =head1 SYNOPSIS
|
---|
428 |
|
---|
429 | This module is used by Image::ExifTool
|
---|
430 |
|
---|
431 | =head1 DESCRIPTION
|
---|
432 |
|
---|
433 | This module contains definitions required by Image::ExifTool to decode BZZ
|
---|
434 | compressed data in DjVu images.
|
---|
435 |
|
---|
436 | =head1 NOTES
|
---|
437 |
|
---|
438 | This code is based on ZPCodec and BSByteStream of DjVuLibre 3.5.21 (see
|
---|
439 | additional copyrights and the first reference below), which are covered
|
---|
440 | under the GNU GPL license.
|
---|
441 |
|
---|
442 | This is implemented as Image::ExifTool::BZZ instead of Compress::BZZ because
|
---|
443 | I am hoping that someone else will write a proper Compress::BZZ module (with
|
---|
444 | compression ability).
|
---|
445 |
|
---|
446 | =head1 AUTHOR
|
---|
447 |
|
---|
448 | Copyright 2003-2011, Phil Harvey (phil at owl.phy.queensu.ca)
|
---|
449 | Copyright 2002, Leon Bottou and Yann Le Cun
|
---|
450 | Copyright 2001, AT&T
|
---|
451 | Copyright 1999-2001, LizardTech Inc.
|
---|
452 |
|
---|
453 | This library is free software; you can redistribute it and/or modify it
|
---|
454 | under the same terms as Perl itself.
|
---|
455 |
|
---|
456 | =head1 REFERENCES
|
---|
457 |
|
---|
458 | =over 4
|
---|
459 |
|
---|
460 | =item L<http://djvu.sourceforge.net/>
|
---|
461 |
|
---|
462 | =item L<http://www.djvu.org/>
|
---|
463 |
|
---|
464 | =back
|
---|
465 |
|
---|
466 | =head1 SEE ALSO
|
---|
467 |
|
---|
468 | L<Image::ExifTool::DjVu(3pm)|Image::ExifTool::DjVu>,
|
---|
469 | L<Image::ExifTool(3pm)|Image::ExifTool>
|
---|
470 |
|
---|
471 | =cut
|
---|
472 |
|
---|