ANEW  --CHARSCAN--                            \  Wil Baden  2002-03-17

\  *******************************************************************
\  *                                                                 *
\  *  Wil Baden  2003-02-17                                          *
\  *                                                                 *
\  *      String Handling with Generalization of SKIP and SCAN       *
\  *                                                                 *
\  *    BACK           EQUALS?        SCAN[          STRING/         *
\  *    BACK[          HUNT           SIMILAR?       th-Word         *
\  *    CHOP           JOIN           SKIP           th-Word-Back    *
\  *    CONTAINS?      Last-Word      SPLIT          th-Word-Forward *
\  *    END-C@         Replace-Char   SPLIT[         TRIM            *
\  *    ENDS?          SCAN           STARTS?                        *
\  *                                                                 *
\  *******************************************************************

\  *******************************************************************
\  *    String Handling with Generalization of SCAN and SKIP         *
\  *******************************************************************

\  SCAN      ( str str+i len-i )
\     Look for a particular character in the specified string.
\     BL is treated as any white space.

\  SCAN[ char-test ]SCAN          ( str len -- str+i len-i ) 
\     Look for a character that satisfies _char-test_ in the 
\     specified string 

\  SKIP      ( str len char -- str+i len-i )
\     Advance past leading occurrences of a particular character.
\     BL is treated as any white space.

\  *************  SKIP[ ]SKIP  SCAN[ ]SCAN  SKIP  SCAN  **************


: SCAN[  S" BEGIN  dup WHILE  over C@  COND "      EVALUATE ; IMMEDIATE

: ]SCAN  S" THENS 0= WHILE  1 /STRING  REPEAT THEN "  EVALUATE ; IMMEDIATE

: COND    0 ; IMMEDIATE
: THENS   BEGIN DUP WHILE  postpone THEN  REPEAT DROP ; IMMEDIATE

: SKIP                        ( str len char -- str+i len-i )
    dup BL = IF
        DROP SCAN[ Is-White 0= ]SCAN
    ELSE
        >R  SCAN[ R@ - ]SCAN  R> DROP
    THEN ;

: SCAN                        ( str len char -- str+i len-i )
    dup BL = IF
        DROP  SCAN[ Is-White ]SCAN
    ELSE
        >R  SCAN[ R@ = ]SCAN  R> DROP
    THEN ;

\  *****************************************************************
\  *   Splitting the Character String                              *
\  *****************************************************************

\  CHOP                 ( a m a+i m-i -- a+i m-i a i )
\     Chop a character string _a m_ at place given by _a+i m-i_.

\  /SPLIT
\     Synonym of `CHOP`.  For backward compatibility.  

\  SPLIT        ( str /str char -- str+i /str-i str i )
\     Divide a string at a given character. The first part of the
\     string is on top, the remaining part is underneath. The
\     remaining part begins with the scanned-for character.

\  SPLIT[ char=test ]SPLIT  ( str /str char -- str+i /str-i str i )
\     Divide a string at a character satisfying _char-test_. 
\     The first part of the  string is on top, the remaining part 
\     is underneath. The remaining part begins with the character
\     satisfying _char-test_.

\  HUNT           ( str /str pat /pat -- str+I /str-i )
\     Scan for a string, _pat /pat_, rather than a character. The 
\     result is like the other scanning functions, and can be 
\     used with `2dup` and `CHOP` to split a line.

\  ********  2dup  CHOP  SPLIT[  ]SPLIT  HUNT  SEPARATE  *********

: CHOP  ( a m b n -- b n a m-n )  2SWAP THIRD - ;

\ : /SPLIT  CHOP ;

: SPLIT[   S" 2dup SCAN[ " EVALUATE ; IMMEDIATE

: ]SPLIT   S" ]SCAN CHOP " EVALUATE ; IMMEDIATE

: HUNT   ( str /str pat /pat -- str+I /str-i )
	SEARCH 0= IF  chars + 0  THEN ;

: SPLIT        ( str /str char -- str+i /str-i str i )
    >R  2dup  R> SCAN  2SWAP  THIRD - ;

\  *************************  Scan Backward  *************************

\  TRIM                     ( str /str -- str /str-i )
\     Remove white space from the end of a string by changing
\     the count of the string.
\
\     To remove white space from the start of a string, use `BL SKIP`.

\  END-C@                    ( str /str -- char )
\     The last character of _str /str_.

\  BACK[ char-test ]BACK   
\     Scan with _char-test_ from back to front.

\  BACK                      ( str /str char -- str /str-i )   
\     Scan for given _char_ from back to front.

\  End-Word       ( str /str -- str+i /str-i )
\     The last word in a string after trimming.

: END-C@                          ( str /str -- char )
    1- chars +  C@ ;

: BACK[  S" BEGIN  dup WHILE  2dup END-C@ COND "  EVALUATE ; IMMEDIATE

: ]BACK  S" THENS 0= WHILE  1-  REPEAT THEN " EVALUATE ; IMMEDIATE

: BACK                            ( str /str char -- str /str-i )
    dup BL = IF
        DROP BACK[ Is-White ]BACK
    ELSE
        >R  BACK[ R@ = ]BACK  R> DROP
    THEN ;

: TRIM                            ( str /str -- str /str-i )
    BACK[ Is-White NOT ]BACK ;

: End-Word      ( str /str -- str+/str-i i )
    trim  2dup bl back nip /string ;

\  *****************************************************************
\  *   Starting and Ending Values                                  *
\  *****************************************************************

\  STARTS?    ( str /str start /start -- str /str flag )
\     Check start of string.

\  ENDS?      ( str /str ending /ending -- str /str flag )
\     Check end of string.

\  EQUALS?            ( str /str pat /pat -- str /str flag )
\     Check for the string equal to the pattern.

\  SIMILAR?           ( str /str pat /pat -- str /str flag )
\     Check for the string equal to the pattern ignoring case.

\  STRING/            ( str /str i -- str+/str-i i )
\     Get ending characters.

\  ********************  STARTS?  ENDS?  EQUALS?  ********************

: STARTS?          ( str /str start /start -- str /str flag )
    2over  THIRD MIN  COMPARE(NC) 0= ;

: ENDS?            ( str /str ending /ending -- str /str flag )
    2over  dup FOURTH - /STRING  COMPARE(NC) 0= ;

: EQUALS?              ( str /str pat /pat -- str /str flag )
    2over COMPARE 0= ;

: SIMILAR?               ( str /str pat /pat -- str /str flag )
    2over COMPARE(NC) 0= ;

: STRING/                   ( str /str i -- str+/str-i i )
    >R  +  R@ -  R> ;

\  *********************************************************************
\  *     Extract Substring from String                                 *
\  *********************************************************************

\  th-Word                  ( str /str n -- str+i /str-i )
\     The _n_th white-space delimited substring of _str len_.

\  th-Word-Forward          ( str /str n -- str+i /str-i )
\     The _n_th white-space delimited substring of _str len_ and
\     what follows it.

\  th-Word-Back             ( str /str n -- str /str-i )
\     All before the _n_th white-space delimited substring of
\     _str /str_

\  ************  th-Word  th-Word-Forward  th-Word-Back  **************

: th-Word-Forward           ( str /str n -- str+i /str-i )
    dup 0= IF  DROP  EXIT THEN
    1 ?DO  BL SKIP BL SCAN  LOOP
    BL SKIP ;

: th-Word                   ( str /str n -- str+i /str-i )
    ?dup IF  th-Word-Forward  THEN
    2dup BL SCAN NIP - ;

: th-Word-Back              ( str /str n -- str /str-i )
    >R 2dup R> th-Word-Forward NIP - ;

\  ****************************  REPLACE  ****************************

\  Replace-Char                  ( str /str char char_2 -- )
\     Replace each occurrence of _char_ with _char_2_.

\  JOIN          ( str_1 /str_1 str_2 /str_2 -- str_3 /str_3)
\     Join _str_1_ . then _str_2_.

\  JOIN          ( str_1 /str_1 str_2 /str_2 -- str_3 /str_3)

\  CONTAINS?  ( str_1 /str_1 str_2 /str_2 -- str_1 /str_1 flag )
\     Test that _str_1_ contains _str_2_.

: Replace-Char                  ( str /str char char_2 -- )
    2SWAP BOUNDS ?DO
        over I C@ = IF  dup I C!  THEN
    LOOP 2DROP ;

: JOIN          ( str_1 /str_1 str_2 /str_2 -- str_3 /str_3)
    >R  THIRD THIRD chars +  R@ MOVE  R> + ;

: CONTAINS?     ( str_1 /str_1 str_2 /str_2 -- str_1 /str_1 flag )
    2over 2SWAP SEARCH NIP NIP ;

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