(********************************************************************)
(*                                                                  *)
(*  gif.s7i       Support for the GIF image file format.            *)
(*  Copyright (C) 2021 - 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 "draw.s7i";
include "lzw.s7i";
include "pixelimage.s7i";


const string: GIF_MAGIC_87 is "GIF87a";
const string: GIF_MAGIC_89 is "GIF89a";

const integer: GIF_SCREEN_DESCRIPTOR_SIZE is 7;
const integer: GIF_IMAGE_DESCRIPTOR_SIZE  is 9;

const char: GIF_IMAGE_SENTINEL     is ',';
const char: GIF_EXTENSION_SENTINEL is '!';
const char: GIF_TRAILER_SENTINEL   is ';';

const integer: GIF_PLAIN_TEXT_EXTENSION      is 16#01;
const integer: GIF_GRAPHIC_CONTROL_EXTENSION is 16#f9;
const integer: GIF_COMMENT_EXTENSION         is 16#fe;
const integer: GIF_APPLICATION_EXTENSION     is 16#ff;

const type: gifHeader is new struct
    var integer: screenWidth is 0;
    var integer: screenHeight is 0;
    var boolean: hasGlobalColorMap is FALSE;
    var integer: bitsOfColorResolution is 0;
    var boolean: paletteIsSorted is FALSE;
    var integer: bitsPerPixel is 0;
    var colorLookupTable: globalColorMap is colorLookupTable.value;
  end struct;

const type: gifImageHeader is new struct
    var integer: leftPosition is 0;
    var integer: topPosition is 0;
    var integer: width is 0;
    var integer: height is 0;
    var boolean: hasLocalColorMap is FALSE;
    var boolean: interlacedOrder is FALSE;
    var boolean: paletteIsSorted is FALSE;
    var integer: bitsPerPixel is 0;
    var colorLookupTable: localColorMap is colorLookupTable.value;
  end struct;

const type: gifGraphicControlExtension is new struct
    var integer: disposalMethod is 0;
    var boolean: userInputFlag is FALSE;
    var boolean: transparentColorFlag is FALSE;
    var integer: delayTime is 0;
    var integer: transparentColorIndex is 0;
  end struct;

const type: gifApplicationExtension is new struct
    var boolean: loopCountPresent is FALSE;
    var integer: loopCount is 0;
  end struct;


const proc: readGifColorMap (inout file: gifFile, in integer: bitsPerPixel,
    inout colorLookupTable: colorMap) is func
  local
    var integer: maxColorMapIndex is 0;
    var integer: colorMapIndex is 0;
    var string: rgbData is "";
    var integer: byteIndex is 1;
  begin
    maxColorMapIndex := pred(2 ** bitsPerPixel);
    colorMap := colorLookupTable[.. maxColorMapIndex] times pixel.value;
    rgbData := gets(gifFile, succ(maxColorMapIndex) * 3);
    for colorMapIndex range 0 to maxColorMapIndex do
      colorMap[colorMapIndex] := rgbPixel(ord(rgbData[byteIndex]) * 256,
                                          ord(rgbData[succ(byteIndex)]) * 256,
                                          ord(rgbData[byteIndex + 2]) * 256);
      byteIndex +:= 3;
    end for;
  end func;


const proc: showHeader (in gifHeader: header) is func
  begin
    writeln("screenWidth: " <& header.screenWidth);
    writeln("screenHeight: " <& header.screenHeight);
    writeln("hasGlobalColorMap: " <& header.hasGlobalColorMap);
    writeln("bitsOfColorResolution: " <& header.bitsOfColorResolution);
    writeln("paletteIsSorted: " <& header.paletteIsSorted);
    writeln("bitsPerPixel: " <& header.bitsPerPixel);
  end func;


const proc: readHeader (inout file: gifFile, inout gifHeader: header) is func
  local
    var string: screenDescriptor is "";
  begin
    screenDescriptor := gets(gifFile, GIF_SCREEN_DESCRIPTOR_SIZE);
    if length(screenDescriptor) = GIF_SCREEN_DESCRIPTOR_SIZE then
      header.screenWidth  := bytes2Int(screenDescriptor[1 fixLen 2], UNSIGNED, LE);
      header.screenHeight := bytes2Int(screenDescriptor[3 fixLen 2], UNSIGNED, LE);
      header.hasGlobalColorMap     :=       ord(screenDescriptor[5]) >= 128;
      header.bitsOfColorResolution := succ((ord(screenDescriptor[5]) >> 4) mod 8);
      header.paletteIsSorted       :=   odd(ord(screenDescriptor[5]) >> 3);
      header.bitsPerPixel          :=  succ(ord(screenDescriptor[5]) mod 8);
      # showHeader(header);
      if header.hasGlobalColorMap then
        readGifColorMap(gifFile, header.bitsPerPixel, header.globalColorMap);
      end if;
    else
      raise RANGE_ERROR;
    end if;
  end func;


const proc: showImageHeader (in gifImageHeader: header) is func
  begin
    writeln("leftPosition: " <& header.leftPosition);
    writeln("topPosition: " <& header.topPosition);
    writeln("width: " <& header.width);
    writeln("height: " <& header.height);
    writeln("hasLocalColorMap: " <& header.hasLocalColorMap);
    writeln("interlacedOrder: " <& header.interlacedOrder);
    writeln("paletteIsSorted: " <& header.paletteIsSorted);
    writeln("bitsPerPixel: " <& header.bitsPerPixel);
  end func;


const proc: readImageHeader (inout file: gifFile, inout gifImageHeader: header) is func
  local
    var string: imageDescriptor is "";
  begin
    imageDescriptor := gets(gifFile, GIF_IMAGE_DESCRIPTOR_SIZE);
    if length(imageDescriptor) = GIF_IMAGE_DESCRIPTOR_SIZE then
      header.leftPosition := bytes2Int(imageDescriptor[1 fixLen 2], UNSIGNED, LE);
      header.topPosition  := bytes2Int(imageDescriptor[3 fixLen 2], UNSIGNED, LE);
      header.width        := bytes2Int(imageDescriptor[5 fixLen 2], UNSIGNED, LE);
      header.height       := bytes2Int(imageDescriptor[7 fixLen 2], UNSIGNED, LE);
      header.hasLocalColorMap :=      ord(imageDescriptor[9]) >= 128;
      header.interlacedOrder  :=  odd(ord(imageDescriptor[9]) >> 6);
      header.paletteIsSorted  :=  odd(ord(imageDescriptor[9]) >> 5);
      header.bitsPerPixel     := succ(ord(imageDescriptor[9]) mod 8);
      # showImageHeader(header);
      if header.hasLocalColorMap then
        readGifColorMap(gifFile, header.bitsPerPixel, header.localColorMap);
      end if;
    else
      raise RANGE_ERROR;
    end if;
  end func;


const func string: readSubBlockSeries (inout file: gifFile) is func
  result
    var string: data is "";
  local
    var integer: blockSize is 0;
  begin
    blockSize := ord(getc(gifFile));
    while blockSize <> 0 do
      data &:= gets(gifFile, blockSize);
      blockSize := ord(getc(gifFile));
    end while;
  end func;


const proc: showExtension (in gifGraphicControlExtension: extension) is func
  begin
    writeln("disposalMethod: " <& extension.disposalMethod);
    writeln("userInputFlag: " <& extension.userInputFlag);
    writeln("transparentColorFlag: " <& extension.transparentColorFlag);
    writeln("delayTime: " <& extension.delayTime);
    writeln("transparentColorIndex: " <& extension.transparentColorIndex);
  end func;


const proc: readGraphicControlExtension (inout file: gifFile,
    inout gifGraphicControlExtension: extension) is func
  local
    var integer: dataSize is 0;
    var string: extensionData is "";
  begin
    dataSize := succ(ord(getc(gifFile)));
    extensionData := gets(gifFile, dataSize);
    if dataSize = 5 and length(extensionData) = 5 then
      extension.disposalMethod       :=    (ord(extensionData[1]) >> 2) mod 8;
      extension.userInputFlag        := odd(ord(extensionData[1]) >> 1);
      extension.transparentColorFlag := odd(ord(extensionData[1]));
      extension.delayTime := bytes2Int(extensionData[2 fixLen 2], UNSIGNED, LE);
      if extension.transparentColorFlag then
        extension.transparentColorIndex := ord(extensionData[4]);
      end if;
      if extensionData[dataSize] <> '\0;' then
        raise RANGE_ERROR;
      end if;
    else
      raise RANGE_ERROR;
    end if;
    # showExtension(extension);
  end func;


const proc: showExtension (in gifApplicationExtension: extension) is func
  begin
    writeln("loopCountPresent: " <& extension.loopCountPresent);
    writeln("loopCount: " <& extension.loopCount);
  end func;


const proc: readApplicationExtension (inout file: gifFile,
    inout gifApplicationExtension: extension) is func
  local
    var string: extensionData is "";
  begin
    extensionData := readSubBlockSeries(gifFile);
    if startsWith(extensionData, "NETSCAPE2.0\1;") or
        startsWith(extensionData, "ANIMEXTS1.0\1;") then
      # Looping Application Extension
      extension.loopCountPresent := TRUE;
      extension.loopCount := bytes2Int(extensionData[13 fixLen 2], UNSIGNED, LE);
    elsif startsWith(extensionData, "NETSCAPE2.0\2;") then
      # Buffering Application Extension
      noop;
    end if;
    # showExtension(extension);
  end func;


const proc: fillGifImageLine8Bit (inout pixelArray: imageLine,
    in integer: leftPosition, in integer: width, in string: pixelData,
    in var integer: pixelIndex, in colorLookupTable: palette) is func
  local
    var char: colorIndex is '\0;';
    var integer: column is 0;
  begin
    for column range succ(leftPosition) to leftPosition + width do
      colorIndex := pixelData[pixelIndex];
      incr(pixelIndex);
      imageLine[column] := palette[ord(colorIndex)];
    end for;
  end func;


const proc: fillGifImage8Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in gifImageHeader: imageHeader) is func
  local
    var integer: line is 0;
    var integer: pixelIndex is 1;
  begin
    # writeln("length(pixelData): " <& length(pixelData));
    # writeln("height: " <& imageHeader.height);
    # writeln("width: " <& imageHeader.width);
    # writeln("no transparent color");
    for line range succ(imageHeader.topPosition) to
        imageHeader.topPosition + imageHeader.height do
      fillGifImageLine8Bit(image[line], imageHeader.leftPosition,
                           imageHeader.width, pixelData, pixelIndex,
                           palette);
      pixelIndex +:= imageHeader.width;
    end for;
  end func;


