(********************************************************************)
(*                                                                  *)
(*  png.s7i       Support for the PNG 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 "bin32.s7i";
include "crc32.s7i";
include "draw.s7i";
include "gzip.s7i";
include "pixelimage.s7i";
include "exif.s7i";


const string: PNG_MAGIC is "\137;PNG\r\n\26;\n";

const integer: PNG_HEADER_SIZE is 13;

const integer: PNG_COLOR_TYPE_GRAYSCALE       is 0;  # Each pixel is a grayscale sample.
const integer: PNG_COLOR_TYPE_RGB             is 2;  # Each pixel is an R,G,B triple.
const integer: PNG_COLOR_TYPE_PALETTE         is 3;  # Each pixel is a palette index.
const integer: PNG_COLOR_TYPE_GRAYSCALE_ALPHA is 4;  # Each pixel is a grayscale,alpha pair.
const integer: PNG_COLOR_TYPE_RGB_ALPHA       is 6;  # Each pixel is an R,G,B,alpha quadruple,

const type: pngHeader is new struct
    var integer: width is 0;
    var integer: height is 0;
    var integer: bitDepth is 0;
    var integer: colorType is 0;
    var integer: compressionMethod is 0;
    var integer: filterMethod is 0;
    var integer: interlaceMethod is 0;
    var integer: bytesPerPixel is 0;
    var integer: bytesPerScanline is 0;
    var exifDataType: exifData is exifDataType.value;
  end struct;


const proc: showHeader (in pngHeader: header) is func
  begin
    writeln("width: " <& header.width);
    writeln("height: " <& header.height);
    writeln("bitDepth: " <& header.bitDepth);
    writeln("colorType: " <& header.colorType);
    writeln("compressionMethod: " <& header.compressionMethod);
    writeln("filterMethod: " <& header.filterMethod);
    writeln("interlaceMethod: " <& header.interlaceMethod);
    writeln("bytesPerPixel: " <& header.bytesPerPixel);
    writeln("bytesPerScanline: " <& header.bytesPerScanline);
  end func;


const func pngHeader: pngHeader (in string: stri) is func
  result
    var pngHeader: header is pngHeader.value;
  begin
    if length(stri) = PNG_HEADER_SIZE then
      header.width             := bytes2Int(stri[ 1 fixLen 4], UNSIGNED, BE);
      header.height            := bytes2Int(stri[ 5 fixLen 4], UNSIGNED, BE);
      header.bitDepth          := bytes2Int(stri[ 9 fixLen 1], UNSIGNED, BE);
      header.colorType         := bytes2Int(stri[10 fixLen 1], UNSIGNED, BE);
      header.compressionMethod := bytes2Int(stri[11 fixLen 1], UNSIGNED, BE);
      header.filterMethod      := bytes2Int(stri[12 fixLen 1], UNSIGNED, BE);
      header.interlaceMethod   := bytes2Int(stri[13 fixLen 1], UNSIGNED, BE);
      # showHeader(header);
    else
      raise RANGE_ERROR;
    end if;
  end func;


const func string: str (in pngHeader: header) is
  return bytes(header.width,             UNSIGNED, BE, 4) &
         bytes(header.height,            UNSIGNED, BE, 4) &
         bytes(header.bitDepth,          UNSIGNED, BE, 1) &
         bytes(header.colorType,         UNSIGNED, BE, 1) &
         bytes(header.compressionMethod, UNSIGNED, BE, 1) &
         bytes(header.filterMethod,      UNSIGNED, BE, 1) &
         bytes(header.interlaceMethod,   UNSIGNED, BE, 1);


const func boolean: isOkay (in pngHeader: header) is
  return (header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
          header.colorType = PNG_COLOR_TYPE_RGB or
          header.colorType = PNG_COLOR_TYPE_GRAYSCALE_ALPHA or
          header.colorType = PNG_COLOR_TYPE_RGB_ALPHA) and
              (header.bitDepth = 8 or header.bitDepth = 16) or
         (header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
          header.colorType = PNG_COLOR_TYPE_PALETTE) and
             (header.bitDepth = 1 or header.bitDepth = 2 or
              header.bitDepth = 4 or header.bitDepth = 8);


const proc: computeBytesPerPixel (inout pngHeader: header) is func
  begin
    case header.colorType of
      when {PNG_COLOR_TYPE_GRAYSCALE}:       header.bytesPerPixel := 1;
      when {PNG_COLOR_TYPE_RGB}:             header.bytesPerPixel := 3;
      when {PNG_COLOR_TYPE_PALETTE}:         header.bytesPerPixel := 1;
      when {PNG_COLOR_TYPE_GRAYSCALE_ALPHA}: header.bytesPerPixel := 2;
      when {PNG_COLOR_TYPE_RGB_ALPHA}:       header.bytesPerPixel := 4;
      otherwise: raise RANGE_ERROR;
    end case;
    if header.bitDepth = 16 then
      header.bytesPerPixel *:= 2;
    end if;
  end func;


const proc: computeBytesPerScanline (inout pngHeader: header) is func
  begin
    if header.bitDepth = 1 then
      header.bytesPerScanline := succ((header.width + 7) mdiv 8);
    elsif header.bitDepth = 2 then
      header.bytesPerScanline := succ((header.width + 3) mdiv 4);
    elsif header.bitDepth = 4 then
      header.bytesPerScanline := succ(succ(header.width) mdiv 2);
    else
      header.bytesPerScanline := succ(header.width * header.bytesPerPixel);
    end if;
  end func;


const func string: readPngChunk (inout file: pngFile, inout string: chunkType) is func
  result
    var string: chunkData is "";
  local
    var string: stri is "";
    var integer: length is 0;
    var string: crc is "";
  begin
    stri := gets(pngFile, 8);
    if length(stri) = 8 then
      length    := bytes2Int(stri[1 fixLen 4], UNSIGNED, BE);
      chunkType :=           stri[5 fixLen 4];
      chunkData := gets(pngFile, length);
      crc := gets(pngFile, 4);
      if length(chunkData) <> length or length(crc) <> 4 then
        raise RANGE_ERROR;
      elsif bin32(bytes2Int(crc, UNSIGNED, BE)) <>
          crc32(chunkType & chunkData) and
          chunkType in {"IHDR", "PLTE", "IDAT", "IEND"} then
        # The CRC of a critical chunk is incorrect.
        raise RANGE_ERROR;
      end if;
    else
      raise RANGE_ERROR;
    end if;
  end func;


const func integer: paethPredictor (in integer: a, in integer: b, in integer: c) is func
  result
    var integer: predicted is 0;
  local
    var integer: pa is 0;
    var integer: pb is 0;
    var integer: pc is 0;
  begin
    # p := a + b - c;
    pa := abs(b - c);          # pa := abs(p - a);
    pb := abs(a - c);          # pb := abs(p - b);
    pc := abs(a + b - 2 * c);  # pc := abs(p - c);
    if pa <= pb and pa <= pc then
      predicted := a;
    elsif pb <= pc then
      predicted := b;
    else
      predicted := c;
    end if;
  end func;


const proc: filterPngData (in pngHeader: header, inout string: uncompressed) is func
  local
    var integer: line is 0;
    var integer: column is 0;
    var integer: byteIndex is 1;
    var integer: filterType is 0;
    var integer: deltaUpLeft is 0;
  begin
    for line range 0 to pred(header.height) do
      byteIndex := succ(line * header.bytesPerScanline);
      filterType := ord(uncompressed[byteIndex]);
      # writeln("filterType: " <& filterType);
      incr(byteIndex);
      case filterType of
        when {0}:
          noop;
        when {1}:
          for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
            uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                           ord(uncompressed[column - header.bytesPerPixel])) mod 256);
          end for;
        when {2}:
          if line <> 0 then
            for column range byteIndex to byteIndex + header.bytesPerScanline - 2 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             ord(uncompressed[column - header.bytesPerScanline])) mod 256);
            end for;
          end if;
        when {3}:
          if line = 0 then
            for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             ord(uncompressed[column - header.bytesPerPixel]) mdiv 2) mod 256);
            end for;
          else
            for column range byteIndex to byteIndex + header.bytesPerPixel - 1 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             ord(uncompressed[column - header.bytesPerScanline]) mdiv 2) mod 256);
            end for;
            for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                            (ord(uncompressed[column - header.bytesPerPixel]) +
                                             ord(uncompressed[column - header.bytesPerScanline])) mdiv 2) mod 256);
            end for;
          end if;
        when {4}:
          if line = 0 then
            for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             paethPredictor(ord(uncompressed[column - header.bytesPerPixel]),
                                                            0, 0)) mod 256);
            end for;
          else
            for column range byteIndex to byteIndex + header.bytesPerPixel - 1 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             paethPredictor(0,
                                                            ord(uncompressed[column - header.bytesPerScanline]),
                                                            0)) mod 256);
            end for;
            deltaUpLeft := header.bytesPerScanline + header.bytesPerPixel;
            for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
              uncompressed @:= [column] chr((ord(uncompressed[column]) +
                                             paethPredictor(ord(uncompressed[column - header.bytesPerPixel]),
                                                            ord(uncompressed[column - header.bytesPerScanline]),
                                                            ord(uncompressed[column - deltaUpLeft]))) mod 256);
            end for;
          end if;
      end case;
    end for;
  end func;


