
(********************************************************************)
(*                                                                  *)
(*  inflate.s7i   Inflate uncompression algorithm                   *)
(*  Copyright (C) 2008  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.                       *)
(*                                                                  *)
(********************************************************************)


const func integer: getBitLe (in string: stri, inout integer: bytePos,
    inout integer: bitPos) is func
  result
    var integer: resultBit is 0;
  begin
    resultBit := (ord(stri[bytePos]) >> bitPos) mod 2;
    if bitPos = 7 then
      bitPos := 0;
      incr(bytePos);
    else
      incr(bitPos);
    end if;
  end func;


const func integer: getBitsLe (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in var integer: bitsNeeded) is func
  result
    var integer: resultBits is 0;
  local
    var integer: bitsInByte is 0;
    var integer: bitsInResult is 0;
  begin
    bitsInByte := 8 - bitPos;
    if bitsInByte > bitsNeeded then
      resultBits := (ord(stri[bytePos]) >> bitPos) rem (1 << bitsNeeded);
      bitPos +:= bitsNeeded;
    else
      resultBits := ord(stri[bytePos]) mod 256 >> bitPos;
      bitPos := 0;
      incr(bytePos);
      if bitsInByte <> bitsNeeded then
        bitsNeeded -:= bitsInByte;
        bitsInResult := bitsInByte;
        while bitsNeeded >= 8 do
          resultBits +:= ord(stri[bytePos]) << bitsInResult;
          incr(bytePos);
          bitsNeeded -:= 8;
          bitsInResult +:= 8;
        end while;
        if bitsNeeded <> 0 then
          resultBits +:= ord(stri[bytePos]) rem (1 << bitsNeeded) << bitsInResult;
          bitPos := bitsNeeded;
        end if;
      end if;
    end if;
  end func;


const proc: getNonCompressedBlock (in string: stri, inout integer: bytePos,
    inout string: uncompressed) is func
  local
    var integer: length is 0;
    var integer: nlength is 0;
  begin
    length := ord(stri[bytePos]) + (ord(stri[succ(bytePos)]) << 8);
    nlength := ord(stri[bytePos + 2]) + (ord(stri[bytePos + 3]) << 8);
    uncompressed &:= stri[bytePos + 4 len length];
    bytePos +:= 4 + length;
  end func;


const func integer: getLiteralOrLength (in string: stri, inout integer: bytePos,
    inout integer: bitPos) is func
  result
    var integer: literalOrLength is 0;
  local
    var integer: bitLength is 0;
  begin
    repeat
      literalOrLength <<:= 1;
      literalOrLength +:= getBitLe(stri, bytePos, bitPos);
      incr(bitLength);
    until bitLength = 7;
    if literalOrLength <= 2#0010111 then
      literalOrLength +:= 256;
    else
      literalOrLength <<:= 1;
      literalOrLength +:= getBitLe(stri, bytePos, bitPos);
      if literalOrLength <= 2#10111111 then
        literalOrLength -:= 2#00110000;
      elsif literalOrLength <= 2#11000111 then
        literalOrLength +:= 280 - 2#11000000;
      else
        literalOrLength <<:= 1;
        literalOrLength +:= getBitLe(stri, bytePos, bitPos);
        literalOrLength -:= 2#110010000 - 144;
      end if;
    end if;
  end func;


const func integer: getDistance (in string: stri, inout integer: bytePos,
    inout integer: bitPos) is func
  result
    var integer: distance is 0;
  local
    var integer: bitLength is 0;
  begin
    repeat
      distance <<:= 1;
      distance +:= getBitLe(stri, bytePos, bitPos);
      incr(bitLength);
    until bitLength = 5;
  end func;


