\ string   11/27/97  gwj
\ implementation of the string word
\ set
create string

: -trailing   ( c-addr u1 -- c-addr u2 ) 
  begin dup 
     if 2dup + 1 chars - c@ 32 = else 0
     then
   while 1- repeat ;

: /string   ( c-addr u1 n -- c-addr u2 ) 
  over min tuck - >r + r> ;

: blank  ( c-addr u -- )   32 fill ;

: cmove  ( c-addr1 c-addr2 u -- )  dup
    if rot swap over + swap
       do i c@ over c! char+ loop
    else 2drop
    then drop  ;

: cmove>  ( c-addr1 c-addr2 u -- ) dup
    if  tuck + rot rot over + 
        do i c@ over c! 1 chars - -1
        +loop
    else 2drop
    then drop ;

\ nonstd word for defining compare
: clean.comp.out   ( n -- n' )
     dup if  0 < if -1 else 1 then then ;

\ nonstd word for defining compare
: compare.begin
  ( c-addr1 u1 c-addr2 u2 -- n )
   rot min ?dup
   if  0 
       do over i + c@ over i + c@ -
             ?dup
              if  nip nip clean.comp.out
                   unloop exit
              then
        loop
   then 
   2drop 0 ;

: compare
   ( c-addr1 u1 c-addr2 u2 -- n )
   rot over over >r >r rot rot
   compare.begin r> r> rot ?dup
   if      nip nip  
   else swap -  clean.comp.out 
   then ;

: uc>lc    ( char -- char' )
      [ char A 1- ] literal over <
      over [ char Z 1+ ] literal  < and
     32 and or
   ;

: icompare.begin
  ( c-addr1 u1 c-addr2 u2 -- n )
   rot min ?dup
   if  0 
       do over i + c@ uc>lc over i + c@ 
             uc>lc -   ?dup
              if  nip nip clean.comp.out
                   unloop exit
              then
        loop
   then 
   2drop 0 ;

: icompare
   ( c-addr1 u1 c-addr2 u2 -- n )
   rot over over >r >r rot rot
   icompare.begin r> r> rot ?dup
   if      nip nip  
   else swap -  clean.comp.out 
   then ;

\ nonstd word for defining search
: scan   ( c-addr1 u1 c -- c-addr2 u2 )
   >r
   begin over c@ r@ <> over and
   while   1 /string
   repeat r> drop ;

: search
 ( c-adr1 u1 c-adr2 u2 -- c-adr3 u3 f )
   over c@ >r 2over
   begin  r@ scan dup
          if   2over 2over 2swap
                compare.begin dup 0=
                swap
          else false dup
          then
   while drop
   repeat
   r> drop >r 2swap 2drop 
   r@ if 2swap then 2drop r> ;
 

: sliteral  ( c-addr1 u -- ) 
>r >r postpone ahead r> here tuck
r@ chars dup allot move >r
postpone then r> postpone literal
r> postpone literal ; immediate