"

 COPYRIGHT (c) 1988 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.

"

"{ Package: 'stx:libbasic' }"

Magnitude subclass:#Character

	instanceVariableNames:'asciivalue'

	classVariableNames:'CharacterTable'

	poolDictionaries:''

	category:'Magnitude-General'

!

!Character class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1988 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

"

    This class represents characters.

    Notice, that actual character objects are not used when characters

    are stored in strings, symbols or twoByteStrings; these only store

    a characters asciiValue for a more compact representation.

    The word 'asciiValue' is a historic leftover - actually, any integer

    code is allowed (i.e. characters are not limited to 8bit).

    Single byte Characters are unique; 

    i.e. for every asciiValue (0..255) there exists exactly one instance of 

    Character, which is shared (Character value:xxx checks for this, and returns 

    a reference to an existing instance).

    Other characters (i.e. asciivalue > 255) are not shared; i.e. these

    are created as required.

    This means: you may compare characters using #== ONLY IFF you are certain,

    that the characters ranges is 0..255. Otherwise, you HAVE TO compare

    using #=. (if in doubt, always compare using #=).

    Sorry for this inconvenience, but it is (practically) impossible to keep

    the possible maximum of 2^32 characters (Unicode) around, for that

    convenience alone.

    Methods marked as (JS) come from the manchester Character goody

    (CharacterComparing) by Jan Steinman, which allow Characters to be used as

    Interval elements (i.e. ($a to:$z) do:[...] ); 

    They are not a big deal, but convenient add-ons.

    Some of these have been modified a bit.

    WARNING: characters are known by compiler and runtime system -

	     do not change the instance layout. 

    Also, although you can create subclasses of Character, the compiler always

    creates instances of Character for literals ...

    ... and other classes are hard-wired to always return instances of characters

    in some cases (i.e. String>>at:, Symbol>>at: etc.).

    Therefore, it may not make sense to create a character-subclass.

    [author:]

	Claus Gittinger

    [see also:]

	String TwoByteString

	StringCollection

"

! !

!Character class methodsFor:'instance creation'!

basicNew

    "catch new - Characters cannot be created with new"

    ^ self error:'Characters cannot be created with new'

!

digitValue:anInteger

    "return a character that corresponds to anInteger.

     0-9 map to $0-$9, 10-35 map to $A-$Z"

    |val "{ Class: SmallInteger }" |

    val := anInteger.

    (val between:0 and:9) ifTrue:[

	^ Character value:(val + ($0 asciiValue))

    ].

    (val between:10 and:35) ifTrue:[

	^ Character value:(val + ($A asciiValue - 10))

    ].

    ^self error:'value not in range 0 to 35'

!

