"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

ByteArray subclass:#CharacterArray

	instanceVariableNames:''

	classVariableNames:'PreviousMatch DecoderTables EncoderTables'

	poolDictionaries:''

	category:'Collections-Text'

!

!CharacterArray class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1994 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    CharacterArray is a superclass for all kinds of Strings (i.e.

    (singleByte-)Strings, TwoByteStrings and whatever comes in the future.

    As the name already implies, this class is abstract, meaning that there are

    no instances of it. All this class does is provide common protocol for 

    concrete subclasses.

"

! !

!CharacterArray class methodsFor:'instance creation'!

basicNew

    "return a new empty string"

    ^ self basicNew:0

!

fromString:aString

    "return a copy of the argument, aString"

    ^ (self basicNew:(aString size)) replaceFrom:1 with:aString

    "TwoByteString fromString:'hello'"

!

fromStringCollection:aCollectionOfStrings

    "return new string formed by concatenating a copy of the argument, aString"

    ^ self fromStringCollection:aCollectionOfStrings separatedBy:''

    "

     String fromStringCollection:#('hello' 'world' 'how' 'about' 'this')

    "

    "Created: 20.11.1995 / 15:26:59 / cg"

!

fromStringCollection:aCollectionOfStrings separatedBy:aSeparatorString

    "return new string formed by concatenating a copy of the argument, aString"

    |newString first|

    newString := ''.

    first := true.

    aCollectionOfStrings do:[:s | 

	first ifFalse:[

	    newString := newString , aSeparatorString

	] ifTrue:[

	    first := false

	].

	newString := newString , s

    ].

    ^ newString

    "

     String fromStringCollection:#('hello' 'world' 'how' 'about' 'this') separatedBy:' '

    "

    "Created: 20.11.1995 / 15:32:17 / cg"

!

new

    "return a new empty string"

    ^ self basicNew:0

! !

!CharacterArray class methodsFor:'cleanup'!

lowSpaceCleanup

    "cleanup in low-memory situations"

    DecoderTables := EncoderTables := nil

    "

     CharacterArray lowSpaceCleanup

    "

    "Created: 22.2.1996 / 16:30:30 / cg"

    "Modified: 22.2.1996 / 17:58:05 / cg"

! !

!CharacterArray class methodsFor:'code tables'!

classForEncoding:encodingSymbol

    "return a class capable of representing text encoded

     by encodingSymbol"

    encodingSymbol == #jis ifTrue:[^ JISEncodedString].

    encodingSymbol == #big5 ifTrue:[^ BIG5EncodedString].

    encodingSymbol == #gb ifTrue:[^ GBEncodedString].

    "/

    "/ assume its an 8-bit code

    "/

    ^ String

    "Modified: 17.4.1996 / 16:18:53 / cg"

!

decoderTableFor:encoding

    "return a table to decode from an alien encoding into

     the internal (iso8859, ansi) format.

     This is an experimental interface - unfinished"

    |table|

    DecoderTables notNil ifTrue:[

        table := DecoderTables at:encoding ifAbsent:nil.

        table notNil ifTrue:[^ table].

    ] ifFalse:[

        DecoderTables := IdentityDictionary new

    ].

    table := (0 to:255) asByteArray.

    "/

    "/ mac -> iso8859

    "/

    encoding == #mac ifTrue:[

        table at:8r232+1 put:246. "/ german umlaut o (mac: 154; 8859: 246)

        table at:8r212+1 put:228. "/ german umlaut a (mac: 138; 8859: 228)

        table at:8r237+1 put:252. "/ german umlaut u (mac: 159; 8859: 252)

        table at:8r206+1 put:220. "/ german umlaut U (mac: 134; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ postscript -> iso8859

    "/

    encoding == #postscript ifTrue:[

        table at:8r224+1 put:246. "/ german umlaut o (ps: 148; 8859: 246)

        table at:8r204+1 put:228. "/ german umlaut a (ps: 132; 8859: 228)

        table at:8r201+1 put:252. "/ german umlaut u (ps: 129; 8859: 252)

        table at:8r231+1 put:214. "/ german umlaut O (ps: 153; 8859: 214)

        table at:8r216+1 put:196. "/ german umlaut A (ps: 142; 8859: 196)

        table at:8r232+1 put:220. "/ german umlaut U (ps: 154; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ msdos -> iso8859

    "/

    encoding == #msdos ifTrue:[

        table at:16r82+1 put:16re9. "/ french e degu    (dos: 82; 8859: e9)

        table at:16r8a+1 put:16re8. "/ french e graph   (dos: 8a; 8859: e8)

        table at:16r88+1 put:16rea. "/ french e circ.   (dos: 88; 8859: ea)

        table at:16r8c+1 put:16ree. "/ french u circ.   (dos: 8c; 8859: ee)

        table at:16r87+1 put:16re7. "/ french c cedille (dos: 87; 8859: e7)

        table at:16r85+1 put:16re0. "/ french a degu    (dos: 85; 8859: e0)

"/        table at:8r224+1 put:246. "/ german umlaut o (ps: 148; 8859: 246)

"/        table at:8r204+1 put:228. "/ german umlaut a (ps: 132; 8859: 228)

"/        table at:8r201+1 put:252. "/ german umlaut u (ps: 129; 8859: 252)

"/        table at:8r231+1 put:214. "/ german umlaut O (ps: 153; 8859: 214)

"/        table at:8r216+1 put:196. "/ german umlaut A (ps: 142; 8859: 196)

"/        table at:8r232+1 put:220. "/ german umlaut U (ps: 154; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/ more encodings needed here ....

    DecoderTables at:encoding put:table.

    ^ table

    "

     DecoderTables := nil

    "

    "Created: 20.10.1995 / 23:04:43 / cg"

    "Modified: 22.2.1996 / 17:19:38 / cg"

!

encoderTableFor:encoding

    "return a table to encode from the internal (iso8859, ansi) format

     into an alien encoding.

     This is an experimental interface - unfinished"

    |table|

    EncoderTables notNil ifTrue:[

        table := EncoderTables at:encoding ifAbsent:nil.

        table notNil ifTrue:[^ table].

    ] ifFalse:[

        EncoderTables := IdentityDictionary new

    ].

    table := (0 to:255) asByteArray.

    "/

    "/ iso8859 -> mac

    "/

    encoding == #mac ifTrue:[

        table at:246+1 put:8r232. "/ german umlaut o (mac: 154; 8859: 246)

        table at:228+1 put:8r212. "/ german umlaut a (mac: 138; 8859: 228)

        table at:252+1 put:8r237. "/ german umlaut u (mac: 159; 8859: 252)

        table at:220+1 put:8r206. "/ german umlaut U (mac: 134; 8859: 220)

        "/ more needed here - need info to do it ....

    ].

    "/

    "/ iso8859 -> msdos

    "/

    encoding == #msdos ifTrue:[

        table at:233+1 put:8r202. "/ french e accent degu  (dos: 130; 8859: 233)

        table at:232+1 put:8r212. "/ french e accent graph (dos: 138; 8859: 232)

        table at:234+1 put:8r210. "/ french e accent circ. (dos: 136; 8859: 234)

        table at:238+1 put:8r214. "/ french u accent circ. (dos: 140; 8859: 238)

        table at:231+1 put:8r207. "/ french c cedille      (dos: 135; 8859: 231)

        table at:16re9+1 put:16r82. "/ french e degu    (dos: 82; 8859: e9)

        table at:16re8+1 put:16r8a. "/ french e graph   (dos: 8a; 8859: e8)

        table at:16rea+1 put:16r88. "/ french e circ.   (dos: 88; 8859: ea)

        table at:16ree+1 put:16r8c. "/ french u circ.   (dos: 8c; 8859: ee)

        table at:16re7+1 put:16r87. "/ french c cedille (dos: 87; 8859: e7)

        table at:16re0+1 put:16r85. "/ french a degu    (dos: 85; 8859: e0)

        "/ more needed here - need info to do it ....

    ].

    "/ more encodings needed here ....

    EncoderTables at:encoding put:table.

    ^ table

    "

     EncoderTables := nil

    "

    "Created: 22.2.1996 / 16:17:58 / cg"

    "Modified: 22.2.1996 / 17:21:13 / cg"

