'**** HEADER ************************************************************
'STRLIB.PF3

'This program is the CONFIDENTIAL and PROPRIETARY property of Applied
'Resource Technologies, Inc.  Any unauthorized use, reproduction or
'transfer of this program is strictly prohibited.  This is an unpublished
'work, and is subject to limited distribution and restricted disclosure
'only.  ALL RIGHTS RESERVED.

'Copyright (c) 1990-1991 Applied Resource Technologies, Inc.
'2305 Cedar Springs Road, Suite 150, Dallas, Texas 75201 U.S.A.
'Voice: (214) 855-0449  FAX: (214) 969-7506  BBS: (214) 855-1347

'Description: String manipulation functions

'**** FUNCTION DECLARATIONS *********************************************
'library
'core
public   chkstr()           'verifies if named item is in passed string
public   delstr()           'removes named item if in passed string
public   strcount()          'counts number of items in passed string
public   strtoary()          'converts string group to public array
public   arytostr()          'converts public array to string group
public   replstr()           'global replace of string within a string
'**** VARIABLE DECLARATIONS *********************************************
'library
public ptary[1] ptstr ptval currlib
'core
'**** CODE **************************************************************

MAIN
local ptpsl
ptpsl = "strlib"
'screen clear box scrheight-3 1 scrheight-3 scrwidth 0 0 no-border
'screen print scrheight-3 1 bginvpleasing bgstandard \
'             "Pop-Tools(tm)"&upper(ptpsl)& \
'             "(Copyright 1990-1991 Applied Resource Technologies, Inc.)"

if currlib = 0
     currlib = ptpsl
     lock module currlib
else
     if chr(32)|lower(currlib)|chr(32) !! chr(32)|ptpsl|chr(32)
          currlib = currlib & ptpsl
     end if
end if
if ptary[1]=0
     lock module ptary[]
end if
if ptstr = 0
     ptstr = NULL
     lock module ptstr
end if
if ptval = 0
     ptval = BLANK
     lock module ptval
end if
END MAIN


function chkstr(s,sl)
local t i
'-------------------------------------
's    = string to check
'sl   = string group
't    = targeted item to check
'i    = counter for group() function
'-------------------------------------
'returns  TRUE  = item is in string group
'         FALSE = item is not in list
'-------------------------------------
i=0
while exact(t,NULL)=FALSE
     i=i+1
     t = group(sl,i)
     if t = s
          return (0)
     end if
end while
return (-1)
end function  'chkstr()


function delstr(s,sl)
local t i n f
'-------------------------------------
's    = string to check
'sl   = string group
't    = targeted string to check
'i    = counter for group() function
'n    = new string group
'f    = list changed flag
'-------------------------------------
'returns:  success =  list less item
'          failure =  original list
'-------------------------------------
f=0
i=0
n=NULL
ptstr = NULL
while TRUE
     i=i+1
     t = group(sl,i)
     if exact(t,NULL)=TRUE
          exit while
     elseif t = s
          f=1
     else
          n=n&t
     end if
end while
if f = 1
     ptstr = trim(n)
     return (0)
end if
ptstr = sl
return (-1)
end function  'delstr()


function strcount(sl)
local i s lo hi c
'-------------------------------------
'sl   = string group
'i    = counter for group() function
's    = string counter increment
'lo   = low search record
'hi   = high search record
'c    = temporary equation to find NULL
'-------------------------------------
'returns  count of strings in string
'         group
'-------------------------------------
s=20
ptval = BLANK
while exact(group(sl,s),NULL)=FALSE
     s=s+20
end while
hi = s
lo = 1
while lo <= hi
     i = int((lo+hi)/2)
     c = group(sl,i)
     if c = NULL
          hi = i-1
     else
          lo = i+1
     end if
end while
while (exact(group(sl,i),NULL)=TRUE and i>0)
     i=i-1
end while
if i > 0
     ptval = i
     return (0)
end if
return (-1)
end function  'strcount()


function strtoary(sl)
local i s c
'-------------------------------------
'sl   = string group
'i    = counter for group() function
'c    = counter for array building
'-------------------------------------
'returns    1+ = success (array count)
'           0  = failed (NULL string)
'changes public array ptary[]
'-------------------------------------
strcount(sl)
i = ptval
ptval = BLANK
if i > 0
     redimension ptary[i]
     for c = 1 to i
          ptary[c] = group(sl,c)
     end for
     ptval = i
     return (0)
end if
return (-1)
end function   'strtoary()


function arytostr(ac)
local i sl
'-------------------------------------
'sl   = string group
'i    = counter for group() function
'ac   = array count
'-------------------------------------
'returns    string group
'           -1 = failed
'-------------------------------------
ptstr = NULL
sl = str(ptary[1])
for i = 2 to ac
     if iserr(ptary[i]) = 0
          sl = sl & str(ptary[i])
     else
          return (-1)
     end if
end for
ptstr = sl
return (0)
end function   'arytostr()


FUNCTION replstr(s,f,r)
local t l p
' s  =  big string
' f  =  find string
' r  =  replacement string
ptstr = NULL
t = s
l = len(f)
if iserr(find(f,t,0))=FALSE
     while iserr(find(f,t,p)) = FALSE
          p = find(f,t,p)
          t  = replace(t,find(f,t,p),l,r)
     end while
     ptstr = t
else
     return (-1)
end if
return (0)
END FUNCTION