utf8DecodeFrom:aStream

    "read and return a single unicode character from an UTF8 encoded stream"

    |fetchNext c1 c2 c3 c4 c5 ascii|

    c1 := aStream next.

    ascii := c1 asciiValue.

    ascii <= 16r7F ifTrue:[

        "/ 0xxxxxxx - 7 bits   

        ^ c1.

    ].

    (ascii bitAnd:2r11000000) == 2r10000000 ifTrue:[

        "/ out of sync (got an intermediate character)

        self error:'out of sync'.

        ^ c1.

    ].

    fetchNext := [  |ch|

                    ch := aStream next.

                    (ch asciiValue bitAnd:2r11000000) == 2r10000000 ifFalse:[

                        "/ followup chars must have 2r10 in high bits

                        self error:'bad encoding'.

                    ].

                    ch

                 ].

    (ascii bitAnd:2r11100000) == 2r11000000 ifTrue:[

        "/ 110xxxxx 10xxxxxx - 11 bits

        c2 := fetchNext value.

        ascii := c1 asciiValue bitAnd:16r1F.

        ascii := (ascii bitShift:6) bitOr:(c2 asciiValue bitAnd:16r3F).

        ascii <= 16r7F ifTrue:[

            self error:'invalid encoding'.

        ].

        ^ Character value:ascii        

    ].

    (ascii bitAnd:2r11110000) == 2r11100000 ifTrue:[

        "/ 1110xxxx 10xxxxxx 10xxxxxx - 16 bits

        c2 := fetchNext value.

        c3 := fetchNext value.

        ascii := c1 asciiValue bitAnd:16r0F.

        ascii := (ascii bitShift:6) bitOr:(c2 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c3 asciiValue bitAnd:16r3F).

        ascii <= 16r7FF ifTrue:[

            self error:'invalid encoding'.

        ].

        ^ Character value:ascii        

    ].

    "/ notice: currently, characters can only have 16bit encoding;

    "/ therefore the following will raise a runtime exception,

    (ascii bitAnd:2r11111000) == 2r11110000 ifTrue:[

        "/ 11110xxx 10xxxxxx 10xxxxxx 10xxxxxx - 21 bits

        c2 := fetchNext value.

        c3 := fetchNext value.

        c4 := fetchNext value.

        ascii := c1 asciiValue bitAnd:16r07.

        ascii := (ascii bitShift:6) bitOr:(c2 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c3 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c4 asciiValue bitAnd:16r3F).

        ascii <= 16rFFFF ifTrue:[

            self error:'invalid encoding'.

        ].

        ^ Character value:ascii        

    ].

    (ascii bitAnd:2r11111100) == 2r11111000 ifTrue:[

        "/ 111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx - 26 bits

        c2 := fetchNext value.

        c3 := fetchNext value.

        c4 := fetchNext value.

        c5 := fetchNext value.

        ascii := c1 asciiValue bitAnd:16r03.

        ascii := (ascii bitShift:6) bitOr:(c2 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c3 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c4 asciiValue bitAnd:16r3F).

        ascii := (ascii bitShift:6) bitOr:(c5 asciiValue bitAnd:16r3F).

        ascii <= 16r1FFFFF ifTrue:[

            self error:'invalid encoding'.

        ].

        ^ Character value:ascii        

    ].

    (ascii bitAnd:2r11111110) == 2r11111100 ifTrue:[

        "/ 1111110x ... 10xxxxxx - any number of bits

        ascii := c1 asciiValue bitAnd:16r01.

        c2 := aStream peek.

        [ (c2 asciiValue bitAnd:2r11000000) == 2r10000000 ] whileTrue:[

            ascii := (ascii bitShift:6) bitOr:(c2 asciiValue bitAnd:16r3F).

            aStream next.

        ].

        ascii <= 16r3FFFFFF ifTrue:[

            self error:'invalid encoding'.

        ].

        ^ Character value:ascii        

    ].

    self error:'bad encoding'.

    ^ c1

    "

      Character utf8DecodeFrom:'a' readStream     

      Character utf8DecodeFrom:#[195 188] asString readStream   

    "                                            

    "test:

      |utf8Encoding original readBack|

      1 to:16rFFFF do:[:ascii |

        original := Character value:ascii.

        utf8Encoding := original asString utf8Encoded.

        readBack := Character utf8DecodeFrom:(utf8Encoding readStream).

        readBack asciiValue = ascii ifFalse:[

            self halt

        ]

      ]

    "

!

value:anInteger

    "return a character with asciivalue anInteger"

%{  /* NOCONTEXT */

    INT ascii;

    if (__isSmallInteger(anInteger)) {

	ascii = __intVal(anInteger);

	if ((ascii & ~0xFF) == 0 /* (ascii >= 0) && (ascii <= 255) */)

	    RETURN ( __MKCHARACTER(ascii) );

    }

%}.

    (anInteger between:0 and:16rFF) ifTrue:[

	^ CharacterTable at:(anInteger + 1)

    ].

    (anInteger between:16r100 and:16rFFFF) ifTrue:[

	^ super basicNew setAsciiValue:anInteger

    ].

    "

     a characters ascii-code must be 0..16rFFFF.

     (i.e. only single-byte and twoByte characters are allowed.)

    "

    self error:'invalid ascii code for character'