const proc: fillGifImageLine8Bit (inout pixelArray: imageLine,
    in integer: leftPosition, in integer: width, in string: pixelData,
    in var integer: pixelIndex, in colorLookupTable: palette,
    in integer: transparentColorIndex) is func
  local
    var char: colorIndex is '\0;';
    var integer: column is 0;
  begin
    for column range succ(leftPosition) to leftPosition + width do
      colorIndex := pixelData[pixelIndex];
      incr(pixelIndex);
      if ord(colorIndex) <> transparentColorIndex then
        imageLine[column] := palette[ord(colorIndex)];
      end if;
    end for;
  end func;


const proc: fillGifImage8Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in integer: transparentColorIndex,
    in gifImageHeader: imageHeader) is func
  local
    var integer: line is 0;
    var integer: pixelIndex is 1;
  begin
    # writeln("length(pixelData): " <& length(pixelData));
    # writeln("height: " <& imageHeader.height);
    # writeln("width: " <& imageHeader.width);
    # writeln("transparentColorIndex: " <& ord(transparentColorIndex));
    for line range succ(imageHeader.topPosition) to
        imageHeader.topPosition + imageHeader.height do
      fillGifImageLine8Bit(image[line], imageHeader.leftPosition,
                           imageHeader.width, pixelData, pixelIndex,
                           palette, transparentColorIndex);
      pixelIndex +:= imageHeader.width;
    end for;
  end func;