!

supportedEncodings

    "/ the first row gives the external (names);

    "/ the second the internally used symbol.

    "/ you may map more than one external name onto the same internal

    ^ #( 

         ('DOS' 'MAC' 'EUC' 'JIS' 'JIS7' 'GB' 'BIG5')

         (msdos  mac   euc   jis   jis7   gb   big5)

       )

    "Created: 22.2.1996 / 16:19:20 / cg"

    "Modified: 17.4.1996 / 16:18:28 / cg"

! !

!CharacterArray class methodsFor:'encoding / decoding'!

decodeFromBIG5:aString

    "return a new string containing the characters from aString,

     which is interpreted as a BIG5 encoded singleByte string.

     The result is a Big5EncodedString (you need a BIG5 font to display that ...)."

    |newString|

    newString := BIG5EncodedString new:aString size.

    newString := self decodeFromBIG5_or_GB:aString into:newString.

'b5 (' print. aString print. ' -> ' print. newString printNL.

    ^ newString

    "Modified: 17.4.1996 / 18:30:29 / cg"

!

decodeFromBIG5_or_GB:aString into:a16BitString

    "return a new string containing the characters from aString,

     which is interpreted as a BIG5 encoded singleByte string.

     The result is a Big5EncodedString (you need a BIG5 font to display that ...)."

    |sz     "{ Class: SmallInteger }"

     dstIdx "{ Class: SmallInteger }"

     srcIdx "{ Class: SmallInteger }"

     b1     "{ Class: SmallInteger }"

     b2     "{ Class: SmallInteger }"

     val    "{ Class: SmallInteger }"

     c|

    sz := aString size.

    sz ~~ 0 ifTrue:[

        dstIdx := 1.

        srcIdx := 1.

        [true] whileTrue:[

            c := aString at:srcIdx.

            "/

            "/ characters below 16rA1 are left untranslated

            "/

            b1 := c asciiValue.

            b1 >= 16rA1 ifTrue:[

                srcIdx := srcIdx + 1.

                srcIdx <= sz ifTrue:[

                    b2 := (aString at:srcIdx) asciiValue.

                    val := (b1 bitShift:8) bitOr:b2.

                    c := Character value:val.

                ]

            ].

            a16BitString at:dstIdx put:c.

            dstIdx := dstIdx + 1.

            srcIdx := srcIdx + 1.

            srcIdx > sz ifTrue:[

                ^ a16BitString copyFrom:1 to:dstIdx-1.

            ]

        ]

    ].

    ^ a16BitString

    "Created: 17.4.1996 / 16:55:54 / cg"

    "Modified: 17.4.1996 / 18:28:31 / cg"

