ANEW --CHARCASE-- DECIMAL                    \  Wil Baden  2002-03-17

\  *******************************************************************
\  *                                                                 *
\  *  Wil Baden  2003-02-17                                          *
\  *                                                                 *
\  *     Character-Case Conversion and Case-Insensitive Compare      *
\  *                                                                 *
\  *                          Using Latin-1                          *
\  *                                                                 *
\  *       .LOWER       Char>Upper   Is-Alpha     Is-Upper           *
\  *       .UPPER       COMPARE(NC)  Is-Digit     String->Lower      *
\  *       Char>Lower   Is-Alnum     Is-Lower     String->Upper      *
\  *                                                                 *
\  *******************************************************************

\  *******************************************************************
\  *                  Character Test and Conversion                  *
\  *******************************************************************

\  Char>Upper                   ( c -- C )
\     Convert character to uppercase.  Uses `Uppercase-Map`.

\  Char>Lower                   ( c -- C )
\     Convert character to lowercase.  Uses `Lowercase-Map`.

\  Is-Lower                     ( char -- flag )
\     Test for lowercase letter.

\  Is-Upper                     ( char -- flag )
\     Test for uppercase letter.

    \  Lowercase-Map                ( -- addr ) 
    \     Table of characters with uppercase letters replaced by 
    \     lowercase letters.  Uses  `Is-Lower` and `Char>Upper`. 

    \  Uppercase-Map                ( -- addr ) 
    \     Table of 256 characters with lowercase letters replaced by 
    \     uppercase letters. 

	CREATE  Uppercase-Map  256 chars ALLOT

	CREATE  Lowercase-Map  256 chars ALLOT

\  *****************  Character Test and Conversion  *****************

: Char>Upper                ( c -- C )
    S" chars Uppercase-Map + C@ " EVALUATE ; IMMEDIATE

: Char>Lower                ( char -- char )
    S" chars Lowercase-Map + C@ " EVALUATE ; IMMEDIATE

: Is-Upper                  ( char -- flag )
    dup Char>Lower <> ;

: Is-Lower                  ( char -- flag )
    dup Char>Upper <> ;

MARKER ONCE

	\  Latin-1 Uppercase Map.

    : Init-Uppercase-Map-with-Latin-1   ( -- )
        256 0 DO
            I       I chars Uppercase-Map + C!
        LOOP
        H# 61 H# 7A 1+ SWAP DO
            I 32 -  I chars Uppercase-Map + C!
        LOOP
        H# E0 H# F6 1+ SWAP DO
            I 32 -  I chars Uppercase-Map + C!
        LOOP
        H# F8 H# FE 1+ SWAP DO
            I 32 -  I chars Uppercase-Map + C!
        LOOP ;

    : Init-Lowercase-Map                ( -- )
        256 0 DO  I I chars Lowercase-Map + C!  LOOP
        256 0 DO
            I Is-Lower IF
                I I Char>Upper chars Lowercase-Map + C!
            THEN
        LOOP ;

    : INITIALIZE
        Init-Uppercase-Map-with-Latin-1
        Init-Lowercase-Map ;

INITIALIZE ONCE

\  *******************************************************************
\  *                    Case-insensitive COMPARE                     *
\  *******************************************************************

\  COMPARE(NC)           ( str1 len1 str2 len2 -- flag )  
\     Case insensitive comparison of two strings.  Returns -1, 0,
\     or 1.  AKA `ICOMPARE` in VFX.  Uses `Char>Upper`.

: COMPARE(NC)               ( a1 n1 a2 n2 -- -1|0|1 )
    ROT  2dup - >R            ( a1 a2 n2 n1)( R: n2-n1)
    MIN                       ( a1 a2 n3)
    BOUNDS ?DO                ( a1)
        COUNT Char>Upper  I C@ Char>Upper  - ( a1 diff)
        dup IF
            NIP  0< 1 OR      ( -1|1)
            UNLOOP
            R> DROP
        EXIT THEN             ( a1 diff)
        DROP                  ( a1)
    LOOP DROP                 ( )
    R>  dup IF  0> 1 OR  THEN   \  2's complement arith.
    ;

\  *******************************************************************
\  *              Character Test and String Conversion               *
\  *******************************************************************

\  .LOWER                       ( str /str -- )
\     Display in lowercase.

\  .UPPER                       ( str /str -- )
\     Display in uppercase.

\  String->Lower                ( str len -- )
\     Convert string into lowercase.

\  String->Upper                ( str len -- )
\     Convert string into uppercase.

\  Is-Alpha                     ( char -- flag )
\     Test _char_ for alphabetic.

\  Is-Digit                     ( char -- flag )
\     Test _char_ for digit.

\  Is-Alnum                     ( char -- flag )
\     Test _char_ for alphanumeric.

\  *************  Character Test and String Conversion  **************

: String->Upper             ( str len -- )
    chars BOUNDS ?DO  I C@ Char>Upper I C!  1 chars +LOOP ;

: String->Lower             ( str len -- )
    chars BOUNDS ?DO  I C@ Char>Lower I C!  1 chars +LOOP ;

: .LOWER                        ( str /str -- )
    BOUNDS ?DO  I C@  Char>Lower  EMIT  LOOP ;

: .UPPER                        ( str /str -- )
    BOUNDS ?DO  I C@  Char>Upper  EMIT  LOOP ;

: Is-Alpha                  ( char -- flag )
    dup Is-Upper SWAP Is-Lower OR ;

: Is-Digit                        ( char -- flag )
    [char] 0 -  10 U< ;

: Is-Alnum                        ( char -- flag )
    dup  Is-Alpha  SWAP  Is-Digit  OR ;

\\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\   //   \\