"

 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.

"

Magnitude subclass:#Character

       instanceVariableNames:'asciivalue'

       classVariableNames:''

       poolDictionaries:''

       category:'Magnitude-General'

!

Character comment:'

COPYRIGHT (c) 1988 by Claus Gittinger

	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Character.st,v 1.18 1995-05-02 23:55:39 claus Exp $

'!

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

"

!

version

"

$Header: /cvs/stx/stx/libbasic/Character.st,v 1.18 1995-05-02 23:55:39 claus Exp $

"

!

documentation

"

    Single byte Characters are unique; this means that for every asciiValue (0..255) there

    is exactly one instance of Character, which is shared.

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

    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:[...] ); 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 subclass Character, the compiler creates instances of

    Character for literals and other classes return Characters hard-wired (i.e. 

    String, Symbol etc.).

"

! !

!Character class methodsFor:'instance creation'!

basicNew

    "catch new - Characters cannot be created with new"

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

!

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

    ].

    self error:'invalid ascii code for character'

!

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'

! !

!Character class methodsFor:'primitive input'!

fromUser

    "return a character from the keyboard

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

%}

! !

!Character class methodsFor:'queries'!

isBuiltInClass

    "return true, if this classes instance layout cannot be changed

     - this class is known by the run-time-system (but not subclasses)"

    ^ self == Character

! !

!Character class methodsFor:'constants'!

bell

    "return the bell character"

    ^ Character value:7

!

backspace

    "return the backspace character"

    ^ Character value:8

!

nl

    "return the newline character"

    ^ Character value:10

!

lf

    "return the newline/linefeed character"

    ^ Character value:10

!

cr

    "return the carriage-return character 

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

    ^ Character value:10

!

tab

    "return the tabulator character"

    ^ Character value:9

!

newPage

    "return the form-feed character"

    ^ Character value:12

!

ff

    "return the form-feed character"

    ^ Character value:12

!

space

    "return the blank character"

    ^ Character value:32

!

esc

    "return the escape character"

    ^ Character value:27

!

quote

    "return the single-quote character"

    ^ Character value:39

!

doubleQuote

    "return the double-quote character"

    ^ Character value:34

!

excla

    "return the exclamation-mark character"

    ^ $!!

! !

!Character methodsFor:'copying'!

copy

    "return a copy of myself

     reimplemented since characters are unique"

     ^ self

!

shallowCopy

    "return a shallow copy of myself

     reimplemented since characters are unique"

     ^ self

!

deepCopy

    "return a deep copy of myself

     reimplemented since characters are unique"

     ^ self

!

simpleDeepCopy

    "return a deep copy of myself

     reimplemented since characters are unique"

     ^ self

!

deepCopyUsing:aDictionary

    "return a deep copy of myself

     reimplemented since characters are unique"

     ^ self

! !

!Character methodsFor:'private accessing'!

setAsciiValue:anInteger

    "very private - set the ascii value. 

     - use this only for characters with codes > 16rFF.

     DANGER alert: funny things happen, if this is applied to

     one of the fixed-characters 0..255."

    asciivalue := anInteger

! !

!Character methodsFor:'accessing'!

asciiValue

    "return the asciivalue of myself.

     PP has removed this methhod with 4.1 and providing

     asInteger instead."

    ^asciivalue

!

instVarAt:index put:anObject

    "catch instvar access - asciivalue may not be changed"

    self error:'Characters may not be modified'

! !

!Character methodsFor:'comparing'!

= aCharacter

    "return true, if the argument, aCharacter is the same character

     redefined to avoid the overhead of [Object =] -> [Object ==] 

     (although the compiler creates a shortcut code for this)"

    ^ (self == aCharacter)

!

~= aCharacter

    "return true, if the argument, aCharacter is not the same character

     redefined to avoid the overhead of [Object ~=] -> [Object not] -> [Object =] -> [Object ==]

     (although the compiler creates a shortcut code for this)"

    ^ (self ~~ aCharacter)

!

> aCharacter

    "return true, if the arguments asciiValue is less than mine"

    ^ (asciivalue > aCharacter asciiValue)

!

< aCharacter

    "return true, if the arguments asciiValue is greater than mine"

    ^ (asciivalue < aCharacter asciiValue)

!

<= aCharacter

    "return true, if the arguments asciiValue is greater or equal to mine"

    ^ (asciivalue <= aCharacter asciiValue)

!

>= aCharacter

    "return true, if the arguments asciiValue is less or equal to mine"

    ^ (asciivalue >= aCharacter asciiValue)

!

identityHash

    "return an integer useful for hashing on identity"

    asciivalue <= 255 ifTrue:[

	^ 4096 + asciivalue

    ].

    ^ super identityHash

