(********************************************************************)
(*                                                                  *)
(*  ccittfax.s7i  CCITT fax decoding support library                *)
(*  Copyright (C) 2015, 2022, 2023, 2024  Thomas Mertes             *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


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;
    var integer: repeatCount is 0;
  begin
    codeLength := length(bits);
    currentCode := integer(bits, 2);
    tableIndex := currentCode << (decoder.maximumCodeLength - codeLength);
    repeatCount := 1 << (decoder.maximumCodeLength - codeLength);
    for repeatCount do
      decoder.symbols[tableIndex] := symbol;
      decoder.codeLengths[tableIndex] := codeLength;
      incr(tableIndex);
    end for;
  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"),         # Pass
    huffmanSymbolBits(CCITT_T4_HORIZONTAL,       "001"),          # Horizontal
    huffmanSymbolBits(CCITT_T4_VERTICAL_0,       "1"),            # V(0)
    huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_1, "011"),          # Vr(1)
    huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_2, "000011"),       # Vr(2)
    huffmanSymbolBits(CCITT_T4_VERTICAL_RIGHT_3, "0000011"),      # Vr(3)
    huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_1,  "010"),          # Vl(1)
    huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_2,  "000010"),       # Vl(2)
    huffmanSymbolBits(CCITT_T4_VERTICAL_LEFT_3,  "0000010"),      # Vl(3)
    huffmanSymbolBits(CCITT_T4_UNCOMPRESSED,     "0000001111"));  # Uncompressed


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);
        # writeln("W" <& whiteBits <& " ");
        if whiteBits >= 64 then
          repeat
            additionalWhiteBits := getHuffmanSymbol(ccittFaxStream, whiteDecoder);
            # writeln("W+" <& additionalWhiteBits <& " ");
            whiteBits +:= additionalWhiteBits;
          until additionalWhiteBits < 64;
        end if;
        # writeln("W=" <& whiteBits <& " ");
      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);
        # writeln("B" <& blackBits <& " ");
        if blackBits >= 64 then
          repeat
            additionalBlackBits := getHuffmanSymbol(ccittFaxStream, blackDecoder);
            # writeln("B+" <& additionalBlackBits <& " ");
            blackBits +:= additionalBlackBits;
          until additionalBlackBits < 64;
        end if;
        # writeln("B=" <& blackBits <& " ");
      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
          # Fill bits are present.
          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);


(**
 *  Read modified CCITT group 3 ''faxData'' with MSB bit ordering into ''image''.
 *  A modified CCITT Group 3 one-dimensional Huffman run-length encoding is used.
 *  The CCITT group 3 facsimile standard has been defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 2.
 *  MSB bit ordering processes the bits from the MSB (most significant bit) to
 *  the LSB (least significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData Modified CCITT group 3 one-dimensional encoded fax data with MSB bit ordering.
 *  @param whitePixel Pixel to be used for white.
 *  @param blackPixel Pixel to be used for black.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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]);
      # Go to the next available byte boundary
      ignore(gets(faxDataStream, 0));
    end for;
  end func;


(**
 *  Read modified CCITT group 3 ''faxData'' with LSB bit ordering into ''image''.
 *  A modified CCITT Group 3 one-dimensional Huffman run-length encoding is used.
 *  The CCITT group 3 facsimile standard has been defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 2.
 *  LSB bit ordering processes the bits from the LSB (least significant bit) to
 *  the MSB (most significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData Modified CCITT group 3 one-dimensional encoded fax data with LSB bit ordering.
 *  @param whitePixel Pixel to be used for white.
 *  @param blackPixel Pixel to be used for black.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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]);
      # Go to the next available byte boundary
      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}:
              # writeln("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;
              # writeln("Horizontal " <& numBits1 <& " " <& numBits2);
              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}:
              # writeln("V(0)");
              currentPixel := blackOrWhite[bIndex mod 2];
              setPixels(imageLine, currentColumn, currentBValue - 1, currentPixel);
              currentColumn := currentBValue;
              aValues &:= currentColumn;
              incr(bIndex);
            when {CCITT_T4_VERTICAL_RIGHT_1}:
              # writeln("Vr(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}:
              # writeln("Vr(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}:
              # writeln("Vr(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}:
              # writeln("Vl(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}:
              # writeln("Vl(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}:
              # writeln("Vl(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);


(**
 *  Read CCITT T.6 bi-level ''faxData'' with MSB bit ordering into ''image''.
 *  CCITT T.6 belongs to the group 4 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 4.
 *  MSB bit ordering processes the bits from the MSB (most significant bit) to
 *  the LSB (least significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.6 two-dimensional encoded fax data with MSB bit ordering.
 *  @param blackOrWhite Array with black and white pixel indexed from 0.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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;


(**
 *  Read CCITT T.6 bi-level ''faxData'' with LSB bit ordering into ''image''.
 *  CCITT T.6 belongs to the group 4 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 4.
 *  LSB bit ordering processes the bits from the LSB (least significant bit) to
 *  the MSB (most significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.6 two-dimensional encoded fax data with LSB bit ordering.
 *  @param blackOrWhite Array with black and white pixel indexed from 0.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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;


(**
 *  Read CCITT T.4 bi-level one-dimensional ''faxData'' with MSB bit ordering into ''image''.
 *  CCITT T.4 belongs to the group 3 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 3 and t4Options is even.
 *  MSB bit ordering processes the bits from the MSB (most significant bit) to
 *  the LSB (least significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.4 one-dimensional encoded fax data with MSB bit ordering.
 *  @param whitePixel Pixel to be used for white.
 *  @param blackPixel Pixel to be used for black.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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;


(**
 *  Read CCITT T.4 bi-level one-dimensional ''faxData'' with LSB bit ordering into ''image''.
 *  CCITT T.4 belongs to the group 3 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 3 and t4Options is even.
 *  LSB bit ordering processes the bits from the LSB (least significant bit) to
 *  the MSB (most significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.4 one-dimensional encoded fax data with LSB bit ordering.
 *  @param whitePixel Pixel to be used for white.
 *  @param blackPixel Pixel to be used for black.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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);


(**
 *  Read CCITT T.4 bi-level two-dimensional ''faxData'' with MSB bit ordering into ''image''.
 *  CCITT T.4 belongs to the group 3 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 3 and t4Options is odd.
 *  MSB bit ordering processes the bits from the MSB (most significant bit) to
 *  the LSB (least significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.4 two-dimensional encoded fax data with MSB bit ordering.
 *  @param blackOrWhite Array with black and white pixel indexed from 0.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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;


(**
 *  Read CCITT T.4 bi-level two-dimensional ''faxData'' with LSB bit ordering into ''image''.
 *  CCITT T.4 belongs to the group 3 facsimile standard defined by CCITT in 1988.
 *  This encoding is used in [[tiff|TIFF]] files if compression = 3 and t4Options is odd.
 *  LSB bit ordering processes the bits from the LSB (least significant bit) to
 *  the MSB (most significant bit). This function fills a part of the ''image''
 *  destination. The part starts with ''startLine'' and extends over ''height'' lines.
 *  @param faxData CCITT T.4 two-dimensional encoded fax data with LSB bit ordering.
 *  @param blackOrWhite Array with black and white pixel indexed from 0.
 *  @param startLine First line of ''image'' to which the pixels are assigned.
 *  @param height Number of lines to be processed.
 *  @param width Width of the lines to be processed.
 *  @param image Destination of the pixel lines.
 *)
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;