const proc: fillPngImageLine1Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
  local
    var integer: column is 0;
    var integer: currentByte is 0;
    var integer: rshift is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to (width - 7) step 8 do
      currentByte := ord(pixelData[byteIndex]);
      imageLine[column]       := palette[ currentByte >> 7];
      imageLine[succ(column)] := palette[(currentByte >> 6) mod 2];
      imageLine[column + 2]   := palette[(currentByte >> 5) mod 2];
      imageLine[column + 3]   := palette[(currentByte >> 4) mod 2];
      imageLine[column + 4]   := palette[(currentByte >> 3) mod 2];
      imageLine[column + 5]   := palette[(currentByte >> 2) mod 2];
      imageLine[column + 6]   := palette[(currentByte >> 1) mod 2];
      imageLine[column + 7]   := palette[ currentByte       mod 2];
      incr(byteIndex);
    end for;
    if width mod 8 <> 0 then
      currentByte := ord(pixelData[byteIndex]);
      rshift := 7;
      for column range succ(width - width mod 8) to width do
        imageLine[column] := palette[(currentByte >> rshift) mod 2];
        decr(rshift);
      end for;
      incr(byteIndex);
    end if;
  end func;


const proc: fillPngImage1Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine1Bit(image[line], pixelData, byteIndex, palette, width);
    end for;
  end func;


