Category : Forth Source Code
Archive   : SMILY46B.ZIP
Filename : CASEOP.SEQ

\ Tony Sager's Case Comparison Operators 20APR86mds

: <<= ( v l -- v l' ) OVER MIN ;
: >>= ( v l -- v l' ) OVER MAX ;
: << ( v l -- v l' ) 1- <<= ;
: >> ( v l -- v l' ) 1+ >>= ;

: [] ( v ll ul -- v l' ) >R OVER MAX R> MIN ;
: () ( v ll ul -- v l' ) >R OVER 1+ MAX R> 1- MIN ;
: [) ( v ll ul -- v l' ) >R OVER MAX R> 1- MIN ;
: (] ( v ll ul -- v l' ) >R OVER 1+ MAX R> MIN ;

comment:
\ Tony Sager's Case Comparison Operators 20APR86mds
Renamed by MDS

From: FORTH Dimensions, Vol. VII, No. 6,
March/April 1986, p.5-6

<<= Checks for v <= l
>>= Checks for v >= l
<< Checks for v < l
>> Checks for v > l

[] Checks for ll <= v <= ul
() Checks for ll < v < ul
[) Checks for ll <= v < ul
(] Checks for ll < v <= ul

comment;
\ Test of Case Conditionals by Tony Sager 20APR86mds

\S

: CLASSIFY ( c -- )
CASE
32 << OF ." Control Character" ENDOF
ASCII 0 << OF ." Punctuation" ENDOF
ASCII 0 ASCII 9 [] OF ." Digit" ENDOF
ASCII @ <<= OF ." Punctuation" ENDOF
ASCII A ASCII Z [] OF ." Upper Case Letter" ENDOF
ASCII a << OF ." Punctuation" ENDOF
ASCII a ASCII z [] OF ." Lower Case Letter" ENDOF
127 << OF ." Punctuation" ENDOF
127 OF ." Rubout Character" ENDOF
." Not an ASCII Character"
ENDCASE ;

comment:
\ Test of Case Conditionals by Tony Sager 20APR86mds

\ Use with:

: TEST ( hi lo -- )
DO
CR I 4 .R 3 SPACES I 32 MAX 127 MIN EMIT SPACE
I CLASSIFY
LOOP ;

comment;