include "bitdata.s7i";
const integer: LZW_MAX_CODE_SIZE is 12;
const integer: LZW_MAX_CODE is pred(2 ** LZW_MAX_CODE_SIZE);
const type: lzwTableType is array [0 .. LZW_MAX_CODE] string;
const func string: lzwCompressLsb (in string: uncompressed, in integer: codeSize) is func
result
var string: compressed is "";
local
var lsbOutBitStream: compressedStream is lsbOutBitStream.value;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var char: ch is ' ';
var hash [string] integer: mydict is (hash [string] integer).value;
var string: buffer is "";
var string: xstr is "";
var integer: bitsToWrite is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToWrite := succ(codeSize);
clearCode := 1 << codeSize;
endOfInformationCode := succ(clearCode);
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
moreBitsNeeded := 1 << bitsToWrite;
for ch range uncompressed do
xstr := buffer & str(ch);
if xstr in mydict then
buffer &:= str(ch)
else
putBits(compressedStream, mydict[buffer], bitsToWrite);
code := length(mydict) + 2;
mydict @:= [xstr] code;
if code = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
mydict := (hash [string] integer).value;
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
moreBitsNeeded := 1 << bitsToWrite;
end if;
buffer := str(ch);
end if;
end for;
if buffer <> "" then
putBits(compressedStream, mydict[buffer], bitsToWrite);
if length(mydict) + 2 = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
end if;
end if;
putBits(compressedStream, endOfInformationCode, bitsToWrite);
flush(compressedStream);
compressed := getBytes(compressedStream);
end func;
const func string: lzwDecompress (inout lsbInBitStream: compressedStream,
in integer: codeSize) is func
result
var string: decompressed is "";
local
var integer: bitsToRead is 0;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var integer: previousCode is 0;
var lzwTableType: table is lzwTableType.value;
var integer: nextTableIndex is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToRead := succ(codeSize);
clearCode := 1 << codeSize;
for code range 0 to pred(clearCode) do
table[code] := str(char(code));
end for;
endOfInformationCode := succ(clearCode);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := 1 << bitsToRead;
previousCode := clearCode;
code := getBits(compressedStream, bitsToRead);
while code <> endOfInformationCode do
if code = clearCode then
bitsToRead := succ(codeSize);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := 1 << bitsToRead;
elsif previousCode = clearCode then
if code < nextTableIndex then
decompressed &:= table[code];
else
raise RANGE_ERROR;
end if;
else
if code < nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[code][1]);
incr(nextTableIndex);
end if;
decompressed &:= table[code];
elsif code = nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[previousCode][1]);
incr(nextTableIndex);
decompressed &:= table[code];
else
decompressed &:= table[previousCode] & str(table[previousCode][1]);
end if;
else
raise RANGE_ERROR;
end if;
if nextTableIndex = moreBitsNeeded then
incr(bitsToRead);
if bitsToRead < LZW_MAX_CODE_SIZE then
moreBitsNeeded := 1 << bitsToRead;
end if;
end if;
end if;
previousCode := code;
code := getBits(compressedStream, bitsToRead);
end while;
end func;
const func string: lzwDecompressLsb (in string: compressed, in integer: codeSize) is func
result
var string: decompressed is "";
local
var lsbInBitStream: compressedStream is lsbInBitStream.value;
begin
compressedStream := openLsbInBitStream(compressed);
decompressed := lzwDecompress(compressedStream, codeSize);
end func;
const func string: lzwCompressMsb (in string: uncompressed, in integer: codeSize) is func
result
var string: compressed is "";
local
var msbOutBitStream: compressedStream is msbOutBitStream.value;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var char: ch is ' ';
var hash [string] integer: mydict is (hash [string] integer).value;
var string: buffer is "";
var string: xstr is "";
var integer: bitsToWrite is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToWrite := succ(codeSize);
clearCode := 1 << codeSize;
endOfInformationCode := succ(clearCode);
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
moreBitsNeeded := 1 << bitsToWrite;
for ch range uncompressed do
xstr := buffer & str(ch);
if xstr in mydict then
buffer &:= str(ch)
else
putBits(compressedStream, mydict[buffer], bitsToWrite);
code := length(mydict) + 2;
mydict @:= [xstr] code;
if code = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
mydict := (hash [string] integer).value;
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
moreBitsNeeded := 1 << bitsToWrite;
end if;
buffer := str(ch);
end if;
end for;
if buffer <> "" then
putBits(compressedStream, mydict[buffer], bitsToWrite);
if length(mydict) + 2 = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
end if;
end if;
putBits(compressedStream, endOfInformationCode, bitsToWrite);
flush(compressedStream);
compressed := getBytes(compressedStream);
end func;
const func string: lzwDecompress (inout msbInBitStream: compressedStream,
in integer: codeSize) is func
result
var string: decompressed is "";
local
var integer: bitsToRead is 0;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var integer: previousCode is 0;
var lzwTableType: table is lzwTableType.value;
var integer: nextTableIndex is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToRead := succ(codeSize);
clearCode := 1 << codeSize;
for code range 0 to pred(clearCode) do
table[code] := str(char(code));
end for;
endOfInformationCode := succ(clearCode);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := 1 << bitsToRead;
previousCode := clearCode;
code := getBits(compressedStream, bitsToRead);
while code <> endOfInformationCode do
if code = clearCode then
bitsToRead := succ(codeSize);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := 1 << bitsToRead;
elsif previousCode = clearCode then
if code < nextTableIndex then
decompressed &:= table[code];
else
raise RANGE_ERROR;
end if;
else
if code < nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[code][1]);
incr(nextTableIndex);
end if;
decompressed &:= table[code];
elsif code = nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[previousCode][1]);
incr(nextTableIndex);
decompressed &:= table[code];
else
decompressed &:= table[previousCode] & str(table[previousCode][1]);
end if;
else
raise RANGE_ERROR;
end if;
if nextTableIndex = moreBitsNeeded then
incr(bitsToRead);
if bitsToRead < LZW_MAX_CODE_SIZE then
moreBitsNeeded := 1 << bitsToRead;
end if;
end if;
end if;
previousCode := code;
code := getBits(compressedStream, bitsToRead);
end while;
end func;
const func string: lzwDecompressMsb (in string: compressed, in integer: codeSize) is func
result
var string: decompressed is "";
local
var msbInBitStream: compressedStream is msbInBitStream.value;
begin
compressedStream := openMsbInBitStream(compressed);
decompressed := lzwDecompress(compressedStream, codeSize);
end func;
const func string: lzwCompressMsbEarlyChange (in string: uncompressed, in integer: codeSize) is func
result
var string: compressed is "";
local
var msbOutBitStream: compressedStream is msbOutBitStream.value;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var char: ch is ' ';
var hash [string] integer: mydict is (hash [string] integer).value;
var string: buffer is "";
var string: xstr is "";
var integer: bitsToWrite is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToWrite := succ(codeSize);
clearCode := 1 << codeSize;
endOfInformationCode := succ(clearCode);
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
moreBitsNeeded := pred(1 << bitsToWrite);
for ch range uncompressed do
xstr := buffer & str(ch);
if xstr in mydict then
buffer &:= str(ch)
else
putBits(compressedStream, mydict[buffer], bitsToWrite);
code := length(mydict) + 2;
mydict @:= [xstr] code;
if code = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
mydict := (hash [string] integer).value;
for code range 0 to pred(clearCode) do
mydict @:= [str(char(code))] code;
end for;
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
moreBitsNeeded := pred(1 << bitsToWrite);
end if;
buffer := str(ch);
end if;
end for;
if buffer <> "" then
putBits(compressedStream, mydict[buffer], bitsToWrite);
if length(mydict) + 2 = moreBitsNeeded then
if bitsToWrite = LZW_MAX_CODE_SIZE then
putBits(compressedStream, clearCode, bitsToWrite);
bitsToWrite := succ(codeSize);
else
incr(bitsToWrite);
end if;
end if;
end if;
putBits(compressedStream, endOfInformationCode, bitsToWrite);
flush(compressedStream);
compressed := getBytes(compressedStream);
end func;
const func string: lzwDecompressEarlyChange (inout msbInBitStream: compressedStream,
in integer: codeSize) is func
result
var string: decompressed is "";
local
var integer: bitsToRead is 0;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var integer: previousCode is 0;
var lzwTableType: table is lzwTableType.value;
var integer: nextTableIndex is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToRead := succ(codeSize);
clearCode := 1 << codeSize;
for code range 0 to pred(clearCode) do
table[code] := str(char(code));
end for;
endOfInformationCode := succ(clearCode);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := pred(1 << bitsToRead);
previousCode := clearCode;
code := getBits(compressedStream, bitsToRead);
while code <> endOfInformationCode do
if code = clearCode then
bitsToRead := succ(codeSize);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := pred(1 << bitsToRead);
elsif previousCode = clearCode then
if code < nextTableIndex then
decompressed &:= table[code];
else
raise RANGE_ERROR;
end if;
else
if code < nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[code][1]);
incr(nextTableIndex);
end if;
decompressed &:= table[code];
elsif code = nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[previousCode][1]);
incr(nextTableIndex);
decompressed &:= table[code];
else
decompressed &:= table[previousCode] & str(table[previousCode][1]);
end if;
else
raise RANGE_ERROR;
end if;
if nextTableIndex = moreBitsNeeded then
incr(bitsToRead);
if bitsToRead < LZW_MAX_CODE_SIZE then
moreBitsNeeded := pred(1 << bitsToRead);
end if;
end if;
end if;
previousCode := code;
code := getBits(compressedStream, bitsToRead);
end while;
end func;
const func string: lzwDecompressMsbEarlyChange (in string: compressed, in integer: codeSize) is func
result
var string: decompressed is "";
local
var msbInBitStream: compressedStream is msbInBitStream.value;
begin
compressedStream := openMsbInBitStream(compressed);
decompressed := lzwDecompressEarlyChange(compressedStream, codeSize);
end func;
const func string: lzwDecompressEarlyChange (inout msbInBitStream: compressedStream,
in integer: codeSize, in integer: requestedLength) is func
result
var string: decompressed is "";
local
var integer: bitsToRead is 0;
var integer: clearCode is 0;
var integer: endOfInformationCode is 0;
var integer: code is 0;
var integer: previousCode is 0;
var lzwTableType: table is lzwTableType.value;
var integer: nextTableIndex is 0;
var integer: moreBitsNeeded is 0;
begin
bitsToRead := succ(codeSize);
clearCode := 1 << codeSize;
for code range 0 to pred(clearCode) do
table[code] := str(char(code));
end for;
endOfInformationCode := succ(clearCode);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := pred(1 << bitsToRead);
previousCode := clearCode;
code := getBits(compressedStream, bitsToRead);
while code <> endOfInformationCode and length(decompressed) < requestedLength do
if code = clearCode then
bitsToRead := succ(codeSize);
nextTableIndex := succ(endOfInformationCode);
moreBitsNeeded := pred(1 << bitsToRead);
elsif previousCode = clearCode then
if code < nextTableIndex then
decompressed &:= table[code];
else
raise RANGE_ERROR;
end if;
else
if code < nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[code][1]);
incr(nextTableIndex);
end if;
decompressed &:= table[code];
elsif code = nextTableIndex then
if nextTableIndex <= LZW_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[previousCode][1]);
incr(nextTableIndex);
decompressed &:= table[code];
else
decompressed &:= table[previousCode] & str(table[previousCode][1]);
end if;
else
raise RANGE_ERROR;
end if;
if nextTableIndex = moreBitsNeeded then
incr(bitsToRead);
if bitsToRead < LZW_MAX_CODE_SIZE then
moreBitsNeeded := pred(1 << bitsToRead);
end if;
end if;
end if;
previousCode := code;
code := getBits(compressedStream, bitsToRead);
end while;
end func;
const func string: lzwDecompressMsbEarlyChange (in string: compressed, in integer: codeSize,
in integer: requestedLength) is func
result
var string: decompressed is "";
local
var msbInBitStream: compressedStream is msbInBitStream.value;
begin
compressedStream := openMsbInBitStream(compressed);
decompressed := lzwDecompressEarlyChange(compressedStream, codeSize, requestedLength);
end func;
const integer: SHRINK_MIN_CODE_SIZE is 9;
const integer: SHRINK_MAX_CODE_SIZE is 13;
const integer: SHRINK_MAX_CODE is pred(2 ** SHRINK_MAX_CODE_SIZE);
const integer: SHRINK_CONTROL_CODE is 256;
const integer: SHRINK_INVALID_CODE is pred(2 ** 16);
const type: shrinkTableType is array [0 .. SHRINK_MAX_CODE] string;
const type: shrinkPrefixType is array [0 .. SHRINK_MAX_CODE] integer;
const func string: unshrinkPartialClear (in shrinkTableType: table,
inout shrinkPrefixType: prefixCode) is func
result
var string: availableCodes is "";
local
var bitset: isPrefix is bitset.value;
var integer: code is 0;
begin
for code range succ(SHRINK_CONTROL_CODE) to SHRINK_MAX_CODE do
if prefixCode[code] <> SHRINK_INVALID_CODE then
incl(isPrefix, prefixCode[code]);
end if;
end for;
for code range succ(SHRINK_CONTROL_CODE) to SHRINK_MAX_CODE do
if code not in isPrefix then
prefixCode[code] := SHRINK_INVALID_CODE;
availableCodes &:= char(code);
end if;
end for;
end func;
const func string: lzwDecompressShrink (inout lsbInBitStream: compressedStream) is func
result
var string: decompressed is "";
local
var integer: bitsToRead is SHRINK_MIN_CODE_SIZE;
var integer: code is 0;
var integer: previousCode is 0;
var integer: specialCommand is 0;
var shrinkTableType: table is shrinkTableType.value;
var shrinkPrefixType: prefixCode is shrinkPrefixType times SHRINK_INVALID_CODE;
var integer: nextTableIndex is 0;
var boolean: dictionaryIsFull is FALSE;
var string: availableCodes is "";
var integer: availableCodeIndex is 1;
var integer: nextAvailableCode is 0;
begin
for code range 0 to pred(SHRINK_CONTROL_CODE) do
table[code] := str(char(code));
end for;
nextTableIndex := succ(SHRINK_CONTROL_CODE);
code := getBits(compressedStream, bitsToRead);
if code < nextTableIndex then
decompressed &:= table[code];
else
raise RANGE_ERROR;
end if;
previousCode := code;
code := getBits(compressedStream, bitsToRead);
while not eof(compressedStream) do
if code = SHRINK_CONTROL_CODE then
specialCommand := getBits(compressedStream, bitsToRead);
if specialCommand = 1 then
incr(bitsToRead);
elsif specialCommand = 2 then
availableCodes := unshrinkPartialClear(table, prefixCode);
availableCodeIndex := 1;
dictionaryIsFull := TRUE;
else
raise RANGE_ERROR;
end if;
else
if not dictionaryIsFull then
if code < nextTableIndex then
if nextTableIndex <= SHRINK_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[code][1]);
prefixCode[nextTableIndex] := previousCode;
incr(nextTableIndex);
end if;
decompressed &:= table[code];
elsif code = nextTableIndex then
if nextTableIndex <= SHRINK_MAX_CODE then
table[nextTableIndex] := table[previousCode] & str(table[previousCode][1]);
prefixCode[nextTableIndex] := previousCode;
incr(nextTableIndex);
decompressed &:= table[code];
else
decompressed &:= table[previousCode] & str(table[previousCode][1]);
end if;
else
raise RANGE_ERROR;
end if;
else
if availableCodeIndex <= length(availableCodes) then
nextAvailableCode := ord(availableCodes[availableCodeIndex]);
incr(availableCodeIndex);
if code <> nextAvailableCode then
table[nextAvailableCode] := table[previousCode] & str(table[code][1]);
else
table[nextAvailableCode] := table[previousCode] & str(table[previousCode][1]);
end if;
prefixCode[nextAvailableCode] := previousCode;
end if;
decompressed &:= table[code];
end if;
previousCode := code;
end if;
code := getBits(compressedStream, bitsToRead);
end while;
end func;