|
1 " |
|
2 COPYRIGHT (c) 1988-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 Magnitude subclass:#Character |
|
14 instanceVariableNames:'asciivalue' |
|
15 classVariableNames:'' |
|
16 poolDictionaries:'' |
|
17 category:'Magnitude-General' |
|
18 ! |
|
19 |
|
20 Character comment:' |
|
21 |
|
22 COPYRIGHT (c) 1988-93 by Claus Gittinger |
|
23 All Rights Reserved |
|
24 |
|
25 Characters are unique; this means that for every asciiValue (0..255) there |
|
26 is exactly one instance of Character, which is shared. |
|
27 |
|
28 Methods marked as (JS) come from the manchester Character goody |
|
29 (CharacterComparing) by Jan Steinman, which allow Characters to be used as |
|
30 Interval elements (i.e. ($a to:$z) do:[...] ). |
|
31 |
|
32 WARNING: characters are known by compiler and runtime system - |
|
33 do not change the instance layout. (also, its not easy to define |
|
34 subclasses of Character since the Compiler always creates Character |
|
35 instances for $x and, since equality check on the Character class is |
|
36 wired into the system in many places.) |
|
37 |
|
38 %W% %E% |
|
39 |
|
40 '! |
|
41 |
|
42 !Character class methodsFor:'instance creation'! |
|
43 |
|
44 basicNew |
|
45 "catch new - Characters cannot be created with new" |
|
46 |
|
47 ^ self error:'Characters cannot be created with new' |
|
48 ! |
|
49 |
|
50 value:anInteger |
|
51 "return a character with asciivalue anInteger" |
|
52 |
|
53 %{ /* NOCONTEXT */ |
|
54 |
|
55 int ascii; |
|
56 |
|
57 if (_isSmallInteger(anInteger)) { |
|
58 ascii = _intVal(anInteger); |
|
59 if ((ascii >= 0) && (ascii <= 255)) |
|
60 RETURN ( _MKCHARACTER(_intVal(anInteger)) ); |
|
61 } |
|
62 %} |
|
63 . |
|
64 (anInteger between:0 and:16rFF) ifTrue:[ |
|
65 ^ CharacterTable at:(anInteger + 1) |
|
66 ]. |
|
67 (anInteger between:16r100 and:16rFFFF) ifTrue:[ |
|
68 ^ super basicNew setAsciiValue:anInteger |
|
69 ]. |
|
70 self error:'invalid ascii code for character' |
|
71 ! |
|
72 |
|
73 digitValue:anInteger |
|
74 "return a character that corresponds to anInteger. |
|
75 0-9 map to $0-$9, 10-35 map to $A-$Z" |
|
76 |
|
77 (anInteger between:0 and:9) ifTrue:[ |
|
78 ^ Character value:(anInteger + ($0 asciiValue)) |
|
79 ]. |
|
80 (anInteger between:10 and:35) ifTrue:[ |
|
81 ^ Character value:(anInteger - 10 + ($A asciiValue)) |
|
82 ]. |
|
83 ^self error:'value not in range 0 to 35' |
|
84 ! ! |
|
85 |
|
86 !Character class methodsFor:'primitive input'! |
|
87 |
|
88 fromUser |
|
89 "return a character from the keyboard |
|
90 - this should only be used for emergency evaluators and the like." |
|
91 |
|
92 %{ /* NOCONTEXT */ |
|
93 int c; |
|
94 |
|
95 c = getchar(); |
|
96 if (c < 0) { |
|
97 RETURN (nil); |
|
98 } |
|
99 RETURN ( _MKCHARACTER(c & 0xFF) ); |
|
100 %} |
|
101 ! ! |
|
102 |
|
103 !Character class methodsFor:'constants'! |
|
104 |
|
105 bell |
|
106 "return the bell character" |
|
107 |
|
108 ^ Character value:7 |
|
109 ! |
|
110 |
|
111 backspace |
|
112 "return the backspace character" |
|
113 |
|
114 ^ Character value:8 |
|
115 ! |
|
116 |
|
117 nl |
|
118 "return the newline character" |
|
119 |
|
120 ^ Character value:10 |
|
121 ! |
|
122 |
|
123 lf |
|
124 "return the newline/linefeed character" |
|
125 |
|
126 ^ Character value:10 |
|
127 ! |
|
128 |
|
129 cr |
|
130 "return the carriage-return character |
|
131 - actually (in unix) this is also a newline" |
|
132 |
|
133 ^ Character value:10 |
|
134 ! |
|
135 |
|
136 tab |
|
137 "return the tabulator character" |
|
138 |
|
139 ^ Character value:9 |
|
140 ! |
|
141 |
|
142 newPage |
|
143 "return the form-feed character" |
|
144 |
|
145 ^ Character value:12 |
|
146 ! |
|
147 |
|
148 ff |
|
149 "return the form-feed character" |
|
150 |
|
151 ^ Character value:12 |
|
152 ! |
|
153 |
|
154 space |
|
155 "return the blank character" |
|
156 |
|
157 ^ Character value:32 |
|
158 ! |
|
159 |
|
160 esc |
|
161 "return the escape character" |
|
162 |
|
163 ^ Character value:27 |
|
164 ! |
|
165 |
|
166 quote |
|
167 "return the single-quote character" |
|
168 |
|
169 ^ Character value:39 |
|
170 ! |
|
171 |
|
172 doubleQuote |
|
173 "return the double-quote character" |
|
174 |
|
175 ^ Character value:34 |
|
176 ! |
|
177 |
|
178 excla |
|
179 "return the exclamation-mark character" |
|
180 ^ $!! |
|
181 ! ! |
|
182 |
|
183 !Character methodsFor:'copying'! |
|
184 |
|
185 shallowCopy |
|
186 "return a shallow copy of myself |
|
187 reimplemented since characters are unique" |
|
188 |
|
189 ^ self |
|
190 ! |
|
191 |
|
192 deepCopy |
|
193 "return a depp copy of myself |
|
194 reimplemented since characters are unique" |
|
195 |
|
196 ^ self |
|
197 ! ! |
|
198 |
|
199 !Character methodsFor:'private accessing'! |
|
200 |
|
201 setAsciiValue:anInteger |
|
202 "very private - set the ascii value - only used for |
|
203 characters with codes > 16rFF" |
|
204 |
|
205 asciivalue := anInteger |
|
206 ! ! |
|
207 |
|
208 !Character methodsFor:'accessing'! |
|
209 |
|
210 asciiValue |
|
211 "return the asciivalue of myself" |
|
212 |
|
213 ^asciivalue |
|
214 ! |
|
215 |
|
216 instVarAt:index put:anObject |
|
217 "catch instvar access - asciivalue cannot be changed" |
|
218 |
|
219 self error:'Characters may not be modified' |
|
220 ! ! |
|
221 |
|
222 !Character methodsFor:'converting'! |
|
223 |
|
224 digitValue |
|
225 "return my digitValue for any base" |
|
226 |
|
227 (asciivalue between:($0 asciiValue) and:($9 asciiValue)) ifTrue:[ |
|
228 ^ asciivalue - $0 asciiValue |
|
229 ]. |
|
230 (asciivalue between:($a asciiValue) and:($z asciiValue)) ifTrue:[ |
|
231 ^ asciivalue - $a asciiValue + 10 |
|
232 ]. |
|
233 (asciivalue between:($A asciiValue) and:($Z asciiValue)) ifTrue:[ |
|
234 ^ asciivalue - $A asciiValue + 10 |
|
235 ]. |
|
236 self error:'bad character' |
|
237 ! ! |
|
238 |
|
239 !Character methodsFor:'comparing'! |
|
240 |
|
241 = aCharacter |
|
242 "return true, if the argument, aCharacter is the same character |
|
243 redefined to avoid the overhead of [Object =] -> [Object ==] |
|
244 (although the compiler creates a shortcut code for this)" |
|
245 |
|
246 ^ (self == aCharacter) |
|
247 ! |
|
248 |
|
249 ~= aCharacter |
|
250 "return true, if the argument, aCharacter is not the same character |
|
251 redefined to avoid the overhead of [Object ~=] -> [Object not] -> [Object =] -> [Object ==] |
|
252 (although the compiler creates a shortcut code for this)" |
|
253 |
|
254 ^ (self ~~ aCharacter) |
|
255 ! |
|
256 |
|
257 > aCharacter |
|
258 "return true, if the arguments asciiValue is less than mine" |
|
259 |
|
260 ^ (asciivalue > aCharacter asciiValue) |
|
261 ! |
|
262 |
|
263 < aCharacter |
|
264 "return true, if the arguments asciiValue is greater than mine" |
|
265 |
|
266 ^ (asciivalue < aCharacter asciiValue) |
|
267 ! |
|
268 |
|
269 <= aCharacter |
|
270 "return true, if the arguments asciiValue is greater or equal to mine" |
|
271 |
|
272 ^ (asciivalue <= aCharacter asciiValue) |
|
273 ! |
|
274 |
|
275 >= aCharacter |
|
276 "return true, if the arguments asciiValue is less or equal to mine" |
|
277 |
|
278 ^ (asciivalue >= aCharacter asciiValue) |
|
279 ! |
|
280 |
|
281 identityHash |
|
282 "return an integer useful for hashing on identity" |
|
283 |
|
284 ^ 4096 + asciivalue |
|
285 ! ! |
|
286 |
|
287 !Character methodsFor: 'arithmetic'! |
|
288 |
|
289 + aMagnitude |
|
290 "Return the Character that is <aMagnitude> higher than the receiver. |
|
291 Wrap if the resulting value is not a legal Character value. (JS)" |
|
292 |
|
293 ^ Character value:(self asInteger + aMagnitude asInteger \\ 256) |
|
294 ! |
|
295 |
|
296 - aMagnitude |
|
297 "Return the Character that is <aMagnitude> lower than the receiver. |
|
298 Wrap if the resulting value is not a legal Character value. (JS)" |
|
299 |
|
300 ^ Character value:(self asInteger - aMagnitude asInteger \\ 256) |
|
301 ! |
|
302 |
|
303 // aMagnitude |
|
304 "Return the Character who's value is the receiver divided by <aMagnitude>. |
|
305 Wrap if the resulting value is not a legal Character value. (JS)" |
|
306 |
|
307 ^ Character value:(self asInteger // aMagnitude asInteger \\ 256) |
|
308 ! |
|
309 |
|
310 \\ aMagnitude |
|
311 "Return the Character who's value is the receiver modulo <aMagnitude>. |
|
312 Wrap if the resulting value is not a legal Character value. (JS)" |
|
313 |
|
314 ^ Character value:(self asInteger \\ aMagnitude asInteger \\ 256) |
|
315 ! ! |
|
316 |
|
317 !Character methodsFor:'testing'! |
|
318 |
|
319 isDigit |
|
320 "return true, if I am a digit (i.e. $0 .. $9)" |
|
321 |
|
322 ^ asciivalue between:($0 asciiValue) and:($9 asciiValue) |
|
323 ! |
|
324 |
|
325 isDigitRadix:r |
|
326 "return true, if I am a digit of a base r number" |
|
327 |
|
328 (asciivalue < $0 asciiValue) ifTrue:[^ false]. |
|
329 (r > 10) ifTrue:[ |
|
330 (asciivalue between:($0 asciiValue) and:($9 asciiValue)) ifTrue:[ |
|
331 ^ true |
|
332 ]. |
|
333 ((asciivalue - $a asciiValue) between:0 and:(r - 10)) ifTrue:[ |
|
334 ^ true |
|
335 ]. |
|
336 ^ (asciivalue - $A asciiValue) between:0 and:(r - 10) |
|
337 ]. |
|
338 (asciivalue - $0 asciiValue) < r ifTrue:[^ true]. |
|
339 ^ false |
|
340 ! |
|
341 |
|
342 isLowercase |
|
343 "return true, if I am a lower-case letter" |
|
344 |
|
345 %{ /* NOCONTEXT */ |
|
346 |
|
347 REGISTER int val; |
|
348 |
|
349 val = _intVal(_INST(asciivalue)); |
|
350 RETURN ( ((val >= 'a') && (val <= 'z')) ? true : false ); |
|
351 %} |
|
352 ! |
|
353 |
|
354 isUppercase |
|
355 "return true, if I am an upper-case letter" |
|
356 |
|
357 %{ /* NOCONTEXT */ |
|
358 |
|
359 REGISTER int val; |
|
360 |
|
361 val = _intVal(_INST(asciivalue)); |
|
362 RETURN ( ((val >= 'A') && (val <= 'Z')) ? true : false ); |
|
363 %} |
|
364 ! |
|
365 |
|
366 isLetter |
|
367 "return true, if I am a letter" |
|
368 |
|
369 %{ /*NOCONTEXT */ |
|
370 |
|
371 REGISTER int val; |
|
372 |
|
373 val = _intVal(_INST(asciivalue)); |
|
374 RETURN ( (((val >= 'a') && (val <= 'z')) || |
|
375 ((val >= 'A') && (val <= 'Z'))) ? true : false ); |
|
376 %} |
|
377 ! |
|
378 |
|
379 isAlphaNumeric |
|
380 "return true, if I am a letter or a digit" |
|
381 |
|
382 %{ /* NOCONTEXT */ |
|
383 |
|
384 REGISTER int val; |
|
385 |
|
386 val = _intVal(_INST(asciivalue)); |
|
387 if ((val >= 'a') && (val <= 'z')) { |
|
388 RETURN ( true ); |
|
389 } |
|
390 if ((val >= 'A') && (val <= 'Z')) { |
|
391 RETURN ( true ); |
|
392 } |
|
393 if ((val >= '0') && (val <= '9')) { |
|
394 RETURN ( true ); |
|
395 } |
|
396 RETURN ( false ); |
|
397 %} |
|
398 ! |
|
399 |
|
400 isVowel |
|
401 "return true, if I am a vowel (lower- or uppercase)" |
|
402 |
|
403 (self == $a) ifTrue:[^ true]. |
|
404 (self == $e) ifTrue:[^ true]. |
|
405 (self == $i) ifTrue:[^ true]. |
|
406 (self == $o) ifTrue:[^ true]. |
|
407 (self == $u) ifTrue:[^ true]. |
|
408 (self == $A) ifTrue:[^ true]. |
|
409 (self == $E) ifTrue:[^ true]. |
|
410 (self == $I) ifTrue:[^ true]. |
|
411 (self == $O) ifTrue:[^ true]. |
|
412 (self == $U) ifTrue:[^ true]. |
|
413 ^ false |
|
414 ! |
|
415 |
|
416 isSeparator |
|
417 "return true if I am a space, cr, tab, nl, or newPage" |
|
418 |
|
419 %{ /* NOCONTEXT */ |
|
420 |
|
421 REGISTER int val; |
|
422 |
|
423 val = _intVal(_INST(asciivalue)); |
|
424 if (val <= ' ') { |
|
425 if ((val == ' ') |
|
426 || (val == '\n') |
|
427 || (val == '\t') |
|
428 || (val == '\r') |
|
429 || (val == '\f')) { |
|
430 RETURN ( true ); |
|
431 } |
|
432 } |
|
433 %} |
|
434 . |
|
435 ^ false |
|
436 ! |
|
437 |
|
438 isEndOfLineCharacter |
|
439 "return true if I am a line delimitting character" |
|
440 |
|
441 %{ /* NOCONTEXT */ |
|
442 |
|
443 REGISTER int val; |
|
444 |
|
445 val = _intVal(_INST(asciivalue)); |
|
446 if (val <= ' ') { |
|
447 if ((val == '\n') |
|
448 || (val == '\r') |
|
449 || (val == '\f')) { |
|
450 RETURN ( true ); |
|
451 } |
|
452 } |
|
453 %} |
|
454 . |
|
455 ^ false |
|
456 ! ! |
|
457 |
|
458 !Character methodsFor:'converting'! |
|
459 |
|
460 asLowercase |
|
461 "return a character with same letter as myself but lowercase |
|
462 (myself if I am lowercase)" |
|
463 |
|
464 self isUppercase ifFalse:[^ self]. |
|
465 ^ Character value:(asciivalue + 32) |
|
466 ! |
|
467 |
|
468 asUppercase |
|
469 "return a character with same letter as myself but uppercase |
|
470 (myself if I am lowercase)" |
|
471 |
|
472 self isLowercase ifFalse:[^ self]. |
|
473 ^ Character value:(asciivalue - 32) |
|
474 ! |
|
475 |
|
476 asInteger |
|
477 "return an Integer with my ascii-value" |
|
478 |
|
479 ^ asciivalue |
|
480 ! |
|
481 |
|
482 asSymbol |
|
483 "return a unique symbol which prints like I print" |
|
484 |
|
485 ^ Symbol internCharacter:self |
|
486 ! |
|
487 |
|
488 asString |
|
489 "return a string of len 1 with myself as contents" |
|
490 |
|
491 %{ /* NOCONTEXT */ |
|
492 |
|
493 char buffer[2]; |
|
494 |
|
495 buffer[0] = (char) _intVal(_characterVal(self)); |
|
496 buffer[1] = '\0'; |
|
497 RETURN ( _MKSTRING(buffer COMMA_SND) ); |
|
498 %} |
|
499 |
|
500 " |
|
501 |newString| |
|
502 |
|
503 newString := String new:1. |
|
504 newString at:1 put:self. |
|
505 ^ newString |
|
506 " |
|
507 ! |
|
508 |
|
509 to:aMagnitude |
|
510 "Return an Interval over the characters from the receiver to <aMagnitude>. |
|
511 Wrap <aMagnitude> if it is not a legal Character value. (JS)" |
|
512 |
|
513 ^ Interval from:self to:(aMagnitude \\ 256) |
|
514 |
|
515 ! ! |
|
516 |
|
517 !Character methodsFor:'printing & storing'! |
|
518 |
|
519 printString |
|
520 "return a string to print me" |
|
521 |
|
522 ^ self asString |
|
523 ! |
|
524 |
|
525 printOn:aStream |
|
526 "print myself on aStream" |
|
527 |
|
528 aStream nextPut:self |
|
529 ! |
|
530 |
|
531 print |
|
532 "print myself on stdout" |
|
533 |
|
534 %{ /* NOCONTEXT */ |
|
535 |
|
536 putchar(_intVal(_INST(asciivalue))); |
|
537 %} |
|
538 ! |
|
539 |
|
540 displayString |
|
541 "return a string used when the receiver is to be displayed |
|
542 in an inspector kind-of-thing" |
|
543 |
|
544 ^ self storeString |
|
545 ! |
|
546 |
|
547 storeString |
|
548 "return a string for storing" |
|
549 |
|
550 (asciivalue between:33 and:127) ifFalse:[ |
|
551 (self == Character space) ifTrue:[ |
|
552 ^ '(Character space)' |
|
553 ]. |
|
554 (self == Character cr) ifTrue:[ |
|
555 ^ '(Character cr)' |
|
556 ]. |
|
557 ^ '(Character value:' , asciivalue printString , ')' |
|
558 ]. |
|
559 ^ '$' , self asString |
|
560 ! |
|
561 |
|
562 storeOn:aStream |
|
563 "store myself on aStream" |
|
564 |
|
565 (asciivalue between:33 and:127) ifFalse:[ |
|
566 aStream nextPutAll:'(Character value:'. |
|
567 aStream nextPutAll:(asciivalue printString). |
|
568 aStream nextPutAll:')' |
|
569 ] ifTrue:[ |
|
570 aStream nextPut:$$. |
|
571 aStream nextPut:self |
|
572 ] |
|
573 ! ! |