
(********************************************************************)
(*                                                                  *)
(*  utf16.s7i     File implementation type for UTF-16 files         *)
(*  Copyright (C) 2009  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 "null_file.s7i";


const type: utf16_file is sub null_file struct
    var PRIMITIVE_FILE: ext_file is PRIMITIVE_NULL_FILE;
    var string: name is "";
  end struct;


(**
 *  Close an utf16_file.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const proc: close (in utf16_file: aFile) is func
  begin
    close(aFile.ext_file);
  end func;


(**
 *  Forces that all buffered data of ''aFile'' is sent to its destination.
 *  This causes data to be sent to the operating systems file system.
 *)
const proc: flush (in utf16_file: aFile) is func
  begin
    flush(aFile.ext_file);
  end func;


(**
 *  Determine the end-of-file indicator.
 *  The end-of-file indicator is set when at least one request to read
 *  from the file failed.
 *  @return TRUE if the end-of-file indicator is set, FALSE otherwise.
 *)
const func boolean: eof (in utf16_file: aFile) is
  return eof(aFile.ext_file);


(**
 *  Determine if at least one character can be read successfully.
 *  This function allows a file to be handled like an iterator.
 *  @return FALSE if 'getc' would return EOF, TRUE otherwise.
 *)
const func boolean: hasNext (in utf16_file: aFile) is
  return hasNext(aFile.ext_file);


(**
 *  Obtain the length of a file.
 *  The file length is measured in bytes.
 *  @return the length of a file, or 0 if it cannot be obtained.
 *  @exception RANGE_ERROR The file length is negative or does not
 *             fit into an integer value.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const func integer: length (in utf16_file: aFile) is
  return length(aFile.ext_file);


(**
 *  Set the current file position.
 *  The file position is measured in bytes from the start of the file.
 *  The first byte in the file has the position 1.
 *  @exception RANGE_ERROR The file position is negative or zero.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const proc: seek (in utf16_file: aFile, in integer: pos) is func
  begin
    seek(aFile.ext_file, pos);
  end func;


(**
 *  Obtain the current file position.
 *  The file position is measured in bytes from the start of the file.
 *  The first byte in the file has the position 1.
 *  @return the current file position.
 *  @exception RANGE_ERROR The file position is negative or does not
 *             fit into an integer value.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const func integer: tell (in utf16_file: aFile) is
  return tell(aFile.ext_file);


const type: utf16le_file is sub utf16_file struct
  end struct;


const func utf16le_file: malloc (in utf16le_file: anUtf16File) is func
  result
    var utf16le_file: newFile is utf16le_file.value;
  begin
    newFile := anUtf16File;
  end func;


(**
 *  Opens an Unicode file which uses the UTF-16LE encoding.
 *  When the file is opened with one of the modes "w", "w+", "wt" or
 *  "wt+" an appropriate BOM is created. When the file is opened
 *  with a any other mode the application program is in charge to
 *  handle optional BOM markers. This way 'open_utf16le' can be used
 *  to open existing files without BOM.
 *  @return the file opened, or STD_NULL if it could not be opened.
 *  @exception RANGE_ERROR Illegal 'mode' or 'fileName' not in
 *             standard path representation.
 *)
const func file: open_utf16le (in string: fileName, in string: mode) is func
  result
    var file: newFile is STD_NULL;
  local
    var PRIMITIVE_FILE: open_file is PRIMITIVE_NULL_FILE;
    var utf16le_file: new_le_file is utf16le_file.value;
  begin
    open_file := PRIMITIVE_FILE_OPEN(fileName, mode);
    if open_file <> PRIMITIVE_NULL_FILE then
      if mode[1 len 1] = "w" then
        write(open_file, "\16#FF\\16#FE\");
      end if;
      new_le_file.ext_file := open_file;
      new_le_file.name := fileName;
      newFile := malloc(new_le_file);
    end if;
  end func;


(**
 *  Write a string to an UTF-16LE file.
 *  @exception RANGE_ERROR A character is not representable with UTF-16.
 *  @exception FILE_ERROR The system function returns an error.
 *)
const proc: write (in utf16le_file: aFile, in string: stri) is func
  local
    var char: ch is ' ';
    var integer: number is 0;
    var char: ch1 is ' ';
    var char: ch2 is ' ';
  begin
    for ch range stri do
      if ch <= '\16#FFFF\' then
        write(aFile.ext_file, str(chr(ord(ch) mod 256)));
        write(aFile.ext_file, str(chr(ord(ch) mdiv 256)));
      elsif ch <= '\16#10FFFF\' then
        number := ord(ch) - 16#10000;
        ch1 := chr(16#D800 + (number >> 10));
        write(aFile.ext_file, str(chr(ord(ch1) mod 256)));
        write(aFile.ext_file, str(chr(ord(ch1) mdiv 256)));
        ch2 := chr(16#DC00 + (number mod 16#400));
        write(aFile.ext_file, str(chr(ord(ch2) mod 256)));
        write(aFile.ext_file, str(chr(ord(ch2) mdiv 256)));
      else
        raise RANGE_ERROR;
      end if;
    end for;
  end func;


(**
 *  Return a string read with a maximum length from an UTF-16LE file.
 *  @return the string read.
 *  @exception RANGE_ERROR The file contains an illegal surrogate pair.
 *)
const func string: gets (in utf16le_file: aFile, in integer: maxLength) is func
  result
    var string: striRead is "";
  local
    var integer: charsMissing is 0;
    var boolean: partialRead is FALSE;
    var string: stri is "";
    var string: surrogate_part is "";
    var integer: index is 0;
    var char: ch1 is ' ';
    var char: ch2 is ' ';
  begin
    charsMissing := maxLength;
    repeat
      stri := gets(aFile.ext_file, 2 * charsMissing);
      if odd(length(stri)) then
        raise RANGE_ERROR;
      elsif length(stri) <> 2 * charsMissing then
        partialRead := TRUE;
      end if;
      for index range 1 to length(stri) div 2 do
        ch1 := chr(ord(stri[index * 2]) * 256 + ord(stri[pred(index * 2)]));
        if ch1 >= '\16#D800\' and ch1 <= '\16#DBFF\' then
          # ch1 introduces a surrogate pair
          if index = length(stri) div 2 then
            surrogate_part := gets(aFile.ext_file, 2);
            if length(surrogate_part) = 2 then
              ch2 := chr(ord(surrogate_part[2]) * 256 + ord(surrogate_part[1]));
            else
              raise RANGE_ERROR;
            end if;
          else
            incr(index);
            ch2 := chr(ord(stri[index * 2]) * 256 + ord(stri[pred(index * 2)]));
          end if;
          if ch2 >= '\16#DC00\' and ch2 <= '\16#DFFF\' then
            # ch1 and ch2 are a surrogate pair
            striRead &:= str(chr((ord(ch1) - 16#D800) << 10 +
                               (ord(ch2) - 16#DC00) + 16#10000));
          else
            raise RANGE_ERROR;
          end if;
        else
          striRead &:= str(ch1);
        end if;
      end for;
      charsMissing := maxLength - length(striRead);
    until charsMissing = 0 or partialRead;
  end func;


const type: utf16be_file is sub utf16_file struct
  end struct;


const func utf16be_file: malloc (in utf16be_file: anUtf16File) is func
  result
    var utf16be_file: newFile is utf16be_file.value;
  begin
    newFile := anUtf16File;
  end func;


(**
 *  Opens an Unicode file which uses the UTF-16BE encoding.
 *  When the file is opened with one of the modes "w", "w+", "wt" or
 *  "wt+" an appropriate BOM is created. When the file is opened
 *  with a any other mode the application program is in charge to
 *  handle optional BOM markers. This way 'open_utf16be' can be used
 *  to open existing files without BOM.
 *  @return the file opened, or STD_NULL if it could not be opened.
 *  @exception RANGE_ERROR Illegal 'mode' or 'fileName' not in
 *             standard path representation.
 *)
const func file: open_utf16be (in string: fileName, in string: mode) is func
  result
    var file: newFile is STD_NULL;
  local
    var PRIMITIVE_FILE: open_file is PRIMITIVE_NULL_FILE;
    var utf16be_file: new_be_file is utf16be_file.value;
  begin
    open_file := PRIMITIVE_FILE_OPEN(fileName, mode);
    if open_file <> PRIMITIVE_NULL_FILE then
      if mode[1 len 1] = "w" then
        write(open_file, "\16#FE\\16#FF\");
      end if;
      new_be_file.ext_file := open_file;
      new_be_file.name := fileName;
      newFile := malloc(new_be_file);
    end if;
  end func;


(**
 *  Write a string to an UTF-16BE file.
 *  @exception RANGE_ERROR When a character is not representable with UTF-16.
 *  @exception FILE_ERROR The system function returns an error.
 *)
const proc: write (in utf16be_file: aFile, in string: stri) is func
  local
    var char: ch is ' ';
    var integer: number is 0;
    var char: ch1 is ' ';
    var char: ch2 is ' ';
  begin
    for ch range stri do
      if ch <= '\16#FFFF\' then
        write(aFile.ext_file, str(chr(ord(ch) mdiv 256)));
        write(aFile.ext_file, str(chr(ord(ch) mod 256)));
      elsif ch <= '\16#10FFFF\' then
        number := ord(ch) - 16#10000;
        ch1 := chr(16#D800 + (number >> 10));
        write(aFile.ext_file, str(chr(ord(ch1) mdiv 256)));
        write(aFile.ext_file, str(chr(ord(ch1) mod 256)));
        ch2 := chr(16#DC00 + (number mod 16#400));
        write(aFile.ext_file, str(chr(ord(ch2) mdiv 256)));
        write(aFile.ext_file, str(chr(ord(ch2) mod 256)));
      else
        raise RANGE_ERROR;
      end if;
    end for;
  end func;


(**
 *  Return a string read with a maximum length from an UTF-16BE file.
 *  @return the string read.
 *  @exception RANGE_ERROR The file contains an illegal surrogate pair.
 *)
const func string: gets (in utf16be_file: aFile, in integer: maxLength) is func
  result
    var string: striRead is "";
  local
    var integer: charsMissing is 0;
    var boolean: partialRead is FALSE;
    var string: stri is "";
    var string: surrogate_part is "";
    var integer: index is 0;
    var char: ch1 is ' ';
    var char: ch2 is ' ';
  begin
    charsMissing := maxLength;
    repeat
      stri := gets(aFile.ext_file, 2 * charsMissing);
      if odd(length(stri)) then
        raise RANGE_ERROR;
      elsif length(stri) <> 2 * charsMissing then
        partialRead := TRUE;
      end if;
      for index range 1 to length(stri) div 2 do
        ch1 := chr(ord(stri[pred(index * 2)]) * 256 + ord(stri[index * 2]));
        if ch1 >= '\16#D800\' and ch1 <= '\16#DBFF\' then
          # ch1 introduces a surrogate pair
          if index = length(stri) div 2 then
            surrogate_part := gets(aFile.ext_file, 2);
            if length(surrogate_part) = 2 then
              ch2 := chr(ord(surrogate_part[1]) * 256 + ord(surrogate_part[2]));
            else
              raise RANGE_ERROR;
            end if;
          else
            incr(index);
            ch2 := chr(ord(stri[pred(index * 2)]) * 256 + ord(stri[index * 2]));
          end if;
          if ch2 >= '\16#DC00\' and ch2 <= '\16#DFFF\' then
            # ch1 and ch2 are a surrogate pair
            striRead &:= str(chr((ord(ch1) - 16#D800) << 10 +
                                 (ord(ch2) - 16#DC00) + 16#10000));
          else
            raise RANGE_ERROR;
          end if;
        else
          striRead &:= str(ch1);
        end if;
      end for;
      charsMissing := maxLength - length(striRead);
    until charsMissing = 0 or partialRead;
  end func;


(**
 *  Opens an Unicode file which uses the UTF-16LE or UTF-16BE encoding.
 *  The function 'open_utf16' checks for a BOM and depending on that
 *  opens an UTF-16LE or UTF-16BE file. When the file contains no BOM
 *  the function returns STD_NULL.
 *  @return the file opened, or STD_NULL if it could not be opened.
 *  @exception RANGE_ERROR Illegal 'mode' or 'fileName' not in
 *             standard path representation.
 *)
const func file: open_utf16 (in string: fileName, in string: mode) is func
  result
    var file: newFile is STD_NULL;
  local
    var PRIMITIVE_FILE: open_file is PRIMITIVE_NULL_FILE;
    var utf16le_file: new_le_file is utf16le_file.value;
    var utf16be_file: new_be_file is utf16be_file.value;
    var string: bom is "";
  begin
    open_file := PRIMITIVE_FILE_OPEN(fileName, mode);
    if open_file <> PRIMITIVE_NULL_FILE then
      bom := gets(open_file, 2);
      if bom = "\16#FF\\16#FE\" then
        new_le_file.ext_file := open_file;
        new_le_file.name := fileName;
        newFile := malloc(new_le_file);
      elsif bom = "\16#FE\\16#FF\" then
        new_be_file.ext_file := open_file;
        new_be_file.name := fileName;
        newFile := malloc(new_be_file);
      else
        close(open_file);
      end if;
    end if;
  end func;
