       ͻ
        Lesson 6 Part 120  F-PC 3.5 Tutorial by Jack Brown 
       ͼ

            Ŀ
              A Simple Sting Package Case Study. 
            

\  This string package originally appeared in
\  Dr. Dobbs Number 50 and was written by
\  Mr. Ralph Dean

\ Search for end of string addr and leave  string length on top.
: SEARCH ( addr -- len )
    DUP BEGIN                   \ addr addr
        DUP C@                  \ addr addr char
        SWAP 1+ SWAP            \ addr addr+1 char
        0= UNTIL                \ addr addr+1+len
        SWAP -  1- ;            \ len

\ Defining word to create new strings.
: STRING ( len -- )      \ when compiling
         ( -- addr len ) \ when executing
     CREATE ABS 255 MIN 1 MAX   \ len  has been range checked.
     DUP C,
     0 DO 0 C, LOOP 0 C,        \ --   initialize as nulls.
     DOES> 1+ DUP SEARCH ;

\ Store string. Usage:  string1  string2  S!
\ Target string is replaced by new string.
: S!   ( addr1 len1 addr2 len2  -- )
    DROP DUP 1- C@     \ addr1 len1 addr2 mlen
    ROT MIN 1 MAX      \ addr1 addr2 len  <- length to store
    2DUP + 0 SWAP C!   \ addr1 addr2 len  mark end with a null
    MOVE ;

\ Store sub string. Usage: string1 string2  SUB!
\ Only sub string of target is replaced.
: SUB! ( addr1 len1 addr2 len2  -- )
        ROT MIN 1 MAX      \ addr1 addr2 len <- sub string length.
        MOVE ;

\ Temporary storage for string operations.
CREATE TEMP 256 ALLOT

\ Usage:  5 10 string MID$
: MID$ ( posn len1 addr2 len2 -- addr len )
     SWAP >R ROT MIN 1 MAX     \ len1 len2 posn
     SWAP OVER MAX OVER - 1+
     SWAP R> + 1- SWAP
     OVER SEARCH MIN ;

\ Usage: 6 string LEFT$
: LEFT$ ( posn addr1 len1 -- addr len )
    >R >R 1 SWAP R> R> MID$ ;

\ Usage: 6 string RIGHT$
: RIGHT$ ( posn addr1 len1 -- addr len )
    256 -ROT MID$ ;

\ Concatenate two strings.
\ Usage:  string1 string2 S+ string3 S!
: S+ ( addr1 len1 addr2 len2 -- addr len )
     ROT >R ROT R> TUCK
     TEMP SWAP MOVE
     TUCK + 255 MIN DUP >R
     OVER - SWAP TEMP + SWAP MOVE
     R> 0 OVER TEMP + C!
     TEMP SWAP ;

\ Return current string length. Usage: string LEN
: LEN  ( addr len -- len )
     NIP ;

\ Return max string length.  Usage:  string MLEN
: MLEN ( addr len -- mlen )
    DROP 1- C@ ;

\ Convert single number to a string.
: STR$ ( n -- addr len )
     S>D TUCK DABS
     <# 0 HOLD #S ROT SIGN #> 1- ;

\ Convert string to a number.
: VAL ( addr len -- dn )
         PAD 2DUP  C!  1+  SWAP  CMOVE  \ Move string to PAD
         BL PAD COUNT + C!              \ Add a blank at the end
         PAD NUMBER DROP ;

: "   \  " {text}"  ( -- addr len )
    STATE @ IF [COMPILE] "
            ELSE ASCII " WORD
                 PAD 257 ERASE DUP COUNT
                 PAD SWAP MOVE PAD SWAP C@
            THEN ;  IMMEDIATE

Ŀ
   Please Move to Lesson 6 Part 130  