!

decodeFromEUC:aString

    "return a new string containing the characters from aString,

     which is interpreted as an EUC encoded singleByte string.

     There are various JIS encodings around (New-JIS, Old-JIS and NEC-JIS);

     this one only understands New-JIS.

     The result is a JISEncodedString (you need a JIS font to display that ...)."

    |newString 

     sz     "{ Class: SmallInteger }"

     dstIdx "{ Class: SmallInteger }"

     start  "{ Class: SmallInteger }"

     b1     "{ Class: SmallInteger }"

     b2     "{ Class: SmallInteger }"

     val    "{ Class: SmallInteger }"

     romans c|

    romans := JISEncodedString romanJISDecoderTable.

    sz := aString size.

    newString := JISEncodedString new:sz.

    sz ~~ 0 ifTrue:[

        dstIdx := 1.

        start := 1.

        [true] whileTrue:[

            c := aString at:start.

            b1 := c asciiValue.

            b1 < 33 ifTrue:[

                newString at:dstIdx put:c.

                dstIdx := dstIdx + 1.

            ] ifFalse:[

                b1 < 161 ifTrue:[

                    newString at:dstIdx put:c.

                    dstIdx := dstIdx + 1.

"/                    b1 < 127 ifTrue:[

"/                        newString at:dstIdx put:(Character value:(romans at:(b1 - 32))).

"/                        dstIdx := dstIdx + 1.

"/                    ] ifFalse:[

"/                        self halt:'unsupported codeSet'

"/                    ]

                ] ifFalse:[

                    start := start + 1.

                    b1 := b1 - 161 + 33.

                    b2 := (aString at:start) asciiValue.

                    b2 := b2 - 161 + 33.

                    val := (b1 bitShift:8) bitOr:b2.

                    newString at:dstIdx put:(Character value:val).

                    dstIdx := dstIdx + 1.

                ]

            ].

            start := start + 1.

            start > sz ifTrue:[

                ^ newString copyFrom:1 to:dstIdx-1.

            ]

        ]

    ].

    ^ newString

    "simple:

         'hello' decodeFromEUC 

    "

    "Created: 17.4.1996 / 16:10:22 / cg"

    "Modified: 17.4.1996 / 16:48:30 / cg"