const func integer: decodeLength (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in integer: code) is func
  result
    var integer: length is 0;
  begin
    if code <= 264 then
      length := code - 254;
    elsif code <= 268 then
      length := 11 + ((code - 265) << 1) + getBitLe(stri, bytePos, bitPos);
    elsif code <= 272 then
      length := 19 + ((code - 269) << 2) + getBitsLe(stri, bytePos, bitPos, 2);
    elsif code <= 276 then
      length := 35 + ((code - 273) << 3) + getBitsLe(stri, bytePos, bitPos, 3);
    elsif code <= 280 then
      length := 67 + ((code - 277) << 4) + getBitsLe(stri, bytePos, bitPos, 4);
    elsif code <= 284 then
      length := 131 + ((code - 281) << 5) + getBitsLe(stri, bytePos, bitPos, 5);
    elsif code = 285 then
      length := 258;
    else
      raise RANGE_ERROR;
    end if;
  end func;


const func integer: decodeDistance (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in integer: code) is func
  result
    var integer: distance is 0;
  begin
    case code of
      when {0, 1, 2, 3}:
        distance := succ(code);
      when {4, 5}:
        distance := 5 + ((code - 4) << 1) + getBitLe(stri, bytePos, bitPos);
      when {6, 7}:
        distance := 9 + ((code - 6) << 2) + getBitsLe(stri, bytePos, bitPos, 2);
      when {8, 9}:
        distance := 17 + ((code - 8) << 3) + getBitsLe(stri, bytePos, bitPos, 3);
      when {10, 11}:
        distance := 33 + ((code - 10) << 4) + getBitsLe(stri, bytePos, bitPos, 4);
      when {12, 13}:
        distance := 65 + ((code - 12) << 5) + getBitsLe(stri, bytePos, bitPos, 5);
      when {14, 15}:
        distance := 129 + ((code - 14) << 6) + getBitsLe(stri, bytePos, bitPos, 6);
      when {16, 17}:
        distance := 257 + ((code - 16) << 7) + getBitsLe(stri, bytePos, bitPos, 7);
      when {18, 19}:
        distance := 513 + ((code - 18) << 8) + getBitsLe(stri, bytePos, bitPos, 8);
      when {20, 21}:
        distance := 1025 + ((code - 20) << 9) + getBitsLe(stri, bytePos, bitPos, 9);
      when {22, 23}:
        distance := 2049 + ((code - 22) << 10) + getBitsLe(stri, bytePos, bitPos, 10);
      when {24, 25}:
        distance := 4097 + ((code - 24) << 11) + getBitsLe(stri, bytePos, bitPos, 11);
      when {26, 27}:
        distance := 8193 + ((code - 26) << 12) + getBitsLe(stri, bytePos, bitPos, 12);
      when {28, 29}:
        distance := 16385 + ((code - 28) << 13) + getBitsLe(stri, bytePos, bitPos, 13);
      otherwise:
        raise RANGE_ERROR;
    end case;
  end func;


const proc: decodeFixedHuffmanCodes (in string: compressed, inout integer: bytePos,
    inout integer: bitPos, inout string: uncompressed) is func
  local
    var integer: literalOrLength is 0;
    var integer: length is 0;
    var integer: distance is 0;
    var integer: number is 0;
    var integer: nextPos is 0;
  begin
    literalOrLength := getLiteralOrLength(compressed, bytePos, bitPos);
    while literalOrLength <> 256 do
      if literalOrLength < 256 then
        uncompressed &:= chr(literalOrLength);
      else
        length := decodeLength(compressed, bytePos, bitPos, literalOrLength);
        distance := getDistance(compressed, bytePos, bitPos);
        distance := decodeDistance(compressed, bytePos, bitPos, distance);
        if length > distance then
          nextPos := succ(length(uncompressed));
          uncompressed &:= "\0\" mult length;
          for number range nextPos to nextPos + length - 1 do
            uncompressed @:= [number] uncompressed[number - distance];
          end for;
        else # hopefully length(uncompressed) >= distance holds
          uncompressed &:= uncompressed[succ(length(uncompressed)) - distance len length];
        end if;
      end if;
      literalOrLength := getLiteralOrLength(compressed, bytePos, bitPos);
    end while;
  end func;


