--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Character.st Fri Jul 16 11:39:45 1993 +0200
@@ -0,0 +1,573 @@
+"
+ 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:[...] ).
+
+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.)
+
+%W% %E%
+
+'!
+
+!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:'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:(self asInteger + 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:(self asInteger - 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:(self asInteger // 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:(self asInteger \\ 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:'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
+ ]
+! !