  'STRINGUTIL.INC

  '=============================
  'OXYGEN BASIC STRING UTILITIES
  '=============================

  '12:44 20/02/2011
  '10:35 29/11/2011
  '14:04 11/02/2013
  '21:23 05/06/2014
  '20:12 03/03/2015
  '16:43 18/05/2015
  '21:16 07/03/2017
  '09:04 20/09/2017
  '05:41 30/04/2018
  '04:35 03/08/2019
  '10:30 08/02/2026
  '
  'Charles E V Pegge
  '

  uses generics

  'int xxx[100]
  string cr,tab,qu,sp,cm
  cr=chr(13,10)
  tab=chr(9)
  qu=chr(34)
  sp=chr(32)
  cm=chr(44)


  sub inserts(string *s, int i, string w)
  =======================================
  s=left(s,i-1)+w+mid(s,i)
  end sub


  function padstr(string d="",int lmar=1,wid=14,rmar=1) as string
  ===============================================================
  string s=string(wid," ")
  mid(s,1,d) 'd will be right clipped
  function=string(lmar," ")+s+string(rmar," ")
  end function


  function numstr(double v=0.0, int wid=9,rmar=1,dp=2) as string
  ==============================================================
  string s,ng
  int n,ls
  if v<0
    v=-v
    ng="-"
  endif
  n=10^dp
  s=str(round(v*n))
  ls=len(s)
  if ls<=dp
    s=string(dp+1-ls,"0")+s
  endif
  if dp
    ls=len(s)
    s=ng+left(s,ls-dp)+"."+mid(s,-dp)
  else
    s=ng+s
  endif
  ls=len(s)
  if ls>wid 'ensure number is never clipped
    wid=ls
  endif
  function=string(wid+rmar," ")
  mid(function,wid-ls+1,s)
  end function


  function CountCr(string s) as int
  =================================
  int c,p
  do
    p=instr(p+1,s,cr)
    if p=0 then exit do
    c++
  end do
  return c
  end function


'Elastic String array
'
'
=================
class StringArray
=================

  int en
  int mx
  int id
  bstring list

  indexbase 1


  method constructor()
  ====================
  list=nuls 1024*sizeof sys
  en=1024
  end method


  method clear()
  ==============
  int i
  sys q at strptr list
  for i=1 to mx
    frees q : q=0
    stride q
  next
  mx=0
  id=0
  end method


  method destructor()
  ===================
  clear()
  frees list : ?list=0
  en=0
  end method

  method length(int i) as int
  ===========================
  if i>mx then return 0
  bstring * t : &t=?list
  id=i
  if i>0 then return len t[i]
  end method

  method line(int i, string s)
  ============================
'okq
  int a
  if i>en then
    a=(i+4096-en)*sizeof sys
    en=4096+i
    list+=nuls a
  end if
  bstring t at strptr list
  if i>0 then
    t[i]=s
    if mx<i then mx=i
  end if
  id=i
  end method


  method insert(int i, string s)
  ==============================
  int a,e,w
  if i>mx+1 then exit method
  w=sizeof sys
  mx+=1
  en+=1
  if i>0 then
    a=i*w-w 'strings below i
    inserts list, a+1, nuls(w) 'alter list of pointers only
    bstring t at strptr list
    t[i]=s
  end if
  id=i
  end method


  method pastelines(int *i, string s)
  ===================================
  if i=0 or i>mx+1 then exit method
  int a,c,e,k,w,p1,p2
  w=sizeof sys
  c=CountCr s
  if c=0 then exit method
  mx+=c
  en+=c
  a=i*w-w 'strings below i
  inserts list,a+1, nuls(w*c) 'alter list of pointers only
  bstring t at strptr list
  e=i+c-1
  p1=1
  for k=i to e
    p2=instr p1,s,cr
    t[k]=mid s,p1,p2-p1
    p1=p2+len cr
  next
  i+=c
  id=i
  end method


  method append(string s)
  =======================
  insert mx+1,s
  end method


  method delete(int i)
  ====================
  if en=0 then exit method
  if mx=0 then exit method
  if i>mx then exit method
  int w=sizeof sys
  en-=1 : mx-=1
  if i>0 then
    int a
    bstring t at strptr list
    frees t[i]
    a=i*w-w
    list=left(list,a)+mid(list,a+w+1) 'alter list of pointers only
    mx-=1
  end if
  id=i
  end method


  method copylines(int i,j) as string
  ===================================
  if en=0 or mx=0 or i=0 or i=j then exit method
  int e,k,w
  if i>j
    k=j : j=i : i=k 'swap
    i++
    j++
  end if
  if i>mx then exit method
  if j>mx then j=mx
  k=j-i
  en-=k : mx-=k
  bstring t at strptr list
  bstring b
  e=j-1
  w=sizeof sys
  for k=i to e
    b+=t[k]+cr
  next
  id=i
  return b
  end method


  method cutlines(int *i,*j) as string
  ====================================
  if en=0 or mx=0 or i=0 or i=j then exit method
  int e,k,w,clp
  clp=i
  if i>j
    clp=j
    k=j : j=i : i=k 'swap
    i++
    j++
  end if
  if i>mx then exit method
  if j>mx then j=mx
  k=j-i
  en-=k : mx-=k
  bstring t at strptr list
  bstring b
  e=j-1
  w=sizeof sys
  for k=i to e
    b+=t[k]+cr
    frees t[k]
  next
  list=left(list,i*w-w)+mid(list,e*w+1) 'alter list of pointers only
  id=i
  j=clp 'set CurLinePos
  return b
  end method


  method line(int i) as bstring
  =============================
  bstring * t : &t=?list
  if i>0 then
    if i<=mx then
      id=i
      return t[i]
    end if
  end if
  end method


  method lines(string s) as int
  =============================
  '
  'store lines from text input
  '
  int i=0, a=1, b=1, et=0
  string t
  clear()
  do
    b=instr(a,s,cr)
    if b=0 then
      b=len(s)+1
      et=1
      if b=1 then return 0 'empty line
    end if
    i+=1
    t=mid(s,a,b-a)
    line(i)=t