const proc: fillGifImage8BitInterlaced (inout pixelImage: image,
    in string: pixelData, in colorLookupTable: palette,
    in gifImageHeader: imageHeader) is func
  local
    var char: colorIndex is '\0;';
    var integer: line is 0;
    var integer: lineBeyond is 0;
    var integer: lineDelta is 8;
    var integer: column is 0;
    var integer: columnBeyond is 0;
    var integer: interlace is 1;
  begin
    # writeln("length(pixelData): " <& length(pixelData));
    # writeln("height: " <& imageHeader.height);
    # writeln("width: " <& imageHeader.width);
    # writeln("no transparent color");
    line := succ(imageHeader.topPosition);
    lineBeyond := succ(imageHeader.topPosition + imageHeader.height);
    column := succ(imageHeader.leftPosition);
    columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
    for colorIndex range pixelData do
      image[line][column] := palette[ord(colorIndex)];
      incr(column);
      if column = columnBeyond then
        line +:= lineDelta;
        if line >= lineBeyond then
          incr(interlace);
          case interlace of
            when {2}: line := imageHeader.topPosition + 5;
                      lineDelta := 8;
            when {3}: line := imageHeader.topPosition + 3;
                      lineDelta := 4;
            when {4}: line := imageHeader.topPosition + 2;
                      lineDelta := 2;
          end case;
        end if;
        column := succ(imageHeader.leftPosition);
      end if;
    end for;
  end func;


