473 lines
18 KiB
Perl
473 lines
18 KiB
Perl
|
#------------------------------------------------------------------------------
|
||
|
|
# File: BZZ.pm
|
||
|
|
#
|
||
|
|
# Description: Utility to decode BZZ compressed data
|
||
|
|
#
|
||
|
|
# Revisions: 09/22/2008 - P. Harvey Created
|
||
|
|
#
|
||
|
|
# References: 1) http://djvu.sourceforge.net/
|
||
|
|
# 2) http://www.djvu.org/
|
||
|
|
#
|
||
|
|
# Notes: This code based on ZPCodec and BSByteStream of DjVuLibre 3.5.21
|
||
|
|
# (see NOTES documentation below for license/copyright details)
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
package Image::ExifTool::BZZ;
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use integer; # IMPORTANT!! use integer arithmetic throughout
|
||
|
|
require Exporter;
|
||
|
|
use vars qw($VERSION @ISA @EXPORT_OK);
|
||
|
|
|
||
|
|
$VERSION = '1.00';
|
||
|
|
@ISA = qw(Exporter);
|
||
|
|
@EXPORT_OK = qw(Decode);
|
||
|
|
|
||
|
|
# constants
|
||
|
|
sub FREQMAX { 4 }
|
||
|
|
sub CTXIDS { 3 }
|
||
|
|
sub MAXBLOCK { 4096 }
|
||
|
|
|
||
|
|
# This table has been designed for the ZPCoder
|
||
|
|
# by running the following command in file 'zptable.sn':
|
||
|
|
# (fast-crude (steady-mat 0.0035 0.0002) 260)))
|
||
|
|
my @default_ztable_p = (
|
||
|
|
0x8000, 0x8000, 0x8000, 0x6bbd, 0x6bbd, 0x5d45, 0x5d45, 0x51b9, 0x51b9, 0x4813,
|
||
|
|
0x4813, 0x3fd5, 0x3fd5, 0x38b1, 0x38b1, 0x3275, 0x3275, 0x2cfd, 0x2cfd, 0x2825,
|
||
|
|
0x2825, 0x23ab, 0x23ab, 0x1f87, 0x1f87, 0x1bbb, 0x1bbb, 0x1845, 0x1845, 0x1523,
|
||
|
|
0x1523, 0x1253, 0x1253, 0x0fcf, 0x0fcf, 0x0d95, 0x0d95, 0x0b9d, 0x0b9d, 0x09e3,
|
||
|
|
0x09e3, 0x0861, 0x0861, 0x0711, 0x0711, 0x05f1, 0x05f1, 0x04f9, 0x04f9, 0x0425,
|
||
|
|
0x0425, 0x0371, 0x0371, 0x02d9, 0x02d9, 0x0259, 0x0259, 0x01ed, 0x01ed, 0x0193,
|
||
|
|
0x0193, 0x0149, 0x0149, 0x010b, 0x010b, 0x00d5, 0x00d5, 0x00a5, 0x00a5, 0x007b,
|
||
|
|
0x007b, 0x0057, 0x0057, 0x003b, 0x003b, 0x0023, 0x0023, 0x0013, 0x0013, 0x0007,
|
||
|
|
0x0007, 0x0001, 0x0001, 0x5695, 0x24ee, 0x8000, 0x0d30, 0x481a, 0x0481, 0x3579,
|
||
|
|
0x017a, 0x24ef, 0x007b, 0x1978, 0x0028, 0x10ca, 0x000d, 0x0b5d, 0x0034, 0x078a,
|
||
|
|
0x00a0, 0x050f, 0x0117, 0x0358, 0x01ea, 0x0234, 0x0144, 0x0173, 0x0234, 0x00f5,
|
||
|
|
0x0353, 0x00a1, 0x05c5, 0x011a, 0x03cf, 0x01aa, 0x0285, 0x0286, 0x01ab, 0x03d3,
|
||
|
|
0x011a, 0x05c5, 0x00ba, 0x08ad, 0x007a, 0x0ccc, 0x01eb, 0x1302, 0x02e6, 0x1b81,
|
||
|
|
0x045e, 0x24ef, 0x0690, 0x2865, 0x09de, 0x3987, 0x0dc8, 0x2c99, 0x10ca, 0x3b5f,
|
||
|
|
0x0b5d, 0x5695, 0x078a, 0x8000, 0x050f, 0x24ee, 0x0358, 0x0d30, 0x0234, 0x0481,
|
||
|
|
0x0173, 0x017a, 0x00f5, 0x007b, 0x00a1, 0x0028, 0x011a, 0x000d, 0x01aa, 0x0034,
|
||
|
|
0x0286, 0x00a0, 0x03d3, 0x0117, 0x05c5, 0x01ea, 0x08ad, 0x0144, 0x0ccc, 0x0234,
|
||
|
|
0x1302, 0x0353, 0x1b81, 0x05c5, 0x24ef, 0x03cf, 0x2b74, 0x0285, 0x201d, 0x01ab,
|
||
|
|
0x1715, 0x011a, 0x0fb7, 0x00ba, 0x0a67, 0x01eb, 0x06e7, 0x02e6, 0x0496, 0x045e,
|
||
|
|
0x030d, 0x0690, 0x0206, 0x09de, 0x0155, 0x0dc8, 0x00e1, 0x2b74, 0x0094, 0x201d,
|
||
|
|
0x0188, 0x1715, 0x0252, 0x0fb7, 0x0383, 0x0a67, 0x0547, 0x06e7, 0x07e2, 0x0496,
|
||
|
|
0x0bc0, 0x030d, 0x1178, 0x0206, 0x19da, 0x0155, 0x24ef, 0x00e1, 0x320e, 0x0094,
|
||
|
|
0x432a, 0x0188, 0x447d, 0x0252, 0x5ece, 0x0383, 0x8000, 0x0547, 0x481a, 0x07e2,
|
||
|
|
0x3579, 0x0bc0, 0x24ef, 0x1178, 0x1978, 0x19da, 0x2865, 0x24ef, 0x3987, 0x320e,
|
||
|
|
0x2c99, 0x432a, 0x3b5f, 0x447d, 0x5695, 0x5ece, 0x8000, 0x8000, 0x5695, 0x481a,
|
||
|
|
0x481a, 0, 0, 0, 0, 0
|
||
|
|
);
|
||
|
|
my @default_ztable_m = (
|
||
|
|
0x0000, 0x0000, 0x0000, 0x10a5, 0x10a5, 0x1f28, 0x1f28, 0x2bd3, 0x2bd3, 0x36e3,
|
||
|
|
0x36e3, 0x408c, 0x408c, 0x48fd, 0x48fd, 0x505d, 0x505d, 0x56d0, 0x56d0, 0x5c71,
|
||
|
|
0x5c71, 0x615b, 0x615b, 0x65a5, 0x65a5, 0x6962, 0x6962, 0x6ca2, 0x6ca2, 0x6f74,
|
||
|
|
0x6f74, 0x71e6, 0x71e6, 0x7404, 0x7404, 0x75d6, 0x75d6, 0x7768, 0x7768, 0x78c2,
|
||
|
|
0x78c2, 0x79ea, 0x79ea, 0x7ae7, 0x7ae7, 0x7bbe, 0x7bbe, 0x7c75, 0x7c75, 0x7d0f,
|
||
|
|
0x7d0f, 0x7d91, 0x7d91, 0x7dfe, 0x7dfe, 0x7e5a, 0x7e5a, 0x7ea6, 0x7ea6, 0x7ee6,
|
||
|
|
0x7ee6, 0x7f1a, 0x7f1a, 0x7f45, 0x7f45, 0x7f6b, 0x7f6b, 0x7f8d, 0x7f8d, 0x7faa,
|
||
|
|
0x7faa, 0x7fc3, 0x7fc3, 0x7fd7, 0x7fd7, 0x7fe7, 0x7fe7, 0x7ff2, 0x7ff2, 0x7ffa,
|
||
|
|
0x7ffa, 0x7fff, 0x7fff, 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, 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, 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, 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, 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, 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, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
|
||
|
|
);
|
||
|
|
my @default_ztable_up = (
|
||
|
|
84, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
|
||
|
|
18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33,
|
||
|
|
34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49,
|
||
|
|
50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65,
|
||
|
|
66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
|
||
|
|
82, 81, 82, 9, 86, 5, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97,
|
||
|
|
82, 99, 76, 101, 70, 103, 66, 105, 106, 107, 66, 109, 60, 111, 56, 69,
|
||
|
|
114, 65, 116, 61, 118, 57, 120, 53, 122, 49, 124, 43, 72, 39, 60, 33,
|
||
|
|
56, 29, 52, 23, 48, 23, 42, 137, 38, 21, 140, 15, 142, 9, 144, 141,
|
||
|
|
146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 70, 157, 66, 81, 62, 75,
|
||
|
|
58, 69, 54, 65, 50, 167, 44, 65, 40, 59, 34, 55, 30, 175, 24, 177,
|
||
|
|
178, 179, 180, 181, 182, 183, 184, 69, 186, 59, 188, 55, 190, 51, 192, 47,
|
||
|
|
194, 41, 196, 37, 198, 199, 72, 201, 62, 203, 58, 205, 54, 207, 50, 209,
|
||
|
|
46, 211, 40, 213, 36, 215, 30, 217, 26, 219, 20, 71, 14, 61, 14, 57,
|
||
|
|
8, 53, 228, 49, 230, 45, 232, 39, 234, 35, 138, 29, 24, 25, 240, 19,
|
||
|
|
22, 13, 16, 13, 10, 7, 244, 249, 10, 89, 230, 0, 0, 0, 0, 0
|
||
|
|
);
|
||
|
|
my @default_ztable_dn = (
|
||
|
|
145, 4, 3, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
|
||
|
|
14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
|
||
|
|
30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
|
||
|
|
46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61,
|
||
|
|
62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
|
||
|
|
78, 79, 80, 85, 226, 6, 176, 143, 138, 141, 112, 135, 104, 133, 100, 129,
|
||
|
|
98, 127, 72, 125, 102, 123, 60, 121, 110, 119, 108, 117, 54, 115, 48, 113,
|
||
|
|
134, 59, 132, 55, 130, 51, 128, 47, 126, 41, 62, 37, 66, 31, 54, 25,
|
||
|
|
50, 131, 46, 17, 40, 15, 136, 7, 32, 139, 172, 9, 170, 85, 168, 248,
|
||
|
|
166, 247, 164, 197, 162, 95, 160, 173, 158, 165, 156, 161, 60, 159, 56, 71,
|
||
|
|
52, 163, 48, 59, 42, 171, 38, 169, 32, 53, 26, 47, 174, 193, 18, 191,
|
||
|
|
222, 189, 218, 187, 216, 185, 214, 61, 212, 53, 210, 49, 208, 45, 206, 39,
|
||
|
|
204, 195, 202, 31, 200, 243, 64, 239, 56, 237, 52, 235, 48, 233, 44, 231,
|
||
|
|
38, 229, 34, 227, 28, 225, 22, 223, 16, 221, 220, 63, 8, 55, 224, 51,
|
||
|
|
2, 47, 87, 43, 246, 37, 244, 33, 238, 27, 236, 21, 16, 15, 8, 241,
|
||
|
|
242, 7, 10, 245, 2, 1, 83, 250, 2, 143, 246, 0, 0, 0, 0, 0
|
||
|
|
);
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# New - create new BZZ object
|
||
|
|
# Inputs: 0) reference to BZZ object or BZZ class name
|
||
|
|
# Returns: blessed BZZ object ref
|
||
|
|
sub new
|
||
|
|
{
|
||
|
|
local $_;
|
||
|
|
my $that = shift;
|
||
|
|
my $class = ref($that) || $that || 'Image::ExifTool::BZZ';
|
||
|
|
return bless {}, $class;
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Initialize BZZ object
|
||
|
|
# Inputs: 0) BZZ object ref, 1) data ref, 2) true for DjVu compatibility
|
||
|
|
sub Init($$)
|
||
|
|
{
|
||
|
|
my ($self, $dataPt, $djvucompat) = @_;
|
||
|
|
# Create machine independent ffz table
|
||
|
|
my $ffzt = $$self{ffzt} = [ ];
|
||
|
|
my ($i, $j);
|
||
|
|
for ($i=0; $i<256; $i++) {
|
||
|
|
$$ffzt[$i] = 0;
|
||
|
|
for ($j=$i; $j&0x80; $j<<=1) {
|
||
|
|
$$ffzt[$i] += 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Initialize table
|
||
|
|
$$self{p} = [ @default_ztable_p ];
|
||
|
|
$$self{'m'} = [ @default_ztable_m ];
|
||
|
|
$$self{up} = [ @default_ztable_up ];
|
||
|
|
$$self{dn} = [ @default_ztable_dn ];
|
||
|
|
# Patch table (and lose DjVu compatibility)
|
||
|
|
unless ($djvucompat) {
|
||
|
|
my ($p, $m, $dn) = ($$self{p}, $$self{'m'}, $$self{dn});
|
||
|
|
for ($j=0; $j<256; $j++) {
|
||
|
|
my $a = (0x10000 - $$p[$j]) & 0xffff;
|
||
|
|
while ($a >= 0x8000) { $a = ($a<<1) & 0xffff }
|
||
|
|
if ($$m[$j]>0 && $a+$$p[$j]>=0x8000 && $a>=$$m[$j]) {
|
||
|
|
$$dn[$j] = $default_ztable_dn[$default_ztable_dn[$j]];
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$$self{ctx} = [ (0) x 300 ];
|
||
|
|
$$self{DataPt} = $dataPt;
|
||
|
|
$$self{Pos} = 0;
|
||
|
|
$$self{DataLen} = length $$dataPt;
|
||
|
|
$$self{a} = 0;
|
||
|
|
$$self{buffer} = 0;
|
||
|
|
$$self{fence} = 0;
|
||
|
|
$$self{blocksize} = 0;
|
||
|
|
# Read first 16 bits of code
|
||
|
|
if (length($$dataPt) >= 2) {
|
||
|
|
$$self{code} = unpack('n', $$dataPt);
|
||
|
|
$$self{Pos} += 2;
|
||
|
|
} elsif (length($$dataPt) >= 1) {
|
||
|
|
$$self{code} = (unpack('C', $$dataPt) << 8) | 0xff;
|
||
|
|
$$self{Pos}++;
|
||
|
|
} else {
|
||
|
|
$$self{code} = 0xffff;
|
||
|
|
}
|
||
|
|
$$self{byte} = $$self{code} & 0xff;
|
||
|
|
# Preload buffer
|
||
|
|
$$self{delay} = 25;
|
||
|
|
$$self{scount} = 0;
|
||
|
|
# Compute initial fence
|
||
|
|
$$self{fence} = $$self{code} >= 0x8000 ? 0x7fff : $$self{code};
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Decode data block
|
||
|
|
# Inputs: 0) optional BZZ object ref, 1) optional data ref
|
||
|
|
# Returns: decoded data or undefined on error
|
||
|
|
# Notes: If called without a data ref, an input BZZ object ref must be given and
|
||
|
|
# the BZZ object must have been initialized by a previous call to Init()
|
||
|
|
sub Decode($;$)
|
||
|
|
{
|
||
|
|
# Decode input stream
|
||
|
|
local $_;
|
||
|
|
my $self;
|
||
|
|
if (ref $_[0] and UNIVERSAL::isa($_[0],'Image::ExifTool::BZZ')) {
|
||
|
|
$self = shift;
|
||
|
|
} else {
|
||
|
|
$self = new Image::ExifTool::BZZ;
|
||
|
|
}
|
||
|
|
my $dataPt = shift;
|
||
|
|
if ($dataPt) {
|
||
|
|
$self->Init($dataPt, 1);
|
||
|
|
} else {
|
||
|
|
$dataPt = $$self{DataPt} or return undef;
|
||
|
|
}
|
||
|
|
# Decode block size
|
||
|
|
my $n = 1;
|
||
|
|
my $m = (1 << 24);
|
||
|
|
while ($n < $m) {
|
||
|
|
my $b = $self->decode_sub(0x8000 + ($$self{a}>>1));
|
||
|
|
$n = ($n<<1) | $b;
|
||
|
|
}
|
||
|
|
$$self{size} = $n - $m;
|
||
|
|
|
||
|
|
return '' unless $$self{size};
|
||
|
|
return undef if $$self{size} > MAXBLOCK()*1024;
|
||
|
|
# Allocate
|
||
|
|
if ($$self{blocksize} < $$self{size}) {
|
||
|
|
$$self{blocksize} = $$self{size};
|
||
|
|
}
|
||
|
|
# Decode Estimation Speed
|
||
|
|
my $fshift = 0;
|
||
|
|
if ($self->decode_sub(0x8000 + ($$self{a}>>1))) {
|
||
|
|
$fshift += 1;
|
||
|
|
$fshift += 1 if $self->decode_sub(0x8000 + ($$self{a}>>1));
|
||
|
|
}
|
||
|
|
# Prepare Quasi MTF
|
||
|
|
my @mtf = (0..255);
|
||
|
|
my @freq = (0) x FREQMAX();
|
||
|
|
my $fadd = 4;
|
||
|
|
# Decode
|
||
|
|
my $mtfno = 3;
|
||
|
|
my $markerpos = -1;
|
||
|
|
my $cx = $$self{ctx};
|
||
|
|
my ($i, @dat);
|
||
|
|
byte: for ($i=0; $i<$$self{size}; $i++) {
|
||
|
|
# dummy loop avoids use of "goto" statement
|
||
|
|
dummy: for (;;) {
|
||
|
|
my $ctxid = CTXIDS() - 1;
|
||
|
|
$ctxid = $mtfno if $ctxid > $mtfno;
|
||
|
|
my $cp = 0;
|
||
|
|
my ($imtf, $bits);
|
||
|
|
for ($imtf=0; $imtf<2; ++$imtf) {
|
||
|
|
if ($self->decoder($$cx[$cp+$ctxid])) {
|
||
|
|
$mtfno = $imtf;
|
||
|
|
$dat[$i] = $mtf[$mtfno];
|
||
|
|
# (a "goto" here could give a segfault due to a Perl bug)
|
||
|
|
last dummy; # do rotation
|
||
|
|
}
|
||
|
|
$cp += CTXIDS();
|
||
|
|
}
|
||
|
|
for ($bits=1; $bits<8; ++$bits, $imtf<<=1) {
|
||
|
|
if ($self->decoder($$cx[$cp])) {
|
||
|
|
my $n = 1;
|
||
|
|
my $m = (1 << $bits);
|
||
|
|
while ($n < $m) {
|
||
|
|
my $b = $self->decoder($$cx[$cp+$n]);
|
||
|
|
$n = ($n<<1) | $b;
|
||
|
|
}
|
||
|
|
$mtfno = $imtf + $n - $m;
|
||
|
|
$dat[$i] = $mtf[$mtfno];
|
||
|
|
last dummy; # do rotation
|
||
|
|
}
|
||
|
|
$cp += $imtf;
|
||
|
|
}
|
||
|
|
$mtfno=256;
|
||
|
|
$dat[$i] = 0;
|
||
|
|
$markerpos=$i;
|
||
|
|
next byte; # no rotation necessary
|
||
|
|
}
|
||
|
|
# Rotate mtf according to empirical frequencies (new!)
|
||
|
|
# Adjust frequencies for overflow
|
||
|
|
$fadd = $fadd + ($fadd >> $fshift);
|
||
|
|
if ($fadd > 0x10000000) {
|
||
|
|
$fadd >>= 24;
|
||
|
|
$_ >>= 24 foreach @freq;
|
||
|
|
}
|
||
|
|
# Relocate new char according to new freq
|
||
|
|
my $fc = $fadd;
|
||
|
|
$fc += $freq[$mtfno] if $mtfno < FREQMAX();
|
||
|
|
my $k;
|
||
|
|
for ($k=$mtfno; $k>=FREQMAX(); $k--) {
|
||
|
|
$mtf[$k] = $mtf[$k-1];
|
||
|
|
}
|
||
|
|
for (; $k>0 && $fc>=$freq[$k-1]; $k--) {
|
||
|
|
$mtf[$k] = $mtf[$k-1];
|
||
|
|
$freq[$k] = $freq[$k-1];
|
||
|
|
}
|
||
|
|
$mtf[$k] = $dat[$i];
|
||
|
|
$freq[$k] = $fc;
|
||
|
|
# when "goto" was used, Perl 5.8.6 could segfault here
|
||
|
|
# unless "next" was explicitly stated
|
||
|
|
}
|
||
|
|
#
|
||
|
|
# Reconstruct the string
|
||
|
|
#
|
||
|
|
return undef if $markerpos<1 || $markerpos>=$$self{size};
|
||
|
|
# Allocate pointers
|
||
|
|
# Prepare count buffer
|
||
|
|
my @count = (0) x 256;
|
||
|
|
my @posn;
|
||
|
|
# Fill count buffer
|
||
|
|
no integer;
|
||
|
|
for ($i=0; $i<$markerpos; $i++) {
|
||
|
|
my $c = $dat[$i];
|
||
|
|
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
||
|
|
}
|
||
|
|
$posn[$i++] = 0; # (initialize marker entry just to be safe)
|
||
|
|
for ( ; $i<$$self{size}; $i++) {
|
||
|
|
my $c = $dat[$i];
|
||
|
|
$posn[$i] = ($c<<24) | ($count[$c]++ & 0xffffff);
|
||
|
|
}
|
||
|
|
use integer;
|
||
|
|
# Compute sorted char positions
|
||
|
|
my $last = 1;
|
||
|
|
for ($i=0; $i<256; $i++) {
|
||
|
|
my $tmp = $count[$i];
|
||
|
|
$count[$i] = $last;
|
||
|
|
$last += $tmp;
|
||
|
|
}
|
||
|
|
# Undo the sort transform
|
||
|
|
$i = 0;
|
||
|
|
$last = $$self{size}-1;
|
||
|
|
while ($last > 0) {
|
||
|
|
my $n = $posn[$i];
|
||
|
|
no integer;
|
||
|
|
my $c = $n >> 24;
|
||
|
|
use integer;
|
||
|
|
$dat[--$last] = $c;
|
||
|
|
$i = $count[$c] + ($n & 0xffffff);
|
||
|
|
}
|
||
|
|
# Final check and return decoded data
|
||
|
|
return undef if $i != $markerpos;
|
||
|
|
pop @dat; # (last byte isn't real)
|
||
|
|
return pack 'C*', @dat;
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Inputs: 0) BZZ object ref, 1) ctx
|
||
|
|
# Returns: decoded bit
|
||
|
|
sub decoder($$)
|
||
|
|
{
|
||
|
|
my ($self, $ctx) = @_;
|
||
|
|
my $z = $$self{a} + $self->{p}[$ctx];
|
||
|
|
if ($z <= $$self{fence}) {
|
||
|
|
$$self{a} = $z;
|
||
|
|
return ($ctx & 1);
|
||
|
|
}
|
||
|
|
# must pass $_[1] so subroutine can modify value (darned C++ pass-by-reference!)
|
||
|
|
return $self->decode_sub($z, $_[1]);
|
||
|
|
}
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
# Inputs: 0) BZZ object ref, 1) z, 2) ctx (or undef)
|
||
|
|
# Returns: decoded bit
|
||
|
|
sub decode_sub($$;$)
|
||
|
|
{
|
||
|
|
my ($self, $z, $ctx) = @_;
|
||
|
|
|
||
|
|
# ensure that we have at least 16 bits of encoded data available
|
||
|
|
if ($$self{scount} < 16) {
|
||
|
|
# preload byte by byte until we have at least 24 bits
|
||
|
|
while ($$self{scount} <= 24) {
|
||
|
|
if ($$self{Pos} < $$self{DataLen}) {
|
||
|
|
$$self{byte} = ord(substr(${$$self{DataPt}}, $$self{Pos}, 1));
|
||
|
|
++$$self{Pos};
|
||
|
|
} else {
|
||
|
|
$$self{byte} = 0xff;
|
||
|
|
if (--$$self{delay} < 1) {
|
||
|
|
# setting size to zero forces error return from Decode()
|
||
|
|
$$self{size} = 0;
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$$self{buffer} = ($$self{buffer}<<8) | $$self{byte};
|
||
|
|
$$self{scount} += 8;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
# Save bit
|
||
|
|
my $a = $$self{a};
|
||
|
|
my ($bit, $code);
|
||
|
|
if (defined $ctx) {
|
||
|
|
$bit = ($ctx & 1);
|
||
|
|
# Avoid interval reversion
|
||
|
|
my $d = 0x6000 + (($z+$a)>>2);
|
||
|
|
$z = $d if $z > $d;
|
||
|
|
} else {
|
||
|
|
$bit = 0;
|
||
|
|
}
|
||
|
|
# Test MPS/LPS
|
||
|
|
if ($z > ($code = $$self{code})) {
|
||
|
|
$bit ^= 1;
|
||
|
|
# LPS branch
|
||
|
|
$z = 0x10000 - $z;
|
||
|
|
$a += $z;
|
||
|
|
$code += $z;
|
||
|
|
# LPS adaptation
|
||
|
|
$_[2] = $self->{dn}[$ctx] if defined $ctx;
|
||
|
|
# LPS renormalization
|
||
|
|
my $sft = $a>=0xff00 ? $self->{ffzt}[$a&0xff] + 8 : $self->{ffzt}[($a>>8)&0xff];
|
||
|
|
$$self{scount} -= $sft;
|
||
|
|
$$self{a} = ($a<<$sft) & 0xffff;
|
||
|
|
$code = (($code<<$sft) & 0xffff) | (($$self{buffer}>>$$self{scount}) & ((1<<$sft)-1));
|
||
|
|
} else {
|
||
|
|
# MPS adaptation
|
||
|
|
$_[2] = $self->{up}[$ctx] if defined $ctx and $a >= $self->{'m'}[$ctx];
|
||
|
|
# MPS renormalization
|
||
|
|
$$self{scount} -= 1;
|
||
|
|
$$self{a} = ($z<<1) & 0xffff;
|
||
|
|
$code = (($code<<1) & 0xffff) | (($$self{buffer}>>$$self{scount}) & 1);
|
||
|
|
}
|
||
|
|
# Adjust fence and save new code
|
||
|
|
$$self{fence} = $code >= 0x8000 ? 0x7fff : $code;
|
||
|
|
$$self{code} = $code;
|
||
|
|
return $bit;
|
||
|
|
}
|
||
|
|
|
||
|
|
1; # end
|
||
|
|
|
||
|
|
__END__
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
Image::ExifTool::BZZ - Utility to decode BZZ compressed data
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
This module is used by Image::ExifTool
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
This module contains definitions required by Image::ExifTool to decode BZZ
|
||
|
|
compressed data in DjVu images.
|
||
|
|
|
||
|
|
=head1 NOTES
|
||
|
|
|
||
|
|
This code is based on ZPCodec and BSByteStream of DjVuLibre 3.5.21 (see
|
||
|
|
additional copyrights and the first reference below), which are covered
|
||
|
|
under the GNU GPL license.
|
||
|
|
|
||
|
|
This is implemented as Image::ExifTool::BZZ instead of Compress::BZZ because
|
||
|
|
I am hoping that someone else will write a proper Compress::BZZ module (with
|
||
|
|
compression ability).
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
Copyright 2003-2018, Phil Harvey (phil at owl.phy.queensu.ca)
|
||
|
|
Copyright 2002, Leon Bottou and Yann Le Cun
|
||
|
|
Copyright 2001, AT&T
|
||
|
|
Copyright 1999-2001, LizardTech Inc.
|
||
|
|
|
||
|
|
This library is free software; you can redistribute it and/or modify it
|
||
|
|
under the same terms as Perl itself.
|
||
|
|
|
||
|
|
=head1 REFERENCES
|
||
|
|
|
||
|
|
=over 4
|
||
|
|
|
||
|
|
=item L<http://djvu.sourceforge.net/>
|
||
|
|
|
||
|
|
=item L<http://www.djvu.org/>
|
||
|
|
|
||
|
|
=back
|
||
|
|
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
L<Image::ExifTool::DjVu(3pm)|Image::ExifTool::DjVu>,
|
||
|
|
L<Image::ExifTool(3pm)|Image::ExifTool>
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|