!

decodeFromGB:aString

    "return a new string containing the characters from aString,

     which is interpreted as a GB encoded singleByte string.

     The result is a Big5EncodedString (you need a GB font to display that ...)."

    |newString|

    newString := GBEncodedString new:aString size.

    ^ self decodeFromBIG5_or_GB:aString into:newString

    "Created: 17.4.1996 / 16:56:33 / cg"

!

decodeFromJIS7:aString

    "return a new string containing the aStrings characters,

     which are interpreted as a JIS7 encoded singleByte string.

     There are various JIS encodings around (New-JIS, Old-JIS and NEC-JIS);

     this one understands New-JIS and treats Old-JIS just the same.

     The result is a JISEncodedString (you need a JIS font to display that ...)."

    |newString 

     sz         "{ Class: SmallInteger }"

     dstIdx     "{ Class: SmallInteger }"

     start      "{ Class: SmallInteger }"

     stop       "{ Class: SmallInteger }"

     n1 n2 n3  

     b1         "{ Class: SmallInteger }"

     b2         "{ Class: SmallInteger }"

     val        "{ Class: SmallInteger }"

     singleBytes romans|

    romans := JISEncodedString romanJISDecoderTable.

    sz := aString size.

    newString := JISEncodedString new:sz.

    sz ~~ 0 ifTrue:[

        dstIdx := 1.

        start := 1.

        singleBytes := true.

        [true] whileTrue:[

            "/

            "/ scan for next escape"

            "/

            stop := aString indexOf:(Character esc) startingAt:start.

            stop == 0 ifTrue:[

                stop := sz + 1.

            ] ifFalse:[

                (stop + 2) > sz ifTrue:[

                    stop := sz + 1.

                ]

            ].

            singleBytes ifTrue:[

                start to:(stop - 1) do:[:i |

                    b1 := (aString at:i) asciiValue.

                    newString at:dstIdx put:(Character value:b1).

"/                    (b1 < 33 or:[b1 > 191]) ifTrue:[

"/                        newString at:dstIdx put:(Character value:b1)

"/                    ] ifFalse:[

"/                        newString at:dstIdx put:(Character value:(romans at:(b1 - 32)))

"/                    ].

                    dstIdx := dstIdx + 1.

                ].

            ] ifFalse:[

                start to:(stop - 2) by:2 do:[:i |

                    b1 := (aString at:i) asciiValue.

                    b2 := (aString at:i+1) asciiValue.

                    val := (b1 bitShift:8) bitOr:b2.

                    newString at:dstIdx put:(Character value:val).

                    dstIdx := dstIdx + 1.

                ]

            ].

            stop > sz ifTrue:[

                ^ newString copyFrom:1 to:dstIdx - 1.

            ].

            start := stop.

            "/