/******************************************************************************
 * This file is part of The Unicode Tools Of Rexx (TUTOR)                     *
 * See https://rexx.epbcn.com/TUTOR/                                          *
 *     and https://github.com/JosepMariaBlasco/TUTOR                          *
 * Copyright © 2023-2025 Josep Maria Blasco <josep.maria.blasco@epbcn.com>    *
 * License: Apache License 2.0 (https://www.apache.org/licenses/LICENSE-2.0)  *
 ******************************************************************************/

/** <h3>The <code>IBM1047</code> encoding class</h3>
 *
 *  <p>
 *    The <code>IBM1047</code> class implements encoding/decoding from/to the IBM1047
 *    ("EBCDIC Open Systems Latin 1") format.
 *
 *  <p>This is a subclass of <a href="Encoding.cls.html">the Encoding class</a>.
 *    Please refer to the documentation for <a href="Encoding.cls.html">that class</a>
 *    for additional details.
 *
 *  <h4>Version history</h4>
 *
 *  <table>
 *    <tr><td><b>1.0</b><td><b>20230811</b><td>Initial release.
 *    <tr><td>          <td><b>20230816</b><td>Change the buffers from strings to mutablebuffer, as per Rony's suggestion
 *    <tr><td><b>1.1</b><td><b>20230926</b><td>JMB</td><td>Change classfile name to IBM1047 as per IANA
 *                                                         https://www.iana.org/assignments/character-sets/character-sets.xhtml
 *  </table>
 *
 *  @see https://www.iana.org/assignments/charset-reg/IBM1047
 *
 */


.Encoding~register(.IBM1047) -- Honor the contract with the .Encoding superclass

::Class IBM1047 Subclass Encoding Public
::Constant name                  "IBM1047"
::Constant aliases               "IBM-1047 1047"
::Constant isFixedLength         1
::Constant bytesPerChar          1
::Constant maxBytesPerChar       1
::Constant endOfLine             "15"X
::Constant alternateEndOfLine    ""
::Constant useAlternateEndOfLine 0
::Constant endOfLineAlignment    1


/**
 *  <p>The <code>activate</code> class method is automatically called at the end
 *  of the class construction. It creates two tables suitable for the TRANSLATE BIF.
 *  These are generated by IBM1047.rex in the "build" subdirectory.
 *
 *  <p>See https://www.iana.org/assignments/charset-reg/IBM1047
 *  for details.
 *
 */

::Method activate class
  Use Local

  encode = '000102039C09867F978D8E0B0C0D0E0F101112139D8508871819928F1C1D1E1F80818283840A171B88898A8B8C050607909116939495960498999A9B14159E1A20A0E2E4E0E1E3E5E7F1A22E3C282B7C26E9EAEBE8EDEEEFECDF21242A293B5E2D2FC2C4C0C1C3C5C7D1A62C255F3E3FF8C9CACBC8CDCECFCC603A2340273D22D8616263646566676869ABBBF0FDFEB1B06A6B6C6D6E6F707172AABAE6B8C6A4B57E737475767778797AA1BFD05BDEAEACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D77B414243444546474849ADF4F6F2F3F57D4A4B4C4D4E4F505152B9FBFCF9FAFF5CF7535455565758595AB2D4D6D2D3D530313233343536373839B3DBDCD9DA9F'X
  decode = '00010203372D2E2F1605250B0C0D0E0F101112133C3D322618193F271C1D1E1F405A7F7B5B6C507D4D5D5C4E6B604B61F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D79818283848586878889919293949596979899A2A3A4A5A6A7A8A9C04FD0A107202122232415061728292A2B2C090A1B30311A333435360838393A3B04143EFF41AA4AB19FB26AB5BBB49A8AB0CAAFBC908FEAFABEA0B6B39DDA9B8BB7B8B9AB6465626663679E687471727378757677AC69EDEEEBEFECBF80FDFEFBFCBAAE594445424643479C4854515253585556578C49CDCECBCFCCE170DDDEDBDC8D8EDF'X

/**
 * IBM1047 encoding will fail, unless the argument string contains
 * only characters that can be represented in IBM1047.
 */

::Method encode Class
  Expose encode -- Built by the "activate" method

  Use Strict Arg string, option = ""

  utf32 = self~prepareEncode(string, option)

  If string == "" Then Return ""

  syntax = Upper(option) = "SYNTAX"

  res = .MutableBuffer~new -- Will hold the result
  Do i = 1 To Length(utf32) By 4
    code = Strip(utf32[i,4],"L","00"X)
    If code == "" Then enc = "00"X -- "00"X --> "00"X
    Else If Length(code) == 1 Then
      enc = Translate(code,XRange("00"x,"FF"x),encode)
    Else
      If Syntax Then
        Raise Syntax 23.900 Additional("Cannot encode Unicode codepoint U+"code" to IBM1047")
      Else Return ""
    res~append( enc )
  End

  Return res~string

/*
 * IBM1047 decoding always succeeds (i.e., there is no such thing as a badly
 * encoded IBM1047 sequence).
 */
::Method decode Class
  Expose decode -- Built by the "activate" method

  Use Strict Arg string, format = "", errorHandling = ""

  -- Check that the supplied arguments are OK, and raise a Syntax condition if not
  Parse Value self~checkDecodeOptions(format,errorHandling) With errorHandling returnUTF8 returnUTF32

  -- Null strings always decode to the null string.
  If string == "" Then Signal StringIsEmpty

  -- Will hold the utf8 value, if needed
  utf8  = .MutableBuffer~new

  -- Will hold the utf32 value, if needed
  utf32 = .MutableBuffer~new

  -- Validation only
  If \returnUTF8, \returnUTF32 Then Return 1

  -- Do we want some real decoding after all
  translated = Translate(string,XRange("00"x,"FF"x),decode)
  Do i = 1 To Length(string)
    code = translated[i]
    If returnUTF8  Then Do
      If code <= "7F"X Then utf8~append( code )
      Else Do
        b = X2B("00"C2X(code))
        utf8~append( X2C(B2X("110"SubStr(b,6,5)"10"Right(b,6))) )
      End
    End
    If returnUTF32 Then utf32~append( "000000"x || code )
  End
  Signal StringIsGood

StringIsGood:
  If returnUTF8 , returnUTF32  Then Do
    -- Several targets. Return a stem.
    s. = .Stem~new()
    s.["UTF8"]  = utf8  ~string
    s.["UTF32"] = utf32 ~string
    Return s.
  End
  If returnUTF8  Then Return utf8 ~string
  If returnUTF32 Then Return utf32~string
  -- Validation only
  Return 1

StringIsEmpty:
  If returnUTF8 , returnUTF32  Then Do
    -- Several targets. Return a stem.
    s. = .Stem~new()
    s.["UTF8"]  = ""
    s.["UTF32"] = ""
    Return s.
  End
  If returnUTF8 | returnUTF32  Then Return ""
  -- Validation only
  Return 1