'STRINGRX Function Package - Bill McDaniel 11/30/2013
' A set of String manipulation functions 
' for BASIC from REXX that are useful to have
' Best viewed in landscape on iPad - SmartBASIC V3+ dependent

' Many of these are based on the built-in SmartBASIC
' SUBSTR$ function which is sensitive to OPTION BASE, 
' So each function forces it to 1, then restores it  
' on exit. These functions assume the first character 
' in a string is character number 1. 
' Some of these functions use the new V3 built-in functions
' INSTR and OPTION_BASE(). INSTR calls use the Haystack,Needle parameter order
' so this file requires SmartBASIC V3

' =======================================
' REXX language functions are below here
' =======================================

' =======================================
' STRING$ returns a string of chars of specified length 
def STRING$(l,f$)
  for i = 1 to l
    s$ = s$ & f$
  next i
  string$ = s$
end def

' =======================================
' PARSE parses a string and tokenizes it into an array
' The string is parsed using a string of stop chars
' Each token is placed in an element of the passed array
' The array is cleared first and parse returns the number of 
' elements that were loaded. If the array was too small,
' parsing will stop and the returned number will be negative
' to avoid that, dim the array to the length of the string
' to insure enough elements. Actually int(len(s$)/2) will always be enough
' This function is replaced by the SPLIT command in V3, but I left it here
' SPLIT probably runs faster, but this is quite quick

def PARSE(s$,p$,a$())
  ob = option_base()      
  option base 1                ' set base to 1
  get dim a$ xsize x           ' get the array size
  for i = 1 to x               ' clear the array
    a$(i) = ""
  next i

  if s$ = "" then              ' if s$ is null
    n=0                        ' nothing is returned
  else
    n = 1                        ' init the element number
    for i = 1 to len(s$)         ' scan the string
      c$ = mid$(s$,i,1)          ' get a char from the string
      if instr(p$,c$,1) <= 0 then' is it a stop char? haystack,needle
        if startanother then     ' no...do we start a token?
          n = n + 1                 ' yes...increment element
          startanother = 0          '    and turn off the flag
        end if
        a$(n) = a$(n) & c$       ' add the char to the token
      else
        if n = x then            ' yes...are we out of array?
          n = -n                    'yes...negate the return
          break i                   '  then exit the loop
        else
          if a$(n) <> "" then       'no...start a new one?
            startanother = 1        '  yes...just set flag
          end if
        end if
      end if
    next i                    ' finish scanning the string
  end if
  parse = n               ' and set the return code
  if ob = 0 then option base 0
end def

' ================================
' TRANSLATE transforms one string into another
' Remember that translate can be used to reorder a string
' an empty table causes nothing to happen
' Translate("4321","abcd","1234") = "dcba"...uses our arg string as tblout
def TRANSLATE$(s$,tblout$,tblin$)
  ob = option_base()
  option base 1
  out$ = ""                         ' clear output
  if tblout$ <> "" then
    for i = 1 to len(s$)            ' scan string
      c$ = mid$(s$,i,1)             '   get next char out of string
      p = instr(tblin$,c$)          '   look for it in tblin...haystack,needle
      if p > 0 then                 '   character found in table?
        c$ = mid$(tblout$,p,1)      '   yes, replace it with char from output table
      end if                          
      out$ = out$ & c$              ' accumulate the char into output buffer
    next i                          ' get next char of string
  endif                    
  translate$ = out$                 ' return accumulated string
  if ob = 0 then option base 0
end def

' ==================================
' CENTER$ returns a string centered in a longer string
' if the required pad length is odd, there will be one 
' less char on the right than on the left of the string
def CENTER$(s$,n,p$)
if len(s$) <= n then               ' string to center less than length to use?
  padlen = int((n - len(s$)) / 2)  ' yes...calculate a rounded half
  x$ = string$(padlen,p$)          '   build a string of pad chars
  center$ = left$(x$ & s$ & x$,n)  '   build the full string, truncing on the right
else
  center$ = left$(s$,n)            ' no...return first n chars of string
end if
end def

' =====================================
' CENTRE$ is exactly like CENTER$ but with British spelling
def CENTRE$(s$,l,p$) = center$(s$,l,p$)       ' just use the center function

' ======================================
' SUBWORD$ returns the nth word in a string s$
def SUBWORD$(s$,n)
  ob = option_base()
  option base 1
  if n > 0 then                     ' is n a valid number?
    dim a$(int(len(s$)/2))          '   yes...dim a big enough array
    i = parse(s$," ",a$)            '     parse the string on blanks
    if n > i then                   '     is n greater than word count?
      subword$ = ""                 '       yes...no words in it then
    else                            '       no
      subword$ = a$(n)              '         then return the nth element of array
    end if
  else
    subword$ = ""                   '   no...return a null
  end if
  if ob = 0 then option base 0
end def

' ======================================
' WORDS returns the number of words in a string
' wordss are space delimited. This uses my PARSE function
' but lines for the new SPLIT command are included and work fine
def WORDS(s$)
  if s$ <> "" then                     ' do we have a null string?
    dim a$(int(len(s$)/2))             '   no…so create an array of sufficient size
    words = parse(s$," ",a$)           '     fill using PARSE function
   'split s$ to a$,n with " "          '     alternative using SPLIT command
   'words = n                          '       to use SPLIT, two lines are required
  else
    words = 0                          '   yes…then return zero
  end if
end def

' =======================================
' WORDINDEX returns the char position of the nth word
' this is an exact duplication of the INSTR function
' except the arguments are passed in as (needle,haystack,position)
' the  built-in INSTR function expects (haystack,needle,[position])
def WORDINDEX(w$,s$,sp)
  ob = option_base()
  option base 1
  wordindex  = instr(s$,w$,sp)        ' Just use INSTR
  if ob = 0 then option base 0
end def

' ========================================
' WORDLENGTH returns the length of the nth word in string
' it just gets the nth word using subword and then returns its length
' subword$ handles bounds checking
def WORDLENGTH(s$,n) = len(subword$(s$,n))    ' A one line function, hurrah!

' ========================================
' WORDPOS returns the number of the first word in a phrase
' The first word is word 1 
' (all these functions assume strings start at position 1). 
def WORDPOS(w$,s$,sp)
  ob = option_base()
  option base 1
  wp = wordindex(w$,s$,sp)     ' get the position of the needle string, w$
  if wp > 0 then               ' is the needle present in the haystack?
    e$ = left$(s$,wp)          '   yes...extract words up to the match
    if wp > 1 then             '     is it present later than position 1? 
      wordpos = words(e$)      '       yes...the pos is number of words
    else                       '     no...handle the edge case of word 1
      wordpos = 1              '       the match starts the haystack 
    end if         
  else                         '   no ... the needle is not in haystack
    wordpos = 0                '     return 0
  end if
  if ob = 0 then option base 0
end def
' ========================================