const type: conversionEntry is new struct
    var integer: limit is 0;
    var array integer: table is 0 times 0;
  end struct;

const type: conversionTableType is array conversionEntry;


const func integer: getHuffmanValue (in string: stri, inout integer: bytePos,
    inout integer: bitPos, in conversionTableType: conversionTable) is func
  result
    var integer: huffmanValue is 0;
  local
    var integer: bitLength is 1;
    var integer: code is 0;
  begin
    repeat
      code <<:= 1;
      code +:= getBitLe(stri, bytePos, bitPos);
      incr(bitLength);
    until code < conversionTable[bitLength].limit;
    huffmanValue := conversionTable[pred(bitLength)].table[code];
  end func;


const func conversionTableType: computeConversionTable (in array integer: codeLengths) is func
  result
    var conversionTableType: conversionTable is conversionTableType.value;
  local
    var integer: maxBits is 0;
    var integer: bits is 0;
    var integer: number is 0;
    var integer: code is 0;
    var array integer: bl_count is 0 times 0;
    var integer: length is 0;
    var array integer: nextCode is 0 times 0;
    var array integer: codeValues is 0 times 0;
  begin
    maxBits := 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      if codeLengths[number] > maxBits then
        maxBits := codeLengths[number];
      end if;
    end for;
    bl_count := [0 .. maxBits] times 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      incr(bl_count[codeLengths[number]]);
    end for;
    code := 0;
    bl_count[0] := 0;
    nextCode := maxBits times 0;
    conversionTable := succ(maxBits) times conversionEntry.value;
    for bits range 1 to maxBits do
      code := (code + bl_count[pred(bits)]) << 1;
      conversionTable[bits].limit := code >> 1;
      conversionTable[bits].table := [code .. pred(code)] times 0;
      nextCode[bits] := code;
    end for;
    conversionTable[succ(maxBits)].limit := 1 << maxBits;
    codeValues := [minIdx(codeLengths) .. maxIdx(codeLengths)] times 0;
    for number range minIdx(codeLengths) to maxIdx(codeLengths) do
      length := codeLengths[number];
      if length <> 0 then
        codeValues[number] := nextCode[length];
        incr(nextCode[length]);
        conversionTable[length].table &:= number;
      end if;
    end for;
  end func;