const proc: fillGifImage8BitInterlaced (inout pixelImage: image,
    in string: pixelData, in colorLookupTable: palette,
    in integer: transparentColorIndex, in gifImageHeader: imageHeader) is func
  local
    var char: colorIndex is '\0;';
    var integer: line is 0;
    var integer: lineBeyond is 0;
    var integer: lineDelta is 8;
    var integer: column is 0;
    var integer: columnBeyond is 0;
    var integer: interlace is 1;
  begin
    # writeln("length(pixelData): " <& length(pixelData));
    # writeln("height: " <& imageHeader.height);
    # writeln("width: " <& imageHeader.width);
    # writeln("transparentColorIndex: " <& ord(transparentColorIndex));
    line := succ(imageHeader.topPosition);
    lineBeyond := succ(imageHeader.topPosition + imageHeader.height);
    column := succ(imageHeader.leftPosition);
    columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
    for colorIndex range pixelData do
      if ord(colorIndex) <> transparentColorIndex then
        image[line][column] := palette[ord(colorIndex)];
      end if;
      incr(column);
      if column = columnBeyond then
        line +:= lineDelta;
        if line >= lineBeyond then
          incr(interlace);
          case interlace of
            when {2}: line := imageHeader.topPosition + 5;
                      lineDelta := 8;
            when {3}: line := imageHeader.topPosition + 3;
                      lineDelta := 4;
            when {4}: line := imageHeader.topPosition + 2;
                      lineDelta := 2;
          end case;
        end if;
        column := succ(imageHeader.leftPosition);
      end if;
    end for;
  end func;


const proc: readImage (inout file: gifFile, in gifHeader: header,
    in gifImageHeader: imageHeader, in gifGraphicControlExtension: extension,
    inout pixelImage: image) is func
  local
    var integer: initialNumberOfLzwBits is 0;
    var string: uncompressed is "";
  begin
    initialNumberOfLzwBits := ord(getc(gifFile));
    uncompressed := lzwDecompressLsb(readSubBlockSeries(gifFile),
                                     initialNumberOfLzwBits);
    if imageHeader.hasLocalColorMap then
      if extension.transparentColorFlag then
        if imageHeader.interlacedOrder then
          fillGifImage8BitInterlaced(image, uncompressed, imageHeader.localColorMap,
                           extension.transparentColorIndex, imageHeader);
        else
          fillGifImage8Bit(image, uncompressed, imageHeader.localColorMap,
                           extension.transparentColorIndex, imageHeader);
        end if;
      else
        if imageHeader.interlacedOrder then
          fillGifImage8BitInterlaced(image, uncompressed,
                                     imageHeader.localColorMap, imageHeader);
        else
          fillGifImage8Bit(image, uncompressed, imageHeader.localColorMap,
                           imageHeader);
        end if;
      end if;
    else
      if extension.transparentColorFlag then
        if imageHeader.interlacedOrder then
          fillGifImage8BitInterlaced(image, uncompressed, header.globalColorMap,
                           extension.transparentColorIndex, imageHeader);
        else
          fillGifImage8Bit(image, uncompressed, header.globalColorMap,
                           extension.transparentColorIndex, imageHeader);
        end if;
      else
        if imageHeader.interlacedOrder then
          fillGifImage8BitInterlaced(image, uncompressed,
                                     header.globalColorMap, imageHeader);
        else
          fillGifImage8Bit(image, uncompressed, header.globalColorMap,
                           imageHeader);
        end if;
      end if;
    end if;
  end func;