const proc: fillPngImageLine2Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
  local
    var integer: column is 0;
    var integer: currentByte is 0;
    var integer: rshift is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to (width - 3) step 4 do
      currentByte := ord(pixelData[byteIndex]);
      imageLine[column]       := palette[ currentByte >> 6];
      imageLine[succ(column)] := palette[(currentByte >> 4) mod 4];
      imageLine[column + 2]   := palette[(currentByte >> 2) mod 4];
      imageLine[column + 3]   := palette[ currentByte       mod 4];
      incr(byteIndex);
    end for;
    if width mod 4 <> 0 then
      currentByte := ord(pixelData[byteIndex]);
      rshift := 6;
      for column range succ(width - width mod 4) to width do
        imageLine[column] := palette[(currentByte >> rshift) mod 4];
        rshift -:= 2;
      end for;
      incr(byteIndex);
    end if;
  end func;


const proc: fillPngImage2Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine2Bit(image[line], pixelData, byteIndex, palette, width);
    end for;
  end func;


const proc: fillPngImageLine4Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
  local
    var integer: column is 0;
    var integer: currentByte is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to pred(width) step 2 do
      currentByte := ord(pixelData[byteIndex]);
      imageLine[column]       := palette[currentByte >> 4];
      imageLine[succ(column)] := palette[currentByte mod 16];
      incr(byteIndex);
    end for;
    if odd(width) then
      imageLine[width] := palette[ord(pixelData[byteIndex]) >> 4];
      incr(byteIndex);
    end if;
  end func;


