Simple String Manipulation Words for Forth

 \ Super simple strings package for Forth (circa 1987, Forth79 and Forth83)
 \ Modified for GFORTH 2009-12-10
 \
 \ String Format:
 \	size	byte	alloted string size
 \	count	byte	size of stored string
 \	string	bytes	string data
 \
 \ When executed a string variable returns the address of the count field so
 \ the standard of Forth's counted strings is maintained.

 \ because gforth doesn't have it
 : c+! ( n caddr - ) dup c@ rot + swap c! ;

 \ create a string variable and allocate it's storage
 \ string length initialized to 0
 \ usage: 55 $variable ted$
 : $variable ( u - ) ( - caddr )
   create   $FF and   dup c, 0 c, allot does> 1+ ;

 \ create a string constant
 \ usage: $constant ted$ test string data"
 : $constant ( - ) ( - caddr ) create  " word c@ 1+ allot ;

 \ fetch a string (well, just count it)
 \ caddr1 is the address of a counted string
 : $@ ( caddr1 - caddr2 count ) count ;

 \ print a string
 \ caddr is the address of a counted string
 : $. ( caddr - ) count type ;

 \ return the length of a string
 \ caddr is the address of a counted string
 : len$ ( caddr - n ) c@ ;

 \ return the size of a strings allocated space
 \ caddr is the address of a counted string variable (requires size)
 : size$ ( caddr - n ) 1- c@ ;

 \ return the unused space in a string variable
 : unused$ ( caddr - u ) dup size$ swap len$ - ;

 \ clear a string, just set the length to 0
 : clr$ ( caddr - ) 0 swap c! ;

 \ return copy count limited by the string size
 \ count is the count of the desired characters to copy
 : countlimit ( count caddr - u ) unused$ min ;

 \ return the address of the end of a string
 \ abcdef
 \       ^ meaning this address (just past the f)
 : end$ ( caddr1 - caddr2 ) dup len$ + 1+ ;

 \ append an un-counted string (caddr1 count1) to a string variable (caddr2)
 \ extra characters from caddr1 are lost
 : #$+! ( caddr1 count1 caddr2 - )
   dup >r   dup end$ -rot ( caddr1 caddr2e count1 caddr2 )
   countlimit dup >r   move   r> r> c+! ;

 \ append a counted string (caddr1) to a string variable (caddr2)
 \ extra characters from caddr1 are lost
 : $+! ( caddr1 caddr2 - ) swap count rot #$+! ;

 \ store a un-counted string (caddr1 count1) into a string variable (caddr2)
 \ extra characters in un-counted string are lost
 : #$! ( caddr1 count1 caddr2 - ) dup clr$ #$+! ;

 \ store a counted string (caddr1) into a string variable (caddr2)
 \ extra characters from caddr1 are lost
 : $! ( caddr1 caddr2 - ) swap count rot #$! ;

 \ compare a string (caddr1 count1) to a string variable (caddr2)
 : #$= ( caddr1 count1 caddr2 - n ) count compare ;

 \ compare two string variables
 : $= ( caddr1 caddr2 - n ) swap count rot #$= ;

 \ Words borrowed from BASIC but make me feel comfortable

 \ return n characters from left side of a string variable
 \ count will not exceed the actual number of characters in the string
 : left$ ( n caddr1 - caddr2 count ) count rot min ;

 \ return n characters from right side of a string variable
 \ count will not exceed the actual number of characters in the string
 : right$ ( n caddr1 - caddr2 count ) count rot over   swap - 0 max   /string ;

 \ return n2 characters from string variable starting from n1
 \ count will not exceed the actual number of characters in the string
 : mid$ ( n1 n2 caddr1 - caddr2 count ) -rot over +   rot left$   rot /string ;