const type: gifData is new struct
    var file: gifFile is STD_NULL;
    var gifHeader: header is gifHeader.value;
    var pixelImage: image is pixelImage.value;
    var gifApplicationExtension: applicationExtension is gifApplicationExtension.value;
    var integer: startPos is 0;
    var char: sentinel is ' ';
    var integer: delayTime is 0;
  end struct;


const proc: getImage (inout gifData: gif) is func
  local
    var char: typeOfExtension is ' ';
    var gifImageHeader: imageHeader is gifImageHeader.value;
    var gifGraphicControlExtension: graphicsExtension is gifGraphicControlExtension.value;
    var boolean: fullImage is FALSE;
  begin
    gif.delayTime := 0;
    while gif.delayTime = 0 and not fullImage and
        gif.sentinel <> GIF_TRAILER_SENTINEL do
      if gif.sentinel = GIF_EXTENSION_SENTINEL then
        typeOfExtension := getc(gif.gifFile);
        case ord(typeOfExtension) of
          when {GIF_GRAPHIC_CONTROL_EXTENSION}:
            readGraphicControlExtension(gif.gifFile, graphicsExtension);
          when {GIF_APPLICATION_EXTENSION}:
            readApplicationExtension(gif.gifFile, gif.applicationExtension);
          when {GIF_COMMENT_EXTENSION, GIF_PLAIN_TEXT_EXTENSION}:
            ignore(readSubBlockSeries(gif.gifFile));
          otherwise: # Unknown extension
            ignore(readSubBlockSeries(gif.gifFile));
        end case;
      elsif gif.sentinel = GIF_IMAGE_SENTINEL then
        gif.delayTime := graphicsExtension.delayTime;
        readImageHeader(gif.gifFile, imageHeader);
        readImage(gif.gifFile, gif.header, imageHeader, graphicsExtension, gif.image);
        graphicsExtension := gifGraphicControlExtension.value;
        if imageHeader.leftPosition = 0 and imageHeader.topPosition = 0 and
            imageHeader.width = gif.header.screenWidth and
            imageHeader.height = gif.header.screenHeight then
          fullImage := TRUE;
        end if;
      else
        raise RANGE_ERROR;
      end if;
      gif.sentinel := getc(gif.gifFile);
    end while;
  end func;


(**
 *  Reads a GIF file into a pixmap.
 *  @param gifFile File that contains a GIF image.
 *  @return A pixmap with the GIF image, or
 *          PRIMITIVE_WINDOW.value if the file does
 *          not contain a GIF magic number.
 *  @exception RANGE_ERROR The file is not in the GIF file format.
 *)
const func PRIMITIVE_WINDOW: readGif (inout file: gifFile) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  local
    var string: magic is "";
    var gifData: gif is gifData.value;
  begin
    magic := gets(gifFile, length(GIF_MAGIC_87));
    if magic = GIF_MAGIC_87 or magic = GIF_MAGIC_89 then
      gif.gifFile := gifFile;
      readHeader(gifFile, gif.header);
      gif.image := pixelImage[.. gif.header.screenHeight] times
                   pixelArray[.. gif.header.screenWidth] times pixel.value;
      gif.sentinel := getc(gifFile);
      getImage(gif);
      pixmap := getPixmap(gif.image);
    end if;
  end func;


(**
 *  Reads a GIF file with the given ''gifFileName'' into a pixmap.
 *  @param gifFileName Name of the GIF file.
 *  @return A pixmap with the GIF image, or
 *          PRIMITIVE_WINDOW.value if the file cannot be opened or
 *          does not contain a GIF magic number.
 *  @exception RANGE_ERROR The file is not in the GIF file format.
 *)
const func PRIMITIVE_WINDOW: readGif (in string: gifFileName) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  local
    var file: gifFile is STD_NULL;
  begin
    gifFile := open(gifFileName, "r");
    if gifFile <> STD_NULL then
      pixmap := readGif(gifFile);
      close(gifFile);
    end if;
  end func;