! !

!Character methodsFor: 'arithmetic'!

+ aMagnitude

    "Return the Character that is <aMagnitude> higher than the receiver. 

     Wrap if the resulting value is not a legal Character value. (JS)"

    ^ Character value:(asciivalue + aMagnitude asInteger \\ 256)

!

- aMagnitude

    "Return the Character that is <aMagnitude> lower than the receiver.  

     Wrap if the resulting value is not a legal Character value. (JS)

     claus: modified to return the difference as integer, if the argument

	    is another character"

    aMagnitude isCharacter ifTrue:[

	^ self asciiValue - aMagnitude asciiValue

    ].

    ^ Character value:(asciivalue - aMagnitude asInteger \\ 256)

    "

     $z - $a  

     $d - 3

    "

!

// aMagnitude

    "Return the Character who's value is the receiver divided by <aMagnitude>. 

     Wrap if the resulting value is not a legal Character value. (JS)"

    ^ Character value:(asciivalue // aMagnitude asInteger \\ 256)

!

\\ aMagnitude

    "Return the Character who's value is the receiver modulo <aMagnitude>.  

     Wrap if the resulting value is not a legal Character value. (JS)"

    ^ Character value:(asciivalue \\ aMagnitude asInteger \\ 256)

! !

!Character methodsFor:'testing'!

isCharacter

    "return true,  if the receiver is some kind of character"

    ^ true

!

isDigit

    "return true, if I am a digit (i.e. $0 .. $9)"

    ^ asciivalue between:($0 asciiValue) and:($9 asciiValue)

!

isDigitRadix:r

    "return true, if I am a digit of a base r number"

    (asciivalue < $0 asciiValue) ifTrue:[^ false]. 

    (r > 10) ifTrue:[

	(asciivalue between:($0 asciiValue) and:($9 asciiValue)) ifTrue:[

	    ^ true

	].

	((asciivalue - $a asciiValue) between:0 and:(r - 10)) ifTrue:[

	    ^ true

	].

	^ (asciivalue - $A asciiValue) between:0 and:(r - 10)

    ].

    (asciivalue - $0 asciiValue) < r ifTrue:[^ true].

    ^ false

!

isLowercase

    "return true, if I am a lower-case letter"

%{  /* NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));

#ifndef OLD

    /* iso8859 puts national lower case characters at e0 .. ff */

    if ((val >= 0xE0) && (val <= 0xFF)) {

	RETURN(true);

    }

#endif

    RETURN ( ((val >= 'a') && (val <= 'z')) ? true : false );

%}

!

isUppercase

    "return true, if I am an upper-case letter"

%{  /* NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));

#ifndef OLD

    /* iso8859 puts national upper case characters at c0 .. df */

    if ((val >= 0xC0) && (val <= 0xDF)) {

	RETURN(true);

    }

#endif

    RETURN ( ((val >= 'A') && (val <= 'Z')) ? true : false );

%}

!

isLetter

    "return true, if I am a letter 

     - use isNationalLetter, if you are interrested in those."

%{  /*NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));

    RETURN ( (((val >= 'a') && (val <= 'z')) ||

	      ((val >= 'A') && (val <= 'Z'))) ? true : false );

%}

!

isLetterOrDigit

    "return true, if I am a letter or a digit

     - use isNationalAlphaNumeric, if you are interrested in those."

%{  /* NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));

    if ((val >= 'a') && (val <= 'z')) {

	RETURN ( true );

    }

    if ((val >= 'A') && (val <= 'Z')) {

	RETURN ( true );

    }

    if ((val >= '0') && (val <= '9')) {

	RETURN ( true );

    }

    RETURN ( false );

%}

!

isAlphaNumeric

    "return true, if I am a letter or a digit

     - same as isAlphaNumeric for compatibility reasons."

    ^ self isLetterOrDigit

!

isVowel

    "return true, if I am a vowel (lower- or uppercase)"

    (self == $a) ifTrue:[^ true].

    (self == $e) ifTrue:[^ true].

    (self == $i) ifTrue:[^ true].

    (self == $o) ifTrue:[^ true].

    (self == $u) ifTrue:[^ true].

    (self == $A) ifTrue:[^ true].

    (self == $E) ifTrue:[^ true].

    (self == $I) ifTrue:[^ true].

    (self == $O) ifTrue:[^ true].

    (self == $U) ifTrue:[^ true].

    ^ false

!

isSeparator

    "return true if I am a space, cr, tab, nl, or newPage"

%{  /* NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));

#ifndef NON_ASCII       /* i.e. EBCDIC ;-) */

    if (val <= ' ')