"
 COPYRIGHT (c) 1988-93 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-93 by Claus Gittinger
              All Rights Reserved

Characters are unique; this means that for every asciiValue (0..255) there
is exactly one instance of Character, which is 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, its not easy to define
subclasses of Character since the Compiler always creates Character
instances for $x and, since equality check on the Character class is
wired into the system in many places.)

$Header: /cvs/stx/stx/libbasic/Character.st,v 1.3 1993-10-13 00:15:12 claus Exp $

'!

!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 >= 0) && (ascii <= 255))
            RETURN ( _MKCHARACTER(_intVal(anInteger)) );
    }
%}
.
    (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"

    (anInteger between:0 and:9) ifTrue:[
        ^ Character value:(anInteger + ($0 asciiValue))
    ].
    (anInteger between:10 and:35) ifTrue:[
        ^ Character value:(anInteger - 10 + ($A asciiValue))
    ].
    ^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
    "this class is known by the run-time-system"

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

shallowCopy
    "return a shallow copy of myself
     reimplemented since characters are unique"

     ^ self
!

deepCopy
    "return a depp copy of myself
     reimplemented since characters are unique"

     ^ self
! !

!Character methodsFor:'private accessing'!

setAsciiValue:anInteger
    "very private - set the ascii value - only used for
     characters with codes > 16rFF"

    asciivalue := anInteger
! !
        
!Character methodsFor:'accessing'!

asciiValue
    "return the asciivalue of myself"

    ^asciivalue
!

instVarAt:index put:anObject
    "catch instvar access - asciivalue cannot be changed"

    self error:'Characters may not be modified'
! !

!Character methodsFor:'converting'!

digitValue
    "return my digitValue for any base"

    (asciivalue between:($0 asciiValue) and:($9 asciiValue)) ifTrue:[
        ^ asciivalue - $0 asciiValue
    ].
    (asciivalue between:($a asciiValue) and:($z asciiValue)) ifTrue:[
        ^ asciivalue - $a asciiValue + 10
    ]. 
    (asciivalue between:($A asciiValue) and:($Z asciiValue)) ifTrue:[
        ^ asciivalue - $A asciiValue + 10
    ]. 
    self error:'bad character'
! !

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

    ^ 4096 + asciivalue
! !

!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)"

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

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

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));
    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));
    RETURN ( ((val >= 'A') && (val <= 'Z')) ? true : false );
%}
!

isLetter
    "return true, if I am a letter"

%{  /*NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));
    RETURN ( (((val >= 'a') && (val <= 'z')) ||
              ((val >= 'A') && (val <= 'Z'))) ? true : false );
%}
!

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

%{  /* 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 );
%}
!

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));
    if (val <= ' ') {
        if ((val == ' ')
         || (val == '\n') 
         || (val == '\t')
         || (val == '\r')
         || (val == '\f')) {
            RETURN ( true );
        }
    }
%}
.
    ^ false
!

isEndOfLineCharacter
    "return true if I am a line delimitting character"

%{  /* NOCONTEXT */

    REGISTER int val;

    val = _intVal(_INST(asciivalue));
    if (val <= ' ') {
        if ((val == '\n')
         || (val == '\r')
         || (val == '\f')) {
            RETURN ( true );
        }
    }
%}
.
    ^ false
! !

!Character methodsFor:'converting'!

asLowercase
    "return a character with same letter as myself but lowercase
     (myself if I am lowercase)"

    self isUppercase ifFalse:[^ self].
    ^ Character value:(asciivalue + 32)
!

asUppercase
    "return a character with same letter as myself but uppercase
     (myself if I am lowercase)"

    self isLowercase ifFalse:[^ self].
    ^ Character value:(asciivalue - 32)
!

asInteger
    "return an Integer with my ascii-value"

    ^ asciivalue
!

asSymbol
    "return a unique symbol which prints like I print"

    ^ Symbol internCharacter:self
!

asString
    "return a string of len 1 with myself as contents"

%{  /* NOCONTEXT */

    char buffer[2];

    buffer[0] = (char) _intVal(_characterVal(self));
    buffer[1] = '\0';
    RETURN ( _MKSTRING(buffer COMMA_SND) );
%}

"
    |newString|

    newString := String new:1.
    newString at:1 put:self.
    ^ newString
"
!

to:aMagnitude
    "Return an Interval over the characters from the receiver to <aMagnitude>. 
     Wrap <aMagnitude> if it is not a legal Character value. (JS)"

    ^ Interval from:self to:(aMagnitude \\ 256)
! !

!Character methodsFor:'enumeration'!

to:stopCharacter do:aBlock
    "evaluate aBlock for each character in self .. stopCharacter.
     This is somewhat stupid, since it depends on the ascii encoding
     (370-users watch out :-)"

    |runChar|

    runChar := self.
    [runChar <= stopCharacter] whileTrue:[
        aBlock value:runChar.
        runChar := runChar + 1
    ]
! !

!Character methodsFor: 'binary storage'!

hasSpecialBinaryRepresentation
    ^ true
!

storeBinaryOn: stream manager: manager
    stream nextPut: manager codeForCharacter.
    stream nextPut:(self asciiValue)
! !

!Character methodsFor:'printing & storing'!

printString
    "return a string to print me"

    ^ self asString
!

printOn:aStream
    "print myself on aStream"

    aStream nextPut:self
!

print
    "print myself on stdout"

%{  /* NOCONTEXT */

    putchar(_intVal(_INST(asciivalue)));
%}
!

displayString
    "return a string used when the receiver is to be displayed
     in an inspector kind-of-thing"

    ^ self storeString
!

storeString
    "return a string for storing"

    (asciivalue between:33 and:127) ifFalse:[
        (self == Character space) ifTrue:[
            ^ '(Character space)'
        ].
        (self == Character cr) ifTrue:[
            ^ '(Character cr)'
        ].
        ^ '(Character value:' , asciivalue printString , ')'
    ].
    ^ '$' , self asString
!

storeOn:aStream
    "store myself on aStream"

    (asciivalue between:33 and:127) ifFalse:[
        aStream nextPutAll:'(Character value:'.
        aStream nextPutAll:(asciivalue printString).
        aStream nextPutAll:')'
    ] ifTrue:[
        aStream nextPut:$$.
        aStream nextPut:self
    ]
! !