"

 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 etc;

    these only store a character's asciiValue/codePoint for a more compact representation.

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

    code is allowed and actually used (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 guaranteed to be shared;

    i.e. these might be created as required (actually, do NOT depend on which characters are and

    which are not shared; always compare using #= if there is any chance of a non-ascii character

    being involved.

    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.

    Case Mapping in Unicode:

	There are a number of complications to case mappings that occur once the repertoire

	of characters is expanded beyond ASCII.

	* Because of the inclusion of certain composite characters for compatibility,

	  such as U+01F1 'DZ' capital dz, there is a third case, called titlecase,

	  which is used where the first letter of a word is to be capitalized

	  (e.g. Titlecase, vs. UPPERCASE, or lowercase).

	  For example, the title case of the example character is U+01F2 'Dz' capital d with small z.

	* Case mappings may produce strings of different length than the original.

	  For example, the German character U+00DF small letter sharp s expands when uppercased to

	  the sequence of two characters 'SS'.

	  This also occurs where there is no precomposed character corresponding to a case mapping.

	  *** This is not yet implemented (in 5.2) ***

	* Characters may also have different case mappings, depending on the context.

	  For example, U+03A3 capital sigma lowercases to U+03C3 small sigma if it is not followed

	  by another letter, but lowercases to 03C2 small final sigma if it is.

	  *** This is not yet implemented (in 5.2) ***

	* Characters may have case mappings that depend on the locale.

	  For example, in Turkish the letter 0049 'I' capital letter i lowercases to 0131 small dotless i.

	  *** This is not yet implemented (in 5.2) ***

	* Case mappings are not, in general, reversible.

	  For example, once the string 'McGowan' has been uppercased, lowercased or titlecased,

	  the original cannot be recovered by applying another uppercase, lowercase, or titlecase operation.

    Collation Sequence:

	*** This is not yet implemented (in 5.2) ***

    [author:]

	Claus Gittinger

    [see also:]

	String TwoByteString Unicode16String Unicode32String

	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 codePoint))

    ].

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

	^ Character value:(val + ($A codePoint - 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 codePoint.

    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 codePoint 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 codePoint bitAnd:16r1F.

	ascii := (ascii bitShift:6) bitOr:(c2 codePoint 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 codePoint bitAnd:16r0F.

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

	ascii := (ascii bitShift:6) bitOr:(c3 codePoint 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 codePoint bitAnd:16r07.

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

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

	ascii := (ascii bitShift:6) bitOr:(c4 codePoint 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 codePoint bitAnd:16r03.

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

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

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

	ascii := (ascii bitShift:6) bitOr:(c5 codePoint 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 codePoint bitAnd:16r01.

	c2 := aStream peek.

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

	    ascii := (ascii bitShift:6) bitOr:(c2 codePoint 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 codePoint = ascii ifFalse:[

	    self halt

	]

      ]

    "

!

value:anInteger

    "return a character with asciivalue anInteger"

%{  /* NOCONTEXT */

    INT __codePoint;

    if (__isSmallInteger(anInteger)) {

	__codePoint = __smallIntegerVal(anInteger);

	if ((unsigned)(__codePoint) <= MAX_IMMEDIATE_CHARACTER /* (__codePoint >= 0) && (__codePoint <= 255) */) {

	    RETURN ( __MKCHARACTER(__codePoint) );

	}

    }

%}.

    (anInteger between:0 and:(CharacterTable size - 1)) ifTrue:[

	^ CharacterTable at:(anInteger + 1)

    ].

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

	^ super basicNew setCodePoint:anInteger

    ].

    "

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

     (i.e. only characters with up-to 30 bits 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

!

euro

    "The Euro currency sign (notice: not all fonts support it).

     Thats the ascii-character code; the Unicode encoding is 0x8364"

    ^ Character value: 16r20AC

    "

     Transcript font:(Font family:'courier' size:18 encoding:'iso10646-1').

     Transcript showCR:Character euro asString

    "

    "

     0 to:255 do:[:i |

	Transcript

	    show:'| '; show:((i printStringRadix:16) leftPaddedTo:2);

	    show:' | '; show:(i printStringPaddedTo:3);

	    show:' | '; show:(Character value:i);

	    cr.

     ]

    "

!

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'!