This is G o o g l e's cache of http://home.earthlink.net/~neilbawd/compare.html.
G o o g l e's cache is the snapshot that we took of the page as we crawled the web.
The page may have changed since that time. Click here for the current page without highlighting.
To link to or bookmark this page, use the following url: http://www.google.com/search?q=cache:AJA3yWpE1_MC:home.earthlink.net/~neilbawd/compare.html+&hl=en&ie=UTF-8

Google is not affiliated with the authors of this page nor responsible for its content.
Case Insensitive Compare

Case Insensitive Compare

Get TEXT

Wil Baden 2001-11-13

Case-Insensitive-Map  ( -- addr )
Table of case insensitive characters for comparison. This is the ISO-Latin-1 set. White space and unused XML characters are 0.
It will have to be redone for Mac or non-English fonts. As Michael Gassanenko discovered, it gives weird results for Russian.
CHAR>CI             ( c -- C )
Convert character to case insensitive.
STRING>CI           ( str len -- )
Convert string to case insensitive.
COMPARE-CI          ( str1 len1 str2 len2 -- flag )
Case insensitive comparison of two strings. Returns -1, 0, or 1. AKA COMPARE(NC) in SwiftForth, ICOMPARE in VFX.
Program Text 1 
\  Comment out if already defined.
    : BOUNDS ( addr len -- addr+len addr ) over + SWAP ;

CREATE Case-Insensitive-Map  256 chars ALLOT

CREATE ISO-Latin-1-CI-Map    128 chars ALLOT

MARKER ONCE

    \  Ascii chars of Case-Insensitive-Map do not change.

    : Init-CI-Ascii-Chars   ( -- )
         33   0 DO  0   I Case-Insensitive-Map +  C!  LOOP
         97  33 DO  I   I Case-Insensitive-Map +  C!  LOOP
        123  97 DO  I 32 -  I Case-Insensitive-Map +  C!  LOOP
        127 123 DO  I   I Case-Insensitive-Map +  C!  LOOP
                    0 127 Case-Insensitive-Map +  C!
        ;

    Init-CI-Ascii-Chars

    : Init-Default-ISO-Latin-1
        ISO-Latin-1-CI-Map  32 chars ERASE
        128  32 DO  I 128 +  I ISO-Latin-1-CI-Map +  C!  LOOP
        ;

    Init-Default-ISO-Latin-1

    : C!++  ( addr char -- addr+1 )  over C! CHAR+ ;

    ISO-Latin-1-CI-Map  64 chars +
        CHAR A C!++   CHAR A C!++   CHAR A C!++   CHAR A C!++
        CHAR A C!++   CHAR A C!++      198 C!++   CHAR C C!++
        CHAR E C!++   CHAR E C!++   CHAR E C!++   CHAR E C!++
        CHAR I C!++   CHAR I C!++   CHAR I C!++   CHAR I C!++
           208 C!++   CHAR N C!++   CHAR O C!++   CHAR O C!++
        CHAR O C!++   CHAR O C!++   CHAR O C!++      215 C!++
        CHAR O C!++   CHAR U C!++   CHAR U C!++   CHAR U C!++
        CHAR U C!++   CHAR Y C!++      222 C!++      223 C!++

        CHAR A C!++   CHAR A C!++   CHAR A C!++   CHAR A C!++
        CHAR A C!++   CHAR A C!++      198 C!++   CHAR C C!++
        CHAR E C!++   CHAR E C!++   CHAR E C!++   CHAR E C!++
        CHAR I C!++   CHAR I C!++   CHAR I C!++   CHAR I C!++
           208 C!++   CHAR N C!++   CHAR O C!++   CHAR O C!++
        CHAR O C!++   CHAR O C!++   CHAR O C!++      247 C!++
        CHAR O C!++   CHAR U C!++   CHAR U C!++   CHAR U C!++
        CHAR U C!++   CHAR Y C!++      254 C!++   CHAR Y C!++

RUN ONCE

: ISO-Latin-1                  ( -- )
    ISO-Latin-1-CI-Map  Case-Insensitive-Map 128 +  128  MOVE ;

ISO-Latin-1

CHAR>CI - STRING>CI - COMPARE-CI

Program Text 2 
: CHAR>CI              ( c -- C )
    Case-Insensitive-Map + C@ ;

: STRING>CI            ( str len -- )
    BOUNDS ?DO  I C@  CHAR>CI  I C!  LOOP ;

: COMPARE-CI           ( a n a2 n2 -- -1|0|1 )
    ROT 2dup - >R                    ( a a2 n2 n)( R: n2-n)
    MIN                              ( a a2 n3)
    BOUNDS ?DO                       ( a)
        I C@  Case-Insensitive-Map +  C@
            I C@  Case-Insensitive-Map +  C@  -   ( a diff)
        dup IF
            NIP  0< 1 OR
            UNLOOP
            R> DROP
            EXIT
        THEN                         ( a diff)
        DROP                         ( a)
    LOOP
    DROP
    R>  dup IF  0> 1 OR  THEN        \  2's complement arith.
    ;

\ \  End of COMPARE-CI

Go back to home page.