include "bytedata.s7i";
include "bitdata.s7i";
include "huffman.s7i";
include "graph.s7i";
include "pixelimage.s7i";
const func msbHuffmanDecoder: createMsbHuffmanDecoder (in integer: maximumCodeLength) is func
result
var msbHuffmanDecoder: decoder is msbHuffmanDecoder.value;
begin
decoder.maximumCodeLength := maximumCodeLength;
decoder.symbols := huffmanSymbolArray[.. pred(1 << maximumCodeLength)] times -2;
decoder.codeLengths := msbHuffmanCodeLengthArray[.. pred(1 << maximumCodeLength)] times 0;
end func;
const proc: addCode (inout msbHuffmanDecoder: decoder, in integer: symbol, in string: bits) is func
local
var integer: codeLength is 0;
var integer: currentCode is 0;
var integer: tableIndex is 0;
begin
codeLength := length(bits);
currentCode := integer(bits, 2);
tableIndex := currentCode << (decoder.maximumCodeLength - codeLength);
while currentCode = tableIndex >> (decoder.maximumCodeLength - codeLength) do
decoder.symbols[tableIndex] := symbol;
decoder.codeLengths[tableIndex] := codeLength;
incr(tableIndex);
end while;
end func;
const func lsbHuffmanDecoder: createLsbHuffmanDecoder (in integer: maximumCodeLength,
in integer: minSymbol, in integer: maxSymbol) is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
begin
decoder.maximumCodeLength := maximumCodeLength;
decoder.symbols := huffmanSymbolArray[.. pred(1 << maximumCodeLength)] times -2;
decoder.codeLengths := [minSymbol .. maxSymbol] times 0;
end func;
const proc: addCode (inout lsbHuffmanDecoder: decoder, in integer: symbol, in string: bits) is func
local
var integer: codeLength is 0;
var integer: currentCode is 0;
var integer: reversedCode is 0;
var integer: highBits is 0;
begin
codeLength := length(bits);
currentCode := integer(bits, 2);
reversedCode := reverseBits(codeLength, currentCode);
for highBits range 0 to pred(1 << decoder.maximumCodeLength) step 1 << codeLength do
decoder.symbols[highBits + reversedCode] := symbol;
end for;
decoder.codeLengths[symbol] := codeLength;
end func;
const type: huffmanSymbolBits is new struct
var integer: symbol is 0;
var string: bits is "";
end struct;
const func huffmanSymbolBits: huffmanSymbolBits (in integer: symbol, in string: bits) is func
result
var huffmanSymbolBits: symbolBits is huffmanSymbolBits.value;
begin
symbolBits.symbol := symbol;
symbolBits.bits := bits;
end func;
const array huffmanSymbolBits: whiteHuffmanSymbolBits is [] (
huffmanSymbolBits( -1, "000000000001"),
huffmanSymbolBits( 0, "00110101"),
huffmanSymbolBits( 1, "000111"),
huffmanSymbolBits( 2, "0111"),
huffmanSymbolBits( 3, "1000"),
huffmanSymbolBits( 4, "1011"),
huffmanSymbolBits( 5, "1100"),
huffmanSymbolBits( 6, "1110"),
huffmanSymbolBits( 7, "1111"),
huffmanSymbolBits( 8, "10011"),
huffmanSymbolBits( 9, "10100"),
huffmanSymbolBits( 10, "00111"),
huffmanSymbolBits( 11, "01000"),
huffmanSymbolBits( 12, "001000"),
huffmanSymbolBits( 13, "000011"),
huffmanSymbolBits( 14, "110100"),
huffmanSymbolBits( 15, "110101"),
huffmanSymbolBits( 16, "101010"),
huffmanSymbolBits( 17, "101011"),
huffmanSymbolBits( 18, "0100111"),
huffmanSymbolBits( 19, "0001100"),
huffmanSymbolBits( 20, "0001000"),
huffmanSymbolBits( 21, "0010111"),
huffmanSymbolBits( 22, "0000011"),
huffmanSymbolBits( 23, "0000100"),
huffmanSymbolBits( 24, "0101000"),
huffmanSymbolBits( 25, "0101011"),
huffmanSymbolBits( 26, "0010011"),
huffmanSymbolBits( 27, "0100100"),
huffmanSymbolBits( 28, "0011000"),
huffmanSymbolBits( 29, "00000010"),
huffmanSymbolBits( 30, "00000011"),
huffmanSymbolBits( 31, "00011010"),
huffmanSymbolBits( 32, "00011011"),
huffmanSymbolBits( 33, "00010010"),
huffmanSymbolBits( 34, "00010011"),
huffmanSymbolBits( 35, "00010100"),
huffmanSymbolBits( 36, "00010101"),
huffmanSymbolBits( 37, "00010110"),
huffmanSymbolBits( 38, "00010111"),
huffmanSymbolBits( 39, "00101000"),
huffmanSymbolBits( 40, "00101001"),
huffmanSymbolBits( 41, "00101010"),
huffmanSymbolBits( 42, "00101011"),
huffmanSymbolBits( 43, "00101100"),
huffmanSymbolBits( 44, "00101101"),
huffmanSymbolBits( 45, "00000100"),
huffmanSymbolBits( 46, "00000101"),
huffmanSymbolBits( 47, "00001010"),
huffmanSymbolBits( 48, "00001011"),
huffmanSymbolBits( 49, "01010010"),
huffmanSymbolBits( 50, "01010011"),
huffmanSymbolBits( 51, "01010100"),
huffmanSymbolBits( 52, "01010101"),
huffmanSymbolBits( 53, "00100100"),
huffmanSymbolBits( 54, "00100101"),
huffmanSymbolBits( 55, "01011000"),
huffmanSymbolBits( 56, "01011001"),
huffmanSymbolBits( 57, "01011010"),
huffmanSymbolBits( 58, "01011011"),
huffmanSymbolBits( 59, "01001010"),
huffmanSymbolBits( 60, "01001011"),
huffmanSymbolBits( 61, "00110010"),
huffmanSymbolBits( 62, "00110011"),
huffmanSymbolBits( 63, "00110100"),
huffmanSymbolBits( 64, "11011"),
huffmanSymbolBits( 128, "10010"),
huffmanSymbolBits( 192, "010111"),
huffmanSymbolBits( 256, "0110111"),
huffmanSymbolBits( 320, "00110110"),
huffmanSymbolBits( 384, "00110111"),
huffmanSymbolBits( 448, "01100100"),
huffmanSymbolBits( 512, "01100101"),
huffmanSymbolBits( 576, "01101000"),
huffmanSymbolBits( 640, "01100111"),
huffmanSymbolBits( 704, "011001100"),
huffmanSymbolBits( 768, "011001101"),
huffmanSymbolBits( 832, "011010010"),
huffmanSymbolBits( 896, "011010011"),
huffmanSymbolBits( 960, "011010100"),
huffmanSymbolBits(1024, "011010101"),
huffmanSymbolBits(1088, "011010110"),
huffmanSymbolBits(1152, "011010111"),
huffmanSymbolBits(1216, "011011000"),
huffmanSymbolBits(1280, "011011001"),
huffmanSymbolBits(1344, "011011010"),
huffmanSymbolBits(1408, "011011011"),
huffmanSymbolBits(1472, "010011000"),
huffmanSymbolBits(1536, "010011001"),
huffmanSymbolBits(1600, "010011010"),
huffmanSymbolBits(1664, "011000"),
huffmanSymbolBits(1728, "010011011"),
huffmanSymbolBits(1792, "00000001000"),
huffmanSymbolBits(1856, "00000001100"),
huffmanSymbolBits(1920, "00000001101"),
huffmanSymbolBits(1984, "000000010010"),
huffmanSymbolBits(2048, "000000010011"),
huffmanSymbolBits(2112, "000000010100"),
huffmanSymbolBits(2176, "000000010101"),
huffmanSymbolBits(2240, "000000010110"),
huffmanSymbolBits(2304, "000000010111"),
huffmanSymbolBits(2368, "000000011100"),
huffmanSymbolBits(2432, "000000011101"),
huffmanSymbolBits(2496, "000000011110"),
huffmanSymbolBits(2560, "000000011111"));
const array huffmanSymbolBits: blackHuffmanSymbolBits is [] (
huffmanSymbolBits( -1, "00000000000"),
huffmanSymbolBits( 0, "0000110111"),
huffmanSymbolBits( 1, "010"),
huffmanSymbolBits( 2, "11"),
huffmanSymbolBits( 3, "10"),
huffmanSymbolBits( 4, "011"),
huffmanSymbolBits( 5, "0011"),
huffmanSymbolBits( 6, "0010"),
huffmanSymbolBits( 7, "00011"),
huffmanSymbolBits( 8, "000101"),
huffmanSymbolBits( 9, "000100"),
huffmanSymbolBits( 10, "0000100"),
huffmanSymbolBits( 11, "0000101"),
huffmanSymbolBits( 12, "0000111"),
huffmanSymbolBits( 13, "00000100"),
huffmanSymbolBits( 14, "00000111"),
huffmanSymbolBits( 15, "000011000"),
huffmanSymbolBits( 16, "0000010111"),
huffmanSymbolBits( 17, "0000011000"),
huffmanSymbolBits( 18, "0000001000"),
huffmanSymbolBits( 19, "00001100111"),
huffmanSymbolBits( 20, "00001101000"),
huffmanSymbolBits( 21, "00001101100"),
huffmanSymbolBits( 22, "00000110111"),
huffmanSymbolBits( 23, "00000101000"),
huffmanSymbolBits( 24, "00000010111"),
huffmanSymbolBits( 25, "00000011000"),
huffmanSymbolBits( 26, "000011001010"),
huffmanSymbolBits( 27, "000011001011"),
huffmanSymbolBits( 28, "000011001100"),
huffmanSymbolBits( 29, "000011001101"),
huffmanSymbolBits( 30, "000001101000"),
huffmanSymbolBits( 31, "000001101001"),
huffmanSymbolBits( 32, "000001101010"),
huffmanSymbolBits( 33, "000001101011"),
huffmanSymbolBits( 34, "000011010010"),
huffmanSymbolBits( 35, "000011010011"),
huffmanSymbolBits( 36, "000011010100"),
huffmanSymbolBits( 37, "000011010101"),
huffmanSymbolBits( 38, "000011010110"),
huffmanSymbolBits( 39, "000011010111"),
huffmanSymbolBits( 40, "000001101100"),
huffmanSymbolBits( 41, "000001101101"),
huffmanSymbolBits( 42, "000011011010"),
huffmanSymbolBits( 43, "000011011011"),
huffmanSymbolBits( 44, "000001010100"),
huffmanSymbolBits( 45, "000001010101"),
huffmanSymbolBits( 46, "000001010110"),
huffmanSymbolBits( 47, "000001010111"),
huffmanSymbolBits( 48, "000001100100"),
huffmanSymbolBits( 49, "000001100101"),
huffmanSymbolBits( 50, "000001010010"),
huffmanSymbolBits( 51, "000001010011"),
huffmanSymbolBits( 52, "000000100100"),
huffmanSymbolBits( 53, "000000110111"),
huffmanSymbolBits( 54, "000000111000"),
huffmanSymbolBits( 55, "000000100111"),
huffmanSymbolBits( 56, "000000101000"),
huffmanSymbolBits( 57, "000001011000"),
huffmanSymbolBits( 58, "000001011001"),
huffmanSymbolBits( 59, "000000101011"),
huffmanSymbolBits( 60, "000000101100"),
huffmanSymbolBits( 61, "000001011010"),
huffmanSymbolBits( 62, "000001100110"),
huffmanSymbolBits( 63, "000001100111"),
huffmanSymbolBits( 64, "0000001111"),
huffmanSymbolBits( 128, "000011001000"),
huffmanSymbolBits( 192, "000011001001"),
huffmanSymbolBits( 256, "000001011011"),
huffmanSymbolBits( 320, "000000110011"),
huffmanSymbolBits( 384, "000000110100"),
huffmanSymbolBits( 448, "000000110101"),
huffmanSymbolBits( 512, "0000001101100"),
huffmanSymbolBits( 576, "0000001101101"),
huffmanSymbolBits( 640, "0000001001010"),
huffmanSymbolBits( 704, "0000001001011"),
huffmanSymbolBits( 768, "0000001001100"),
huffmanSymbolBits( 832, "0000001001101"),
huffmanSymbolBits( 896, "0000001110010"),
huffmanSymbolBits( 960, "0000001110011"),
huffmanSymbolBits(1024, "0000001110100"),
huffmanSymbolBits(1088, "0000001110101"),
huffmanSymbolBits(1152, "0000001110110"),
huffmanSymbolBits(1216, "0000001110111"),
huffmanSymbolBits(1280, "0000001010010"),
huffmanSymbolBits(1344, "0000001010011"),
huffmanSymbolBits(1408, "0000001010100"),
huffmanSymbolBits(1472, "0000001010101"),
huffmanSymbolBits(1536, "0000001011010"),
huffmanSymbolBits(1600, "0000001011011"),
huffmanSymbolBits(1664, "0000001100100"),
huffmanSymbolBits(1728, "0000001100101"),
huffmanSymbolBits(1792, "00000001000"),
huffmanSymbolBits(1856, "00000001100"),
huffmanSymbolBits(1920, "00000001101"),
huffmanSymbolBits(1984, "000000010010"),
huffmanSymbolBits(2048, "000000010011"),
huffmanSymbolBits(2112, "000000010100"),
huffmanSymbolBits(2176, "000000010101"),
huffmanSymbolBits(2240, "000000010110"),
huffmanSymbolBits(2304, "000000010111"),
huffmanSymbolBits(2368, "000000011100"),
huffmanSymbolBits(2432, "000000011101"),
huffmanSymbolBits(2496, "000000011110"),
huffmanSymbolBits(2560, "000000011111"));
const proc: addHuffmanSymbols (inout msbHuffmanDecoder: decoder,
in array huffmanSymbolBits: symbolBitsArray) is func
local
var huffmanSymbolBits: symbolBits is huffmanSymbolBits.value;
begin
for symbolBits range symbolBitsArray do
addCode(decoder, symbolBits.symbol, symbolBits.bits);
end for;
end func;
const proc: addHuffmanSymbols (inout lsbHuffmanDecoder: decoder,
in array huffmanSymbolBits: symbolBitsArray) is func
local
var huffmanSymbolBits: symbolBits is huffmanSymbolBits.value;
begin
for symbolBits range symbolBitsArray do
addCode(decoder, symbolBits.symbol, symbolBits.bits);
end for;
end func;
const func msbHuffmanDecoder: genWhiteMsbHuffmanDecoder is func
result
var msbHuffmanDecoder: decoder is msbHuffmanDecoder.value;
begin
decoder := createMsbHuffmanDecoder(12);
addHuffmanSymbols(decoder, whiteHuffmanSymbolBits);
end func;
const func msbHuffmanDecoder: genBlackMsbHuffmanDecoder is func
result
var msbHuffmanDecoder: decoder is msbHuffmanDecoder.value;
begin
decoder := createMsbHuffmanDecoder(13);
addHuffmanSymbols(decoder, blackHuffmanSymbolBits);
end func;
const func lsbHuffmanDecoder: genWhiteLsbHuffmanDecoder is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
begin
decoder := createLsbHuffmanDecoder(12, -1, 2560);
addHuffmanSymbols(decoder, whiteHuffmanSymbolBits);
end func;
const func lsbHuffmanDecoder: genBlackLsbHuffmanDecoder is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
begin
decoder := createLsbHuffmanDecoder(13, -1, 2560);
addHuffmanSymbols(decoder, blackHuffmanSymbolBits);
end func;
const msbHuffmanDecoder: whiteMsbHuffmanDecoder is genWhiteMsbHuffmanDecoder;
const msbHuffmanDecoder: blackMsbHuffmanDecoder is genBlackMsbHuffmanDecoder;
const lsbHuffmanDecoder: whiteLsbHuffmanDecoder is genWhiteLsbHuffmanDecoder;
const lsbHuffmanDecoder: blackLsbHuffmanDecoder is genBlackLsbHuffmanDecoder;
const integer: CCITT_T4_PASS is 0;
const integer: CCITT_T4_HORIZONTAL is 1;
const integer: CCITT_T4_VERTICAL_0 is 2;
const integer: CCITT_T4_VERTICAL_RIGHT_1 is 3;
const integer: CCITT_T4_VERTICAL_RIGHT_2 is 4;
const integer: CCITT_T4_VERTICAL_RIGHT_3 is 5;
const integer: CCITT_T4_VERTICAL_LEFT_1 is 6;
const integer: CCITT_T4_VERTICAL_LEFT_2 is 7;
const integer: CCITT_T4_VERTICAL_LEFT_3 is 8;
const integer: CCITT_T4_UNCOMPRESSED is 9;
const array huffmanSymbolBits: t4HuffmanSymbolBits is [] (
huffmanSymbolBits(-1, "000000000001"),
huffmanSymbolBits(CCITT_T4_PASS, "0001"),
huffmanSymbolBits(CCITT_T4_HORIZONTAL, "001"),
huffmanSymbolBits(CCITT_T4_VERTICAL_0, "1"),
huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_1, "011"),
huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_2, "000011"),
huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_3, "0000011"),
huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_1, "010"),
huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_2, "000010"),
huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_3, "0000010"),
huffmanSymbolBits(CCITT_T4_UNCOMPRESSED, "0000001111"));
const func msbHuffmanDecoder: genT4MsbHuffmanDecoder is func
result
var msbHuffmanDecoder: decoder is msbHuffmanDecoder.value;
begin
decoder := createMsbHuffmanDecoder(12);
addHuffmanSymbols(decoder, t4HuffmanSymbolBits)
end func;
const func lsbHuffmanDecoder: genT4LsbHuffmanDecoder is func
result
var lsbHuffmanDecoder: decoder is lsbHuffmanDecoder.value;
begin
decoder := createLsbHuffmanDecoder(12, -2, 10);
addHuffmanSymbols(decoder, t4HuffmanSymbolBits)
end func;
const msbHuffmanDecoder: t4MsbHuffmanDecoder is genT4MsbHuffmanDecoder;
const lsbHuffmanDecoder: t4LsbHuffmanDecoder is genT4LsbHuffmanDecoder;
const proc: DECLARE_CcittModifiedGroup3Fax_FUNCTIONS (in type: bitStream,
in type: huffmanDecoder) is func
begin
const func integer: getWhiteBits (inout bitStream: ccittFaxStream,
in huffmanDecoder: whiteDecoder) is func
result
var integer: whiteBits is 0;
local
var integer: additionalWhiteBits is 0;
begin
whiteBits := getHuffmanSymbol(ccittFaxStream, whiteDecoder);
if whiteBits >= 64 then
repeat
additionalWhiteBits := getHuffmanSymbol(ccittFaxStream, whiteDecoder);
whiteBits +:= additionalWhiteBits;
until additionalWhiteBits < 64;
end if;
end func;
const func integer: getBlackBits (inout bitStream: ccittFaxStream,
in huffmanDecoder: blackDecoder) is func
result
var integer: blackBits is 0;
local
var integer: additionalBlackBits is 0;
begin
blackBits := getHuffmanSymbol(ccittFaxStream, blackDecoder);
if blackBits >= 64 then
repeat
additionalBlackBits := getHuffmanSymbol(ccittFaxStream, blackDecoder);
blackBits +:= additionalBlackBits;
until additionalBlackBits < 64;
end if;
end func;
const proc: skipEol (inout bitStream: inBitStream, in integer: expected) is func
local
var integer: symbol is 0;
begin
symbol := getBits(inBitStream, 12);
if symbol = 0 then
repeat
symbol := getBit(inBitStream);
until symbol = 1;
elsif symbol <> expected then
raise RANGE_ERROR;
end if;
end func;
const proc: processCcittFaxRow (inout bitStream: faxDataStream,
in huffmanDecoder: whiteDecoder, in huffmanDecoder: blackDecoder,
in pixel: whitePixel, in pixel: blackPixel, in integer: width,
inout pixelArray: imageLine) is func
local
var integer: numWhitePixels is 0;
var integer: numBlackPixels is 0;
var integer: currentColumn is 1;
begin
repeat
numWhitePixels := getWhiteBits(faxDataStream, whiteDecoder);
if numWhitePixels >= 0 then
setPixels(imageLine, currentColumn,
currentColumn + pred(numWhitePixels), whitePixel);
currentColumn +:= numWhitePixels;
if currentColumn <= width then
numBlackPixels := getBlackBits(faxDataStream, blackDecoder);
if numBlackPixels >= 0 then
setPixels(imageLine, currentColumn,
currentColumn + pred(numBlackPixels), blackPixel);
currentColumn +:= numBlackPixels;
else
setPixels(imageLine, currentColumn, width, blackPixel);
currentColumn := succ(width);
end if;
end if;
else
setPixels(imageLine, currentColumn, width, whitePixel);
currentColumn := succ(width);
end if;
until currentColumn > width;
end func;
end func;
DECLARE_CcittModifiedGroup3Fax_FUNCTIONS(msbInBitStream, msbHuffmanDecoder);
DECLARE_CcittModifiedGroup3Fax_FUNCTIONS(lsbInBitStream, lsbHuffmanDecoder);
const proc: processCcittModifiedGroup3FaxMsb (in string: faxData,
in pixel: whitePixel, in pixel: blackPixel, in integer: startLine,
in integer: height, in integer: width, inout pixelImage: image) is func
local
var msbInBitStream: faxDataStream is msbInBitStream.value;
var integer: line is 0;
begin
faxDataStream := openMsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
processCcittFaxRow(faxDataStream, whiteMsbHuffmanDecoder,
blackMsbHuffmanDecoder, whitePixel, blackPixel,
width, image[line]);
ignore(gets(faxDataStream, 0));
end for;
end func;
const proc: processCcittModifiedGroup3FaxLsb (in string: faxData,
in pixel: whitePixel, in pixel: blackPixel, in integer: startLine,
in integer: height, in integer: width, inout pixelImage: image) is func
local
var lsbInBitStream: faxDataStream is lsbInBitStream.value;
var integer: line is 0;
begin
faxDataStream := openLsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
processCcittFaxRow(faxDataStream, whiteLsbHuffmanDecoder,
blackLsbHuffmanDecoder, whitePixel, blackPixel,
width, image[line]);
ignore(gets(faxDataStream, 0));
end for;
end func;
const type: ccittFaxValues is array [1 .. ] integer;
const proc: DECLARE_CcittT6Fax_FUNCTIONS (in type: bitStream,
in type: huffmanDecoder) is func
begin
const proc: processCcittT4Fax2dRow (inout bitStream: faxDataStream,
in huffmanDecoder: t4HuffmanDecoder, in huffmanDecoder: whiteDecoder,
in huffmanDecoder: blackDecoder, in colorLookupTable: blackOrWhite,
in integer: width, inout ccittFaxValues: bValues,
inout pixelArray: imageLine) is func
local
var pixel: currentPixel is pixel.value;
var integer: mode is 0;
var integer: numBits1 is 0;
var integer: numBits2 is 0;
var integer: currentColumn is 1;
var ccittFaxValues: aValues is ccittFaxValues.value;
var integer: bIndex is 1;
var integer: currentBValue is 0;
begin
mode := getHuffmanSymbol(faxDataStream, t4HuffmanDecoder);
while mode >= 0 and currentColumn <= width do
if bIndex <= length(bValues) then
currentBValue := bValues[bIndex];
else
currentBValue := succ(width);
end if;
case mode of
when {CCITT_T4_PASS}:
currentPixel := blackOrWhite[bIndex mod 2];
incr(bIndex);
if bIndex <= length(bValues) then
currentBValue := bValues[bIndex];
else
currentBValue := succ(width);
end if;
setPixels(imageLine, currentColumn, currentBValue - 1, currentPixel);
currentColumn := currentBValue;
incr(bIndex);
when {CCITT_T4_HORIZONTAL}:
if odd(bIndex) then
numBits1 := getWhiteBits(faxDataStream, whiteDecoder);
numBits2 := getBlackBits(faxDataStream, blackDecoder);
else
numBits1 := getBlackBits(faxDataStream, blackDecoder);
numBits2 := getWhiteBits(faxDataStream, whiteDecoder);
end if;
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentColumn + pred(numBits1),
currentPixel);
currentColumn +:= numBits1;
aValues &:= currentColumn;
currentPixel := blackOrWhite[succ(bIndex) mod 2];
setPixels(imageLine, currentColumn, currentColumn + pred(numBits2),
currentPixel);
currentColumn +:= numBits2;
aValues &:= currentColumn;
while bIndex <= length(bValues) and bValues[bIndex] <= currentColumn do
bIndex +:= 2;
end while;
when {CCITT_T4_VERTICAL_0}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue - 1, currentPixel);
currentColumn := currentBValue;
aValues &:= currentColumn;
incr(bIndex);
when {CCITT_T4_VERTICAL_RIGHT_1}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue, currentPixel);
currentColumn := currentBValue + 1;
aValues &:= currentColumn;
incr(bIndex);
if bIndex <= length(bValues) and bValues[bIndex] <= currentColumn then
bIndex +:= 2;
end if;
when {CCITT_T4_VERTICAL_RIGHT_2}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue + 1, currentPixel);
currentColumn := currentBValue + 2;
aValues &:= currentColumn;
incr(bIndex);
if bIndex <= length(bValues) and bValues[bIndex] <= currentColumn then
bIndex +:= 2;
end if;
when {CCITT_T4_VERTICAL_RIGHT_3}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue + 2, currentPixel);
currentColumn := currentBValue + 3;
aValues &:= currentColumn;
incr(bIndex);
while bIndex <= length(bValues) and bValues[bIndex] <= currentColumn do
bIndex +:= 2;
end while;
when {CCITT_T4_VERTICAL_LEFT_1}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue - 2, currentPixel);
currentColumn := currentBValue - 1;
aValues &:= currentColumn;
incr(bIndex);
when {CCITT_T4_VERTICAL_LEFT_2}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue - 3, currentPixel);
currentColumn := currentBValue - 2;
aValues &:= currentColumn;
if bIndex > 1 and (pred(bIndex) > length(bValues) or
bValues[pred(bIndex)] > currentColumn) then
decr(bIndex);
else
incr(bIndex);
end if;
when {CCITT_T4_VERTICAL_LEFT_3}:
currentPixel := blackOrWhite[bIndex mod 2];
setPixels(imageLine, currentColumn, currentBValue - 4, currentPixel);
currentColumn := currentBValue - 3;
aValues &:= currentColumn;
if bIndex > 1 and (pred(bIndex) > length(bValues) or
bValues[pred(bIndex)] > currentColumn) then
decr(bIndex);
else
incr(bIndex);
end if;
otherwise:
raise RANGE_ERROR;
end case;
if currentColumn <= width then
mode := getHuffmanSymbol(faxDataStream, t4HuffmanDecoder);
end if;
end while;
bValues := aValues;
end func;
end func;
DECLARE_CcittT6Fax_FUNCTIONS(msbInBitStream, msbHuffmanDecoder);
DECLARE_CcittT6Fax_FUNCTIONS(lsbInBitStream, lsbHuffmanDecoder);
const proc: processCcittT6FaxMsb (in string: faxData,
in colorLookupTable: blackOrWhite, in integer: startLine, in integer: height,
in integer: width, inout pixelImage: image) is func
local
var msbInBitStream: faxDataStream is msbInBitStream.value;
var ccittFaxValues: bValues is ccittFaxValues.value;
var integer: line is 0;
begin
faxDataStream := openMsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
processCcittT4Fax2dRow(faxDataStream, t4MsbHuffmanDecoder,
whiteMsbHuffmanDecoder, blackMsbHuffmanDecoder,
blackOrWhite, width, bValues, image[line]);
end for;
end func;
const proc: processCcittT6FaxLsb (in string: faxData,
in colorLookupTable: blackOrWhite, in integer: startLine, in integer: height,
in integer: width, inout pixelImage: image) is func
local
var lsbInBitStream: faxDataStream is lsbInBitStream.value;
var ccittFaxValues: bValues is ccittFaxValues.value;
var integer: line is 0;
begin
faxDataStream := openLsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
processCcittT4Fax2dRow(faxDataStream, t4LsbHuffmanDecoder,
whiteLsbHuffmanDecoder, blackLsbHuffmanDecoder,
blackOrWhite, width, bValues, image[line]);
end for;
end func;
const proc: processCcittT4Fax1dMsb (in string: faxData,
in pixel: whitePixel, in pixel: blackPixel, in integer: startLine,
in integer: height, in integer: width, inout pixelImage: image) is func
local
var msbInBitStream: faxDataStream is msbInBitStream.value;
var integer: line is 0;
begin
faxDataStream := openMsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
skipEol(faxDataStream, 2#000000000001);
processCcittFaxRow(faxDataStream, whiteMsbHuffmanDecoder,
blackMsbHuffmanDecoder, whitePixel, blackPixel,
width, image[line]);
end for;
end func;
const proc: processCcittT4Fax1dLsb (in string: faxData,
in pixel: whitePixel, in pixel: blackPixel, in integer: startLine,
in integer: height, in integer: width, inout pixelImage: image) is func
local
var lsbInBitStream: faxDataStream is lsbInBitStream.value;
var integer: line is 0;
begin
faxDataStream := openLsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
skipEol(faxDataStream, 2#100000000000);
processCcittFaxRow(faxDataStream, whiteLsbHuffmanDecoder,
blackLsbHuffmanDecoder, whitePixel, blackPixel,
width, image[line]);
end for;
end func;
const proc: DECLARE_CcittT4Fax2d_FUNCTIONS (in type: bitStream,
in type: huffmanDecoder) is func
begin
const proc: processCcittT4Fax1dRow (inout bitStream: faxDataStream,
in huffmanDecoder: whiteDecoder, in huffmanDecoder: blackDecoder,
in pixel: whitePixel, in pixel: blackPixel, in integer: width,
inout ccittFaxValues: aValues, inout pixelArray: imageLine) is func
local
var integer: numWhitePixels is 0;
var integer: numBlackPixels is 0;
var integer: currentColumn is 1;
begin
aValues := ccittFaxValues.value;
repeat
numWhitePixels := getWhiteBits(faxDataStream, whiteDecoder);
if numWhitePixels >= 0 then
setPixels(imageLine, currentColumn,
currentColumn + pred(numWhitePixels), whitePixel);
currentColumn +:= numWhitePixels;
aValues &:= currentColumn;
if currentColumn <= width then
numBlackPixels := getBlackBits(faxDataStream, blackDecoder);
if numBlackPixels >= 0 then
setPixels(imageLine, currentColumn,
currentColumn + pred(numBlackPixels), blackPixel);
currentColumn +:= numBlackPixels;
aValues &:= currentColumn;
else
setPixels(imageLine, currentColumn, width, blackPixel);
currentColumn := succ(width);
end if;
end if;
else
setPixels(imageLine, currentColumn, width, whitePixel);
currentColumn := succ(width);
end if;
until currentColumn > width;
end func;
end func;
DECLARE_CcittT4Fax2d_FUNCTIONS(msbInBitStream, msbHuffmanDecoder);
DECLARE_CcittT4Fax2d_FUNCTIONS(lsbInBitStream, lsbHuffmanDecoder);
const proc: processCcittT4Fax2dMsb (in string: faxData,
in colorLookupTable: blackOrWhite, in integer: startLine, in integer: height,
in integer: width, inout pixelImage: image) is func
local
var msbInBitStream: faxDataStream is msbInBitStream.value;
var ccittFaxValues: bValues is ccittFaxValues.value;
var integer: line is 0;
begin
faxDataStream := openMsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
skipEol(faxDataStream, 2#000000000001);
if getBit(faxDataStream) = 1 then
processCcittT4Fax1dRow(faxDataStream, whiteMsbHuffmanDecoder,
blackMsbHuffmanDecoder, blackOrWhite[1], blackOrWhite[0],
width, bValues, image[line]);
else
processCcittT4Fax2dRow(faxDataStream, t4MsbHuffmanDecoder,
whiteMsbHuffmanDecoder, blackMsbHuffmanDecoder,
blackOrWhite, width, bValues, image[line]);
end if;
end for;
end func;
const proc: processCcittT4Fax2dLsb (in string: faxData,
in colorLookupTable: blackOrWhite, in integer: startLine, in integer: height,
in integer: width, inout pixelImage: image) is func
local
var lsbInBitStream: faxDataStream is lsbInBitStream.value;
var ccittFaxValues: bValues is ccittFaxValues.value;
var integer: line is 0;
begin
faxDataStream := openLsbInBitStream(faxData);
for line range startLine to startLine + height - 1 do
skipEol(faxDataStream, 2#100000000000);
if getBit(faxDataStream) = 1 then
processCcittT4Fax1dRow(faxDataStream, whiteLsbHuffmanDecoder,
blackLsbHuffmanDecoder, blackOrWhite[1], blackOrWhite[0],
width, bValues, image[line]);
else
processCcittT4Fax2dRow(faxDataStream, t4LsbHuffmanDecoder,
whiteLsbHuffmanDecoder, blackLsbHuffmanDecoder,
blackOrWhite, width, bValues, image[line]);
end if;
end for;
end func;