(********************************************************************)
(*                                                                  *)
(*  ppm.s7i       Support for PPM (portable pixmap) image 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 "scanfile.s7i";
include "bytedata.s7i";
include "draw.s7i";
include "keybd.s7i";
include "pixelimage.s7i";


const string: PPM_ASCII_MAGIC  is "P3";
const string: PPM_BINARY_MAGIC is "P6";


const proc: readPpmAsciiImage (inout pixelImage: image,
    in integer: height, in integer: width, in integer: maximumColorValue,
    inout file: ppmFile) is func
  local
    var integer: factor is 0;
    var integer: line is 0;
    var integer: column is 0;
    var integer: redLight is 0;
    var integer: greenLight is 0;
    var integer: blueLight is 0;
  begin
    factor := pred(2 ** 16) div maximumColorValue;
    for line range 1 to height do
      for column range 1 to width do
        skipWhiteSpace(ppmFile);
        redLight := integer(getDigits(ppmFile)) * factor;
        skipWhiteSpace(ppmFile);
        greenLight := integer(getDigits(ppmFile)) * factor;
        skipWhiteSpace(ppmFile);
        blueLight := integer(getDigits(ppmFile)) * factor;
        image[line][column] := rgbPixel(redLight, greenLight, blueLight);
      end for;
    end for;
  end func;


const proc: readPpmBinaryImageLine8 (inout pixelArray: imageLine,
    in integer: width, in integer: factor, inout file: ppmFile) is func
  local
    var string: pixelData is "";
    var integer: byteIndex is 1;
    var integer: column is 0;
  begin
    pixelData := gets(ppmFile, width * 3);
    for column range 1 to width do
      imageLine[column] := rgbPixel(ord(pixelData[byteIndex]) * factor,
                                    ord(pixelData[succ(byteIndex)]) * factor,
                                    ord(pixelData[byteIndex + 2]) * factor);
      byteIndex +:= 3;
    end for;
  end func;


const proc: readPpmBinaryImageLine16 (inout pixelArray: imageLine,
    in integer: width, in integer: factor, inout file: ppmFile) is func
  local
    var string: pixelData is "";
    var integer: byteIndex is 1;
    var integer: column is 0;
  begin
    pixelData := gets(ppmFile, width * 6);
    for column range 1 to width do
      imageLine[column] :=
          rgbPixel(bytes2Int(pixelData[byteIndex     fixLen 2], UNSIGNED, BE) * factor,
                   bytes2Int(pixelData[byteIndex + 2 fixLen 2], UNSIGNED, BE) * factor,
                   bytes2Int(pixelData[byteIndex + 4 fixLen 2], UNSIGNED, BE) * factor);
      byteIndex +:= 6;
    end for;
  end func;


const proc: readPpmBinaryImage (inout pixelImage: image,
    in integer: height, in integer: width, in integer: maximumColorValue,
    inout file: ppmFile) is func
  local
    var integer: factor is 0;
    var integer: line is 0;
  begin
    factor := pred(2 ** 16) div maximumColorValue;
    if maximumColorValue <= 255 then
      for line range 1 to height do
        readPpmBinaryImageLine8(image[line], width, factor, ppmFile);
      end for;
    else
      for line range 1 to height do
        readPpmBinaryImageLine16(image[line], width, factor, ppmFile);
      end for;
    end if;
  end func;


(**
 *  Reads a PPM (portable pixmap) image file into a pixmap.
 *  @param ppmFile File that contains a PPM image.
 *  @return A pixmap with the PPM image, or
 *          PRIMITIVE_WINDOW.value if the file does
 *          not contain a PPM magic number.
 *  @exception RANGE_ERROR The file is not in the PPM file format.
 *)
const func PRIMITIVE_WINDOW: readPpm (inout file: ppmFile) is func
  result
    var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
  local
    var string: magic is "";
    var integer: width is 0;
    var integer: height is 0;
    var integer: maximumColorValue is 0;
    var pixelImage: image is pixelImage.value;
  begin
    magic := gets(ppmFile, length(PPM_ASCII_MAGIC));
    if magic = PPM_ASCII_MAGIC or magic = PPM_BINARY_MAGIC then
      ppmFile.bufferChar := getc(ppmFile);
      skipWhiteSpace(ppmFile);
      while ppmFile.bufferChar = '#' do
        skipLineComment(ppmFile);
        ppmFile.bufferChar := getc(ppmFile);
        skipWhiteSpace(ppmFile);
      end while;
      width := integer(getDigits(ppmFile));
      skipWhiteSpace(ppmFile);
      while ppmFile.bufferChar = '#' do
        skipLineComment(ppmFile);
        ppmFile.bufferChar := getc(ppmFile);
        skipWhiteSpace(ppmFile);
      end while;
      height := integer(getDigits(ppmFile));
      skipWhiteSpace(ppmFile);
      while ppmFile.bufferChar = '#' do
        skipLineComment(ppmFile);
        ppmFile.bufferChar := getc(ppmFile);
        skipWhiteSpace(ppmFile);
      end while;
      maximumColorValue := integer(getDigits(ppmFile));
      image := pixelImage[.. height] times
               pixelArray[.. width] times pixel.value;
      if magic = PPM_ASCII_MAGIC then
        readPpmAsciiImage(image, height, width, maximumColorValue,
                          ppmFile);
      else
        readPpmBinaryImage(image, height, width, maximumColorValue,
                           ppmFile);
      end if;
      pixmap := getPixmap(image);
    end if;
  end func;


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


(**
 *  Converts a pixmap into a string in PPM format.
 *  @param pixmap Pixmap to be converted.
 *  @return a string with data in PPM format.
 *)
const func string: str (in PRIMITIVE_WINDOW: pixmap, PPM) is func
  result
    var string: stri is PPM_BINARY_MAGIC;
  local
    var integer: height is 0;
    var integer: width is 0;
    var pixelImage: image is pixelImage.value;
    var integer: line is 0;
    var pixel: pix is pixel.value;
    var color: col is color.value;
  begin
    height := height(pixmap);
    width := width(pixmap);
    stri &:= "\n" <& width <& " " <& height <& "\n255\n";
    image := getPixelImage(pixmap);
    for line range 1 to height do
      for pix range image[line] do
        col := pixelToColor(pix);
        stri &:= chr(col.redLight   mdiv 256);
        stri &:= chr(col.greenLight mdiv 256);
        stri &:= chr(col.blueLight  mdiv 256);
      end for;
    end for;
  end func;


const proc: writePpm (in string: ppmFileName, in PRIMITIVE_WINDOW: pixmap) is func
  local
    var file: ppmFile is STD_NULL;
  begin
    ppmFile := open(ppmFileName, "w");
    if ppmFile <> STD_NULL then
      write(ppmFile, str(pixmap, PPM));
      close(ppmFile);
    end if;
  end func;