const proc: fillPngImage4Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine4Bit(image[line], pixelData, byteIndex, palette, width);
    end for;
  end func;


const proc: fillPngImageLine8Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
  local
    var integer: column is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to width do
      imageLine[column] := palette[ord(pixelData[byteIndex])];
      incr(byteIndex);
    end for;
  end func;


const proc: fillPngImage8Bit (inout pixelImage: image, in string: pixelData,
    in colorLookupTable: palette, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine8Bit(image[line], pixelData, byteIndex, palette, width);
    end for;
  end func;


const proc: fillPngImageLine8Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
  local
    var integer: column is 0;
    var integer: grayIntensity is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to width do
      grayIntensity := ord(pixelData[byteIndex]) * 256;
      imageLine[column] := rgbPixel(grayIntensity, grayIntensity, grayIntensity);
      byteIndex +:= bytesPerPixel;
    end for;
  end func;


const proc: fillPngImage8Bit (inout pixelImage: image, in string: pixelData,
    in integer: bytesPerPixel, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine8Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
    end for;
  end func;


const proc: fillPngImageLine16Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
  local
    var integer: column is 0;
    var integer: grayIntensity is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to width do
      grayIntensity := ord(pixelData[byteIndex]) * 256 + ord(pixelData[succ(byteIndex)]);
      imageLine[column] := rgbPixel(grayIntensity, grayIntensity, grayIntensity);
      byteIndex +:= bytesPerPixel;
    end for;
  end func;


const proc: fillPngImage16Bit (inout pixelImage: image, in string: pixelData,
    in integer: bytesPerPixel, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine16Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
    end for;
  end func;


const proc: fillPngImageLine24Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
  local
    var integer: column is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to width do
      imageLine[column] := rgbPixel(ord(pixelData[byteIndex]) * 256,
                                    ord(pixelData[byteIndex + 1]) * 256,
                                    ord(pixelData[byteIndex + 2]) * 256);
      byteIndex +:= bytesPerPixel;
    end for;
  end func;


const proc: fillPngImage24Bit (inout pixelImage: image, in string: pixelData,
    in integer: bytesPerPixel, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine24Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
    end for;
  end func;


const proc: fillPngImageLine48Bit (inout pixelArray: imageLine, in string: pixelData,
    inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
  local
    var integer: column is 0;
  begin
    incr(byteIndex);  # Skip byte with filterType
    for column range 1 to width do
      imageLine[column] := rgbPixel(bytes2Int(pixelData[byteIndex     fixLen 2], UNSIGNED, BE),
                                    bytes2Int(pixelData[byteIndex + 2 fixLen 2], UNSIGNED, BE),
                                    bytes2Int(pixelData[byteIndex + 4 fixLen 2], UNSIGNED, BE));
      byteIndex +:= bytesPerPixel;
    end for;
  end func;


const proc: fillPngImage48Bit (inout pixelImage: image, in string: pixelData,
    in integer: bytesPerPixel, in integer: height, in integer: width) is func
  local
    var integer: line is 0;
    var integer: byteIndex is 1;
  begin
    for line range 1 to height do
      fillPngImageLine48Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
    end for;
  end func;


const func pixelImage: pixelDataToImage (in pngHeader: header,
    in string: pixelData, in colorLookupTable: palette) is func
  result
    var pixelImage: image is pixelImage.value;
  local
    var colorLookupTable: grayscalePalette is colorLookupTable.value;
  begin
    image := pixelImage[.. header.height] times
             pixelArray[.. header.width] times pixel.value;
    if  header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
        header.colorType = PNG_COLOR_TYPE_GRAYSCALE_ALPHA then
      if header.bitDepth = 1 then
        grayscalePalette := colorLookupTable[.. 1] times pixel.value;
        grayscalePalette[0] := rgbPixel(    0,     0,     0);
        grayscalePalette[1] := rgbPixel(65535, 65535, 65535);
        fillPngImage1Bit(image, pixelData, grayscalePalette, header.height, header.width);
      elsif header.bitDepth = 2 then
        grayscalePalette := colorLookupTable[.. 3] times pixel.value;
        grayscalePalette[0] := rgbPixel(    0,     0,     0);
        grayscalePalette[1] := rgbPixel(21845, 21845, 21845);
        grayscalePalette[2] := rgbPixel(43690, 43690, 43690);
        grayscalePalette[3] := rgbPixel(65535, 65535, 65535);
        fillPngImage2Bit(image, pixelData, grayscalePalette, header.height, header.width);
      elsif header.bitDepth = 4 then
        grayscalePalette := colorLookupTable[.. 15] times pixel.value;
        grayscalePalette[ 0] := rgbPixel(    0,     0,     0);
        grayscalePalette[ 1] := rgbPixel( 4369,  4369,  4369);
        grayscalePalette[ 2] := rgbPixel( 8738,  8738,  8738);
        grayscalePalette[ 3] := rgbPixel(13107, 13107, 13107);
        grayscalePalette[ 4] := rgbPixel(17476, 17476, 17476);
        grayscalePalette[ 5] := rgbPixel(21845, 21845, 21845);
        grayscalePalette[ 6] := rgbPixel(26214, 26214, 26214);
        grayscalePalette[ 7] := rgbPixel(30583, 30583, 30583);
        grayscalePalette[ 8] := rgbPixel(34952, 34952, 34952);
        grayscalePalette[ 9] := rgbPixel(39321, 39321, 39321);
        grayscalePalette[10] := rgbPixel(43690, 43690, 43690);
        grayscalePalette[11] := rgbPixel(48059, 48059, 48059);
        grayscalePalette[12] := rgbPixel(52428, 52428, 52428);
        grayscalePalette[13] := rgbPixel(56797, 56797, 56797);
        grayscalePalette[14] := rgbPixel(61166, 61166, 61166);
        grayscalePalette[15] := rgbPixel(65535, 65535, 65535);
        fillPngImage4Bit(image, pixelData, grayscalePalette, header.height, header.width);
      elsif header.bitDepth = 8 then
        fillPngImage8Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
      else
        fillPngImage16Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
      end if;
    elsif header.colorType = PNG_COLOR_TYPE_RGB or
          header.colorType = PNG_COLOR_TYPE_RGB_ALPHA then
      if header.bitDepth = 8 then
        fillPngImage24Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
      else
        fillPngImage48Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
      end if;
    elsif header.colorType = PNG_COLOR_TYPE_PALETTE then
      if header.bitDepth = 1 then
        fillPngImage1Bit(image, pixelData, palette, header.height, header.width);
      elsif header.bitDepth = 2 then
        fillPngImage2Bit(image, pixelData, palette, header.height, header.width);
      elsif header.bitDepth = 4 then
        fillPngImage4Bit(image, pixelData, palette, header.height, header.width);
      else
        fillPngImage8Bit(image, pixelData, palette, header.height, header.width);
      end if;
    end if;
  end func;


const func pixelImage: interlaceToImage (in pngHeader: header,
    in string: pixelData, in colorLookupTable: palette) is func
  result
    var pixelImage: image is pixelImage.value;
  local
    var integer: pass is 0;
    var pngHeader: passHeader is pngHeader.value;
    var integer: passStartPos is 1;
    var string: passData is "";
    var pixelImage: passImage is pixelImage.value;
    var integer: line is 0;
    var integer: column is 0;
    var integer: passLine is 0;
    var integer: passColumn is 0;
    var integer: startLine is 0;
    var integer: startColumn is 0;
    var integer: lineDelta is 0;
    var integer: columnDelta is 0;
  begin
    image := pixelImage[.. header.height] times
             pixelArray[.. header.width] times pixel.value;
    for pass range 1 to 7 do
      case pass of
        when {1}:
          startLine := 1;
          startColumn := 1;
          lineDelta := 8;
          columnDelta := 8;
        when {2}:
          startLine := 1;
          startColumn := 5;
          lineDelta := 8;
          columnDelta := 8;
        when {3}:
          startLine := 5;
          startColumn := 1;
          lineDelta := 8;
          columnDelta := 4;
        when {4}:
          startLine := 1;
          startColumn := 3;
          lineDelta := 4;
          columnDelta := 4;
        when {5}:
          startLine := 3;
          startColumn := 1;
          lineDelta := 4;
          columnDelta := 2;
        when {6}:
          startLine := 1;
          startColumn := 2;
          lineDelta := 2;
          columnDelta := 2;
        when {7}:
          startLine := 2;
          startColumn := 1;
          lineDelta := 2;
          columnDelta := 1;
      end case;
      if startLine <= header.height and startColumn <= header.width then
        passHeader.width := (header.width + columnDelta - startColumn) div columnDelta;
        passHeader.height := (header.height + lineDelta - startLine) div lineDelta;
        passHeader.bitDepth := header.bitDepth;
        passHeader.colorType := header.colorType;
        passHeader.bytesPerPixel := header.bytesPerPixel;
        computeBytesPerScanline(passHeader);
        passData := pixelData[passStartPos ..];
        filterPngData(passHeader, passData);
        passImage := pixelDataToImage(passHeader, passData, palette);
        line := startLine;
        for passLine range 1 to passHeader.height do
          column := startColumn;
          for passColumn range 1 to passHeader.width do
            image[line][column] := passImage[passLine][passColumn];
            column +:= columnDelta;
          end for;
          line +:= lineDelta;
        end for;
        passStartPos +:= passHeader.height * passHeader.bytesPerScanline;
      end if;
    end for;
  end func;


(**
 *  Reads a PNG file into a pixmap.
 *  @param pngFile File that contains a PNG image.
 *  @return A pixmap with the PNG image, or
 *          PRIMITIVE_WINDOW.value if the file does
 *          not contain a PNG magic number.
 *  @exception RANGE_ERROR The file is not in the PNG file format.
 *)
const func PRIMITIVE_WINDOW: readPng (inout file: pngFile) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  local
    var string: magic is "";
    var string: chunkType is "";
    var string: chunkData is "";
    var pngHeader: header is pngHeader.value;
    var string: compressed is "";
    var string: uncompressed is "";
    var integer: paletteIndex is 0;
    var integer: byteIndex is 1;
    var colorLookupTable: palette is colorLookupTable.value;
    var pixelImage: image is pixelImage.value;
  begin
    magic := gets(pngFile, length(PNG_MAGIC));
    if magic = PNG_MAGIC then
      repeat
        chunkData := readPngChunk(pngFile, chunkType);
        # write("chunkType: " <& literal(chunkType));
        # writeln(", isCritical: " <& chunkType[1] in {'A' .. 'Z'} lpad 5 <&
        #         ", length: " <& length(chunkData) lpad 6);
        case chunkType of
          when {"IHDR"}:
            header := pngHeader(chunkData);
          when {"PLTE"}:
            palette := colorLookupTable[.. pred(length(chunkData) div 3)] times pixel.value;
            byteIndex := 1;
            for paletteIndex range 0 to pred(length(chunkData) div 3) do
              palette[paletteIndex] := rgbPixel(ord(chunkData[byteIndex]) * 256,
                                                ord(chunkData[byteIndex + 1]) * 256,
                                                ord(chunkData[byteIndex + 2]) * 256);
              byteIndex +:= 3;
            end for;
          when {"IDAT"}:
            compressed &:= chunkData;
          when {"eXIf"}:
            readExifData(chunkData, header.exifData);
        end case;
      until chunkType = "IEND";
      if isOkay(header) then
        computeBytesPerPixel(header);
        computeBytesPerScanline(header);
        uncompressed := gzuncompress(compressed);
        if header.interlaceMethod = 0 then
          filterPngData(header, uncompressed);
          image := pixelDataToImage(header, uncompressed, palette);
        else
          image := interlaceToImage(header, uncompressed, palette);
        end if;
        if header.exifData.orientation > EXIF_ORIENTATION_NORMAL and
            header.exifData.orientation < EXIF_ORIENTATION_UNDEFINED then
          changeOrientation(image, header.exifData.orientation);
        end if;
        pixmap := getPixmap(image);
      else
        raise RANGE_ERROR;
      end if;
    end if;
  end func;


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


const func string: imageToPixelData (in pixelImage: image) is func
  result
    var string: pixelData is "";
  local
    var integer: line is 0;
    var pixel: pix is pixel.value;
    var color: col is color.value;
  begin
    for line range 1 to length(image) do
      pixelData &:= '\0;';  # Set filterType to none
      for pix range image[line] do
        col := pixelToColor(pix);
        pixelData &:= chr(col.redLight   mdiv 256);
        pixelData &:= chr(col.greenLight mdiv 256);
        pixelData &:= chr(col.blueLight  mdiv 256);
      end for;
    end for;
  end func;


const proc: doFilter0 (in pngHeader: header, inout string: scanline0,
    inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range 1 to pred(header.bytesPerScanline) do
      delta := ord(scanline0[column]);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter1 (in pngHeader: header, inout string: scanline1,
    inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
      delta := (ord(scanline1[column]) -
                ord(scanline1[column - header.bytesPerPixel])) mod 256;
      scanline1 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter2 (in pngHeader: header, in string: upperScanline,
    inout string: scanline2, inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range 1 to pred(header.bytesPerScanline) do
      delta := (ord(scanline2[column]) -
                ord(upperScanline[column])) mod 256;
      scanline2 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter3 (in pngHeader: header, inout string: scanline3,
    inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
      delta := (ord(scanline3[column]) -
                ord(scanline3[column - header.bytesPerPixel]) mdiv 2) mod 256;
      scanline3 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter3 (in pngHeader: header, in string: upperScanline,
    inout string: scanline3, inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
      delta := (ord(scanline3[column]) -
                (ord(scanline3[column - header.bytesPerPixel]) +
                 ord(upperScanline[column])) mdiv 2) mod 256;
      scanline3 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
    for column range header.bytesPerPixel downto 1 do
      delta := (ord(scanline3[column]) -
                ord(upperScanline[column]) mdiv 2) mod 256;
      scanline3 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter4 (in pngHeader: header, inout string: scanline4,
    inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
      delta := (ord(scanline4[column]) -
                paethPredictor(ord(scanline4[column - header.bytesPerPixel]),
                               0, 0)) mod 256;
      scanline4 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: doFilter4 (in pngHeader: header, in string: upperScanline,
    inout string: scanline4, inout integer: sumOfDifferences) is func
  local
    var integer: column is 0;
    var integer: delta is 0;
  begin
    for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
      delta := (ord(scanline4[column]) -
                paethPredictor(ord(scanline4[column - header.bytesPerPixel]),
                               ord(upperScanline[column]),
                               ord(upperScanline[column - header.bytesPerPixel]))) mod 256;
      scanline4 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
    for column range header.bytesPerPixel downto 1 do
      delta := (ord(scanline4[column]) -
                paethPredictor(0,
                               ord(upperScanline[column]),
                               0)) mod 256;
      scanline4 @:= [column] chr(delta);
      if delta >= 128 then
        sumOfDifferences +:= 256 - delta;
      else
        sumOfDifferences +:= delta;
      end if;
    end for;
  end func;


const proc: setPngFilter (in pngHeader: header, inout string: pixelData,
    in integer: line) is func
  local
    var integer: byteIndex is 1;
    var string: scanline1 is "";
    var string: scanline2 is "";
    var string: scanline3 is "";
    var string: scanline4 is "";
    var integer: sumOfDifferences0 is 0;
    var integer: sumOfDifferences1 is 0;
    var integer: sumOfDifferences2 is 0;
    var integer: sumOfDifferences3 is 0;
    var integer: sumOfDifferences4 is 0;
    var integer: filterZeroMin is 0;
  begin
    byteIndex := line * header.bytesPerScanline + 2;
    scanline1 := pixelData[byteIndex len pred(header.bytesPerScanline)];
    doFilter0(header, scanline1, sumOfDifferences0);
    doFilter1(header, scanline1, sumOfDifferences1);
    if line <> 0 then
      scanline2 := pixelData[byteIndex len pred(header.bytesPerScanline)];
      doFilter2(header,
                pixelData[byteIndex - header.bytesPerScanline
                          len pred(header.bytesPerScanline)],
                scanline2, sumOfDifferences2);
    else
      sumOfDifferences2 := integer.last;
    end if;
    scanline3 := pixelData[byteIndex len pred(header.bytesPerScanline)];
    if line = 0 then
      doFilter3(header, scanline3, sumOfDifferences3);
    else
      doFilter3(header,
                pixelData[byteIndex - header.bytesPerScanline
                          len pred(header.bytesPerScanline)],
                scanline3, sumOfDifferences3);
    end if;
    scanline4 := pixelData[byteIndex len pred(header.bytesPerScanline)];
    if line = 0 then
      doFilter4(header, scanline4, sumOfDifferences4);
    else
      doFilter4(header,
                pixelData[byteIndex - header.bytesPerScanline
                          len pred(header.bytesPerScanline)],
                scanline4, sumOfDifferences4);
    end if;
    filterZeroMin := min(min(sumOfDifferences0, sumOfDifferences1),
                         min(sumOfDifferences2, min(sumOfDifferences3, sumOfDifferences4)));
    if sumOfDifferences0 = filterZeroMin then
      noop;
    elsif sumOfDifferences1 = filterZeroMin then
      pixelData @:= [pred(byteIndex)] '\1;';
      pixelData @:= [byteIndex] scanline1;
    elsif sumOfDifferences2 = filterZeroMin then
      pixelData @:= [pred(byteIndex)] '\2;';
      pixelData @:= [byteIndex] scanline2;
    elsif sumOfDifferences3 = filterZeroMin then
      pixelData @:= [pred(byteIndex)] '\3;';
      pixelData @:= [byteIndex] scanline3;
    else
      pixelData @:= [pred(byteIndex)] '\4;';
      pixelData @:= [byteIndex] scanline4;
    end if;
    # writeln(sumOfDifferences0 <& " " <& sumOfDifferences1 <& " " <& sumOfDifferences2 <& " " <&
    #     sumOfDifferences3 <& " " <& sumOfDifferences4 <& " " <& ord(pixelData[pred(byteIndex)]));
  end func;


const proc: setPngFilter (in pngHeader: header, inout string: pixelData) is func
  local
    var integer: line is 0;
  begin
    for line range pred(header.height) downto 0 do
      setPngFilter(header, pixelData, line);
    end for;
  end func;


const func string: genPngChunk (in string: chunkType, in string: chunkData) is
  return bytes(length(chunkData), UNSIGNED, BE, 4) &
         chunkType & chunkData &
         bytes(integer(crc32(chunkType & chunkData)), UNSIGNED, BE, 4);


(**
 *  Converts a pixmap into a string in PNG format.
 *  @param pixmap Pixmap to be converted.
 *  @return a string with data in PNG format.
 *)
const func string: str (in PRIMITIVE_WINDOW: pixmap, PNG) is func
  result
    var string: stri is PNG_MAGIC;
  local
    var pngHeader: header is pngHeader.value;
    var pixelImage: image is pixelImage.value;
    var string: pixelData is "";
  begin
    header.width  := width(pixmap);
    header.height := height(pixmap);
    header.bitDepth          := 8;
    header.colorType         := PNG_COLOR_TYPE_RGB;
    header.compressionMethod := 0;
    header.filterMethod      := 0;
    header.interlaceMethod   := 0;
    header.bytesPerPixel     := 3;  # RGB
    header.bytesPerScanline  := succ(header.width * header.bytesPerPixel);
    image := getPixelImage(pixmap);
    pixelData := imageToPixelData(image);
    setPngFilter(header, pixelData);
    stri &:= genPngChunk("IHDR", str(header)) &
             genPngChunk("IDAT", gzcompress(pixelData)) &
             genPngChunk("IEND", "");
  end func;


const proc: writePng (in string: pngFileName, in PRIMITIVE_WINDOW: pixmap) is func
  local
    var file: pngFile is STD_NULL;
  begin
    pngFile := open(pngFileName, "w");
    if pngFile <> STD_NULL then
      write(pngFile, str(pixmap, PNG));
      close(pngFile);
    end if;
  end func;