/*
print "okq " t
''line
  int ii,aa
  ii=i
  if ii>en then
    aa=(ii+4096-en)*sizeof sys
    en=4096+ii
    list+=nuls aa
  end if
  bstring tt at strptr list
  if ii>0 then
    tt[ii]=t
    if mx<ii then mx=ii
  end if
  id=ii
''
*/
    if et then
      if a=b then i-=1 : mx-=1 'null line at end
      'del t
      return i 'number of lines
    end if
    a=b+2 'skip cr for next line
  end do
end method  


  method lines() as string
  ========================
  '
  'return whole text
  '
  int i=1, la=1, ls, le, e
  string s="" : e=mx
  do
    if i>e then exit do
    le=length(i)+2
    if la+le>ls then
      s+=nuls le+0x10000 'add more space to buffer
      ls+=le+0x10000
    end if
    mid(s,la)=line(i)+cr
    la+=le
    i+=1
  end do
  return left s,la-1
  end method


  method sortlines(int descend=0)
  ===============================
  '
  int i,j,k
  int nd=mx
  '
  'BUFFERS
  bstring *ss
  @ss    = strptr list
  '
  macro compare(sw,i,j)
  =====================
    'COMPARE STRINGS
    if descend then 
      if ss[i]<ss[j] then sw=1 'DESCENDING
    else
      if ss[i]>ss[j] then sw=1 'ASCENDING
    end if
  end macro
  '
  mergeSort(index,nd,compare)
  '
  'RE-ORDER LINES
  bstring lists=list
  sys ps at strptr lists
  sys qs at strptr list
  for i=1 to nd
    j=index[i]
    qs[i]=ps[j]
  next
  frees lists
  freememory @index
  end method



  method LastLine() as int
  ========================
  return mx
  end method

  method LineCount() as int
  ========================
  return mx
  end method


  method BaseLine(int i)
  ======================
  if i<0 or i>mx then exit method
  id=i
  end method


  method NextLine(string*s,int*i)
  ===============================
  if id>=mx
    i=0
  else
    id++
    i=id
    s=line(i)
  end if
  end method


  method locate(string w, int *i,*j) as int
  =========================================
  'case insensitive
  'returns linepos i and charpos j
  '
  int e
  string s,k
  k=lcase w
  e=mx
  if i<1 then i=1
  if j<1 then j=1
  do
    if i>e then exit do
    s=lcase line(i)
    if len s then j=instr j,s,k else j=0
    if j
      id=i
      return i
    else
      j=1
    end if
    i+=1
  end do
  i=0 : j=0
  end method

 
  method load(string n) as int
  ============================
  string s
  s=getfile n
  return lines s
  end method  


  method save(string n)
  =====================
  putfile n,lines()
  end method  

end class 'StringArray


def TextArray StringArray