const proc: decodeDynamicHuffmanCodes (in string: compressed, inout integer: bytePos,
    inout integer: bitPos, inout string: uncompressed) is func
  local
    const array integer: codeLengthAlphabet is []
        (16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15);
    var integer: hlit is 0;
    var integer: hdist is 0;
    var integer: hclen is 0;
    var array integer: lengthCodeLengths is [0 .. -1] times 0;
    var array integer: combinedCodeLengths is [0 .. -1] times 0;
    var array integer: literalOrLengthCodeLengths is [0 .. -1] times 0;
    var array integer: distanceCodeLengths is [0 .. -1] times 0;
    var integer: number is 0;
    var integer: codeLength is 0;
    var integer: factor is 0;
    var conversionTableType: lengthConversionTable is conversionTableType.value;
    var conversionTableType: literalOrLengthConversionTable is conversionTableType.value;
    var conversionTableType: distanceConversionTable is conversionTableType.value;
    var integer: literalOrLength is 0;
    var integer: length is 0;
    var integer: distance is 0;
    var integer: nextPos is 0;
  begin
    hlit := getBitsLe(compressed, bytePos, bitPos, 5);
    hdist := getBitsLe(compressed, bytePos, bitPos, 5);
    hclen := getBitsLe(compressed, bytePos, bitPos, 4);
    lengthCodeLengths := [0 .. 18] times 0;
    for number range 1 to hclen + 4 do
      lengthCodeLengths[codeLengthAlphabet[number]] := getBitsLe(compressed, bytePos, bitPos, 3);
    end for;
    lengthConversionTable := computeConversionTable(lengthCodeLengths);
    number := 1;
    while number <= hlit + 257 + hdist + 1 do
      codeLength := getHuffmanValue(compressed, bytePos, bitPos, lengthConversionTable);
      if codeLength <= 15 then
        combinedCodeLengths &:= codeLength;
        incr(number);
      elsif codeLength = 16 then
        factor := getBitsLe(compressed, bytePos, bitPos, 2) + 3;
        combinedCodeLengths &:= factor times
            combinedCodeLengths[maxIdx(combinedCodeLengths)];
        number +:= factor;
      elsif codeLength = 17 then
        factor := getBitsLe(compressed, bytePos, bitPos, 3) + 3;
        combinedCodeLengths &:= factor times 0;
        number +:= factor;
      else # codeLength = 18
        factor := getBitsLe(compressed, bytePos, bitPos, 7) + 11;
        combinedCodeLengths &:= factor times 0;
        number +:= factor;
      end if;
    end while;
    literalOrLengthCodeLengths := combinedCodeLengths[.. hlit + 256];
    distanceCodeLengths := combinedCodeLengths[hlit + 257 .. ];
    literalOrLengthConversionTable := computeConversionTable(literalOrLengthCodeLengths);
    distanceConversionTable := computeConversionTable(distanceCodeLengths);
    literalOrLength := getHuffmanValue(compressed, bytePos, bitPos, literalOrLengthConversionTable);
    while literalOrLength <> 256 do
      if literalOrLength < 256 then
        uncompressed &:= chr(literalOrLength);
      else
        length := decodeLength(compressed, bytePos, bitPos, literalOrLength);
        distance := getHuffmanValue(compressed, bytePos, bitPos, distanceConversionTable);
        distance := decodeDistance(compressed, bytePos, bitPos, distance);
        if length > distance then
          nextPos := succ(length(uncompressed));
          uncompressed &:= "\0\" mult length;
          for number range nextPos to nextPos + length - 1 do
            uncompressed @:= [number] uncompressed[number - distance];
          end for;
        else # hopefully length(uncompressed) >= distance holds
          uncompressed &:= uncompressed[succ(length(uncompressed)) - distance len length];
        end if;
      end if;
      literalOrLength := getHuffmanValue(compressed, bytePos, bitPos, literalOrLengthConversionTable);
    end while;
  end func;


const proc: processCompressedBlock (in string: compressed, inout integer: bytePos,
    inout integer: bitPos, inout string: uncompressed, inout boolean: bfinal) is func
  local
    var integer: btype is 0;
  begin
    bfinal := odd(getBitLe(compressed, bytePos, bitPos));
    btype := getBitsLe(compressed, bytePos, bitPos, 2);
    case btype of
      when {0}:
        if bitPos <> 0 then
          incr(bytePos);
          bitPos := 0;
        end if;
        getNonCompressedBlock(compressed, bytePos, uncompressed);
      when {1}:
        decodeFixedHuffmanCodes(compressed, bytePos, bitPos, uncompressed);
      when {2}:
        decodeDynamicHuffmanCodes(compressed, bytePos, bitPos, uncompressed);
      otherwise:
        raise RANGE_ERROR;
    end case;
  end func;


(**
 *  Decompress a string that was compressed with DEFLATE.
 *  DEFLATE is a compression algorithm that uses a combination of
 *  the LZ77 algorithm and Huffman coding.
 *  @return the uncompressed string.
 *  @exception RANGE_ERROR When ''compressed'' is not in DEFLATE format.
 *)
const func string: inflate (in string: compressed) is func
  result
    var string: uncompressed is "";
  local
    var integer: bytePos is 1;
    var integer: bitPos is 0;
    var boolean: bfinal is FALSE;
  begin
    repeat
      processCompressedBlock(compressed, bytePos, bitPos, uncompressed, bfinal);
    until bfinal;
  end func;
