include "bitdata.s7i";
const type: huffmanSymbolArray is array [0 ..] integer;
const type: msbHuffmanCodeLengthArray is array [0 ..] integer;
const type: msbHuffmanDecoder is new struct
var integer: maximumCodeLength is 0;
var huffmanSymbolArray: symbols is huffmanSymbolArray.value;
var msbHuffmanCodeLengthArray: codeLengths is msbHuffmanCodeLengthArray.value;
end struct;
const func msbHuffmanDecoder: createMsbHuffmanDecoder (in integer: maximumCodeLength,
in array integer: numberOfCodesWithLength, in string: huffmanSymbols) is func
result
var msbHuffmanDecoder: decoder is msbHuffmanDecoder.value;
local
var integer: currentCode is 0;
var integer: codeLength is 0;
var integer: symbolIndexStart is 0;
var integer: symbolIndexEnd is 0;
var integer: symbolIndex is 0;
var integer: symbol is 0;
var integer: tableIndex is 0;
begin
decoder.maximumCodeLength := maximumCodeLength;
decoder.symbols := huffmanSymbolArray[.. pred(1 << maximumCodeLength)] times 0;
decoder.codeLengths := msbHuffmanCodeLengthArray[.. pred(1 << maximumCodeLength)] times 0;
for codeLength range 1 to maximumCodeLength do
symbolIndexStart := succ(symbolIndexEnd);
symbolIndexEnd +:= numberOfCodesWithLength[codeLength];
for symbolIndex range symbolIndexStart to symbolIndexEnd do
symbol := ord(huffmanSymbols[symbolIndex]);
while currentCode = tableIndex >> (maximumCodeLength - codeLength) do
decoder.symbols[tableIndex] := symbol;
decoder.codeLengths[tableIndex] := codeLength;
incr(tableIndex);
end while;
incr(currentCode);
end for;
currentCode <<:= 1;
end for;
symbol := ord(huffmanSymbols[length(huffmanSymbols)]);
while tableIndex <= pred(1 << maximumCodeLength) do
decoder.symbols[tableIndex] := symbol;
decoder.codeLengths[tableIndex] := maximumCodeLength;
incr(tableIndex);
end while;
end func;
const func msbHuffmanDecoder: createHuffmanTableMsb (in integer: maximumCodeLength,
in array integer: numberOfCodesWithLength, in string: orderedSymbols) is
return createMsbHuffmanDecoder(maximumCodeLength, numberOfCodesWithLength, orderedSymbols);
const func integer: getHuffmanSymbol (inout msbInBitStream: inBitStream,
in msbHuffmanDecoder: decoder) is func
result
var integer: symbol is 0;
local
var integer: index is 0;
begin
index := peekBits(inBitStream, decoder.maximumCodeLength);
symbol := decoder.symbols[index];
skipBits(inBitStream, decoder.codeLengths[index]);
end func;
const type: symbolsWithCodeLengthType is array array integer;
const func symbolsWithCodeLengthType: computeSymbolsWithCodeLength (in array integer: codeLengths) is func
result
var symbolsWithCodeLengthType: symbolsWithCodeLength is 0 times 0 times 0;
local
var integer: codeLength is 0;
var integer: maximumCodeLength is 0;
var integer: numberOfCodes is 0;
var array integer: numberOfCodesWithLength is 0 times 0;
var array integer: valueIndex is 0 times 0;
var integer: symbol is 0;
begin
for codeLength range codeLengths do
if codeLength > maximumCodeLength then
maximumCodeLength := codeLength;
end if;
end for;
numberOfCodesWithLength := [1 .. maximumCodeLength] times 0;
for codeLength range codeLengths do
if codeLength <> 0 then
incr(numberOfCodesWithLength[codeLength]);
end if;
end for;
symbolsWithCodeLength := [1 .. maximumCodeLength] times 0 times 0;
for numberOfCodes key codeLength range numberOfCodesWithLength do
if numberOfCodes <> 0 then
symbolsWithCodeLength[codeLength] := numberOfCodes times 0;
end if;
end for;
valueIndex := [1 .. maximumCodeLength] times 1;
for codeLength key symbol range codeLengths do
if codeLength <> 0 then
symbolsWithCodeLength[codeLength][valueIndex[codeLength]] := symbol;
incr(valueIndex[codeLength]);
end if;
end for;
end func;
const type: lsbHuffmanDecoder is new struct
var integer: maximumCodeLength is 0;
var huffmanSymbolArray: symbols is huffmanSymbolArray.value;
var array integer: codeLengths is 0 times 0;
end struct;
const func lsbHuffmanDecoder: createLsbHuffmanDecoder (in array integer: codeLengths,
in integer: maximumCodeLength,
in symbolsWithCodeLengthType: symbolsWithCodeLength) is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
local
var integer: codeLength is 0;
var integer: symbol is 0;
var integer: currentCode is 0;
var integer: reversedCode is 0;
var integer: highBits is 0;
begin
decoder.maximumCodeLength := maximumCodeLength;
decoder.symbols := huffmanSymbolArray[.. pred(1 << maximumCodeLength)] times 0;
decoder.codeLengths := codeLengths;
for codeLength range 1 to maximumCodeLength do
for symbol range symbolsWithCodeLength[codeLength] do
reversedCode := reverseBits(codeLength, currentCode);
for highBits range 0 to pred(1 << maximumCodeLength) step 1 << codeLength do
decoder.symbols[highBits + reversedCode] := symbol;
end for;
incr(currentCode);
end for;
currentCode <<:= 1;
end for;
end func;
const func lsbHuffmanDecoder: createLsbHuffmanDecoder (in array integer: codeLengths) is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
local
var symbolsWithCodeLengthType: symbolsWithCodeLength is 0 times 0 times 0;
begin
symbolsWithCodeLength := computeSymbolsWithCodeLength(codeLengths);
decoder := createLsbHuffmanDecoder(codeLengths, maxIdx(symbolsWithCodeLength),
symbolsWithCodeLength);
end func;
const func lsbHuffmanDecoder: createHuffmanTableLsb (in array integer: codeLengths) is
return createLsbHuffmanDecoder(codeLengths);
const func integer: getHuffmanSymbol (inout lsbInBitStream: inBitStream,
in lsbHuffmanDecoder: decoder) is func
result
var integer: symbol is 0;
local
var integer: index is 0;
begin
index := peekBits(inBitStream, decoder.maximumCodeLength);
symbol := decoder.symbols[index];
skipBits(inBitStream, decoder.codeLengths[symbol]);
end func;
const type: huffmanEncoding is new struct
var integer: huffmanCode is 0;
var integer: codeLength is 0;
end struct;
const type: huffmanEncoder is array huffmanEncoding;
const proc: putHuffmanSymbol (inout lsbOutBitStream: outBitStream, in huffmanEncoding: encoding) is func
begin
putBits(outBitStream, encoding.huffmanCode, encoding.codeLength);
end func;
const proc: putHuffmanSymbol (inout msbOutBitStream: outBitStream, in huffmanEncoding: encoding) is func
begin
putBits(outBitStream, encoding.huffmanCode, encoding.codeLength);
end func;
const type: huffmanSymbolNode is new struct
var integer: count is 0;
var integer: symbol is 0;
var integer: fictiveNode is 0;
end struct;
const func integer: compare (in huffmanSymbolNode: node1, in huffmanSymbolNode: node2) is
return -compare(node1.count, node2.count);
const type: huffmanSymbolNodeArray is array huffmanSymbolNode;
const type: huffmanTreeNode is new struct
var integer: leftTreeNode is 0;
var integer: rightTreeNode is 0;
var integer: leftSymbol is 0;
var integer: rightSymbol is 0;
end struct;
const type: huffmanTreeNodeArray is array huffmanTreeNode;
const func huffmanSymbolNodeArray: getHuffmanSymbolNodes (in array integer: symbolCount) is func
result
var huffmanSymbolNodeArray: symbolNodes is huffmanSymbolNodeArray.value;
local
var integer: count is 0;
var integer: symbol is 0;
var integer: index is 1;
begin
symbolNodes := length(symbolCount) times huffmanSymbolNode.value;
for count key symbol range symbolCount do
symbolNodes[index].count := count;
symbolNodes[index].symbol := symbol;
incr(index);
end for;
symbolNodes := sort(symbolNodes);
end func;
const proc: getLengthsFromTree (inout array integer: codeLengths,
in huffmanTreeNode: treeNode, in huffmanTreeNodeArray: treeNodes,
in integer: codeLength) is func
begin
if treeNode.leftTreeNode <> 0 then
getLengthsFromTree(codeLengths, treeNodes[treeNode.leftTreeNode],
treeNodes, succ(codeLength));
else
codeLengths[treeNode.leftSymbol] := succ(codeLength);
end if;
if treeNode.rightTreeNode <> 0 then
getLengthsFromTree(codeLengths, treeNodes[treeNode.rightTreeNode],
treeNodes, succ(codeLength));
else
codeLengths[treeNode.rightSymbol] := succ(codeLength);
end if;
end func;
const proc: getLengthsFromTree (inout array integer: codeLengths,
in huffmanSymbolNode: symbolNode, in huffmanTreeNodeArray: treeNodes,
in integer: codeLength) is func
begin
if symbolNode.fictiveNode <> 0 then
getLengthsFromTree(codeLengths, treeNodes[symbolNode.fictiveNode],
treeNodes, codeLength);
else
codeLengths[symbolNode.symbol] := succ(codeLength);
end if;
end func;
const func array integer: getHuffmanCodeLengths (in array integer: symbolCount) is func
result
var array integer: codeLengths is 0 times 0;
local
var huffmanSymbolNodeArray: symbolNodes is huffmanSymbolNodeArray.value;
var huffmanTreeNodeArray: treeNodes is huffmanTreeNodeArray.value;
var huffmanTreeNode: treeNode is huffmanTreeNode.value;
var integer: index is 0;
begin
symbolNodes := getHuffmanSymbolNodes(symbolCount);
index := length(symbolNodes);
while symbolNodes[index].count = 0 and
index > minIdx(symbolNodes) do
decr(index);
end while;
while index > 1 do
treeNode := huffmanTreeNode.value;
if symbolNodes[pred(index)].fictiveNode <> 0 then
treeNode.leftTreeNode :=
symbolNodes[pred(index)].fictiveNode;
else
treeNode.leftSymbol := symbolNodes[pred(index)].symbol;
end if;
if symbolNodes[index].fictiveNode <> 0 then
treeNode.rightTreeNode :=
symbolNodes[index].fictiveNode;
else
treeNode.rightSymbol := symbolNodes[index].symbol;
end if;
treeNodes &:= treeNode;
symbolNodes[pred(index)].count +:= symbolNodes[index].count;
symbolNodes[pred(index)].fictiveNode := length(treeNodes);
symbolNodes[index].count := 0;
symbolNodes := sort(symbolNodes);
decr(index);
end while;
codeLengths := [minIdx(symbolCount) .. maxIdx(symbolCount)] times 0;
getLengthsFromTree(codeLengths, symbolNodes[1], treeNodes, 0);
end func;
const proc: reduceMaximumHuffmanCodeLength (inout array integer: codeLengths,
in integer: allowedMaximum) is func
local
var symbolsWithCodeLengthType: symbolsWithCodeLength is 0 times 0 times 0;
var integer: maximumCodeLength is 0;
var integer: shorterCodeLength is 0;
var integer: longerCodeLength is 0;
var integer: symbolsMovingUp is 0;
var boolean: moveDone is FALSE;
var integer: index is 0;
var integer: symbol is 0;
begin
symbolsWithCodeLength := computeSymbolsWithCodeLength(codeLengths);
maximumCodeLength := maxIdx(symbolsWithCodeLength);
repeat
shorterCodeLength := maximumCodeLength - 2;
moveDone := FALSE;
repeat
while length(symbolsWithCodeLength[shorterCodeLength]) = 0 do
decr(shorterCodeLength);
end while;
longerCodeLength := shorterCodeLength + 2;
symbolsMovingUp := 2;
while longerCodeLength <= maximumCodeLength and
length(symbolsWithCodeLength[longerCodeLength]) < symbolsMovingUp do
incr(longerCodeLength);
symbolsMovingUp *:= 2;
end while;
if longerCodeLength <= maximumCodeLength then
symbol := symbolsWithCodeLength[shorterCodeLength][1];
symbolsWithCodeLength[succ(shorterCodeLength)] &:= symbol;
codeLengths[symbol] := succ(shorterCodeLength);
symbolsWithCodeLength[shorterCodeLength] :=
symbolsWithCodeLength[shorterCodeLength][2 ..];
for index range 1 to symbolsMovingUp do
symbol := symbolsWithCodeLength[longerCodeLength][index];
symbolsWithCodeLength[pred(longerCodeLength)] &:= symbol;
codeLengths[symbol] := pred(longerCodeLength);
end for;
symbolsWithCodeLength[longerCodeLength] :=
symbolsWithCodeLength[longerCodeLength][succ(symbolsMovingUp) ..];
moveDone := TRUE;
else
decr(shorterCodeLength);
end if;
until moveDone;
if length(symbolsWithCodeLength[maximumCodeLength]) = 0 then
decr(maximumCodeLength);
end if;
until maximumCodeLength <= allowedMaximum;
end func;
const func huffmanEncoder: createHuffmanEncoder (in array integer: codeLengths,
in integer: maximumCodeLength,
in symbolsWithCodeLengthType: symbolsWithCodeLength) is func
result
var huffmanEncoder: encoder is huffmanEncoder.value;
local
var integer: codeLength is 0;
var integer: symbol is 0;
var integer: currentCode is 0;
begin
encoder := [minIdx(codeLengths) .. maxIdx(codeLengths)] times huffmanEncoding.value;
for codeLength range 1 to maximumCodeLength do
for symbol range symbolsWithCodeLength[codeLength] do
encoder[symbol].huffmanCode := reverseBits(codeLength, currentCode);
encoder[symbol].codeLength := codeLength;
incr(currentCode);
end for;
currentCode <<:= 1;
end for;
end func;
const func huffmanEncoder: createHuffmanEncoder (in array integer: codeLengths) is func
result
var huffmanEncoder: encoder is huffmanEncoder.value;
local
var symbolsWithCodeLengthType: symbolsWithCodeLength is 0 times 0 times 0;
begin
symbolsWithCodeLength := computeSymbolsWithCodeLength(codeLengths);
encoder := createHuffmanEncoder(codeLengths, maxIdx(symbolsWithCodeLength),
symbolsWithCodeLength);
end func;