! !

!Character class methodsFor:'Compatibility - ANSI'!

codePoint:asciiValue

    ^ self value:asciiValue

! !

!Character class methodsFor:'accessing untypeable characters'!

endOfInput

	"Answer the Character representing ctrl-d ."

	^self value: 4

!

leftParenthesis

	"Answer the Character representing a left parenthesis."

	^self value: 40

!

period

	"Answer the Character representing a carriage period."

	^self value: 46

!

poundSign

	"Answer the Character representing a pound sign."

	^self value: 35

!

rightParenthesis

	"Answer the Character representing a right parenthesis."

	^self value: 41

! !

!Character class methodsFor:'constants'!

backspace

    "return the backspace character"

    ^ Character value:8

!

bell

    "return the bell character"

    ^ Character value:7

!

cr

    "return the lineEnd character 

     - actually (in unix) this is a newline character"

    ^ Character value:10

!

del 

    "return the delete character"

    ^ Character value:16r7F 

!

doubleQuote

    "return the double-quote character"

    ^ Character value:34

!

esc

    "return the escape character"

    ^ Character value:27

!

excla

    "return the exclamation-mark character"

    ^ $!!

!

ff

    "return the form-feed character"

    ^ Character value:12

!

lf

    "return the newline/linefeed character"

    ^ Character value:10

!

linefeed

    "squeak compatibility: return the newline/linefeed character"

    ^ Character value:10

!

maxValue 

    "return the maximum asciiValue a character can have"

    ^ 16rFFFF

!

newPage

    "return the form-feed character"

    ^ Character value:12

!

nl

    "return the newline character"

    ^ Character value:10

!

null

    ^ Character value:0

!

quote

    "return the single-quote character"

    ^ Character value:39

!

return 

    "return the return character.

     In ST/X, this is different from cr - for Unix reasons."

    ^ Character value:13 

!

space

    "return the blank character"

    ^ Character value:32

!

tab

    "return the tabulator character"

    ^ Character value:9

! !

!Character class methodsFor:'primitive input'!

fromUser

    "return a character from the keyboard (C's standard input stream)

     - this should only be used for emergency evaluators and the like."

%{  /* NOCONTEXT */

    int c;

    c = getchar();

    if (c < 0) {

        RETURN (nil);

    }

    RETURN ( __MKCHARACTER(c & 0xFF) );

%}.

    ^ Stdin next

! !

!Character class methodsFor:'queries'!

allCharacters

    "added for squeak compatibility: return a collection of all chars"

    ^ CharacterTable

    "

     Character allCharacters 

    "

!

hasSharedInstances

    "return true if this class has shared instances, that is, instances

     with the same value are identical.

     False is returned here, only redefined in classes which have unified

     instances (or should be treated so)."

    ^ true

!

isBuiltInClass

    "return true if this class is known by the run-time-system.

     Here, true is returned for myself, false for subclasses."

    ^ self == Character

    "Modified: 23.4.1996 / 15:56:39 / cg"

!

separators

    "added for squeak compatibility: return a collection of separator chars"

    ^ Array 

        with:Character space

        with:Character return

        "/ with:Character cr

        with:Character tab

        with:Character lf

        with:Character ff

    "

     Character separators

    "

! !

!Character methodsFor:'Compatibility - ANSI'!

codePoint

    ^ self asciiValue

! !

!Character methodsFor:'Compatibility - Dolphin'!

isControl

    ^ self asciiValue <= 16r20

!

isHexDigit

    ^ '0123456789abcdefABCDEF' includes:self

!

isPunctuation

    ^ (asciivalue between:16r21 and:16r40)

      or:[ (asciivalue between:16r5B and:16r60)

      or:[ (asciivalue between:123 and:126)