'**** HEADER ************************************************************
'WRAPTEXT.PF3
'wraptext()

'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: displays, with justification, blocks of text

'**** FUNCTION DECLARATIONS *********************************************
'library
'core
public   wraptext()
'**** VARIABLE DECLARATIONS *********************************************
'library
public psa dsa ptary[1] ptval currlib
'core
global   pgtxt()
global   regen()
global   wreplstr()
'**** CODE **************************************************************

MAIN
local ptpsl
ptpsl = "wraptext"

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 dsa = 0
     dsa = NULL
     lock module dsa
end if
if psa = 0
     psa = NULL
     lock module psa
end if
if ptval = 0
     ptval = BLANK
     lock module ptval
end if
END MAIN


FUNCTION wraptext(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg)

local wc p0 p1 p2 d dr dc a b c line1 lnmsg lmscn
local dlm rs ps ls fmt pcnt eot lts max

' uses: pgtext()
'-------------------------------------------------------------
' returns:     #  =  0  if  sprn = 1  else # of prary[] elements
'                                            (see ptary[#] below)
'             -1  =  no text string to print
'             -2  =  invalid row/col coordinates
'        ptary[#] =  if sprn = 0 (i.e. "no screen print")
'                    array containing word wrapped text will
'                    be nulled (redimensioned) else ptary[#]
'                    will be left available.
'-------------------------------------------------------------
'r1       ' upper left row
'r2       ' lower right row
'c1       ' upper left column
'c2       ' lower right column
'fg       ' foreground color
'bg       ' background color
'ts       ' text string
'jst      ' justification  ("l"=left) or ("m"= middle) or ("r" = right)
'sprn     ' screen print (1 = yes) or (0 = no )
'sml      ' shrink rows to fit end of text ( 1 = yes ) or ( 0 = no )
'pg       ' page up / down option ( 1 = paging ) ( 0 = no paging )
'dc       ' delta c2,c1
'dr       ' delta r2,r1
'wck      ' word check avg length - used in (dc - wc) regressive checks
'a        ' counter
'b        ' counter
'c        ' counter
'p0       ' pointer position 0 (start)
'p1       ' pointer position 1 (end)
'p2       ' pointer position 2 (next start)
'dlm      ' delimiter (space)
'rs       ' remaining string
'ps       ' print string
'ptary[]  ' public poptools array
'pcnt     ' print rows (from counter (a)  )
'fmt      ' format
'eot      ' end of text flag
'lts      ' lenght of ts
'max      ' maximum number of array elements
'lnmsg    ' Loading text...
'line1    ' smart message line
'lmscn    ' message saved screen area

smartpeek $_l1 line1
max  = 1000
if r2 > scrheight
     r2 = scrheight
end if
if c2 > scrwidth
     c2 = scrwidth
end if
dc   = (c2 - c1) - 2
dr   = (r2 - r1) - 1

ts = wreplstr(ts,chr(126),chr(32))

lts = len(ts)
if lts = 0
     return (-1)
end if

lnmsg = "Formatting..."
screen save line1 1 line1 len(lnmsg) lmscn
screen print line1 1 bginvpleasing fginvpleasing format "L"|str(len(lnmsg)) lnmsg

if dc<1 or dr<1 or dc>scrwidth or dr>scrheight or r1<1 or c1<1
     return (-2)
end if
a    = 0
eot  = 0
wc   = 2
dlm  = chr(32)
rs   = ts
redimension ptary[max]
while a <= max
     a = a + 1
     if len(rs) <= dc
          ptary[a] = rs
          exit while
     end if
     ls = left(rs,dc)
     p1 = len(ls)
     for b = p1 to 0 step (-wc)
          if mid(ls,b,wc) ! dlm
               p2 = find(dlm,mid(ls,b,wc),0)
               ptary[a] = left(ls,(b+p2-1))
               ls = mid(ls,b+p2)
               p0 = len(ls)
               for c = 1 to p0
                    if mid(ls,c,1) <> dlm
                         exit for
                    end if
               end for
               rs = mid(rs,(b+p2+c-1))
               exit for
          end if
     end for
     if b <= 0
          ptary[a] = ls
          rs = mid(rs,p1+1)
          while left(rs,1) = dlm
               rs = mid(rs,2)
          end while
     end if
end while
'a = case a (dr+1,a-1) else a
screen shortrestore lmscn
if sprn = 1
     fmt  =  (case lower(jst) ("r",jst)("m",jst) else "l")|str(dc)
     if sml = 1
          if (r1+a) < r2
               r2 = r1+a+1
               dr   = (r2 - r1) - 1
          end if
     else
          if a < dr
               if (r1+a) < r2
                    for b = a+1 to dr
                         ptary[b] = " "
                    end for
               end if
          end if
     end if
     b = dr
     screen save r1 c1 r2 c2 psa
     screen clear box r1 c1 r2 c2 fg bg
     for pcnt = 1 to b
          screen print (r1+pcnt) c1+2 fg bg format fmt ptary[pcnt]
     end for
     if pg = 1
          pgtxt(a,r1,c1,r2,c2,dr,fg,bg,fmt)
     end if
     screen save r1 c1 r2 c2 dsa
     redimension ptary[1]
end if
ptval = a
return (0)
END FUNCTION   'wraptext(r1,c1,r2,c2,fg,bg,ts,jst,sprn,sml,pg)



function pgtxt(recs,r1,c1,r2,c2,dr,fg,bg,fmt)
local t hml hm cnum mscn blen l dc lc sc pl pc c rec k
local drows sym

sym=spsymmap(28)

if recs = 0
     return (-1)
end if
blen=0
l=blen
dc=(c2-c1)--2
lc=c1+2
sc=c1+1
pl=(r2-r1)-1
pc=1
c=1
rec=1
drows = pl
while TRUE
     screen print r1+c lc fg bg format fmt ptary[rec]
     screen print r1+c sc fg bg sym
     k=inchar
     screen print r1+c sc fg bg chr(32)
     if k={Down}
          if rec=recs
               beep
          else
               if c = pl
                    screen scroll up r1+1 lc r2-1 c2-1 fg bg 1
               end if
               c= case c (pl,c) else (c+1)
               rec=rec+1
          end if
     elseif k={Up}
          if rec=1
               beep
          else
               if c = 1
                    screen scroll down r1+1 lc r2-1 c2-1 fg bg 1
               end if
               c= case c (1,c) else (c-1)
               rec=rec-1
          end if
     elseif k={Home}
          if c>1
               if rec =(rec-c)+1
                    rec = 1
               else
                    rec =(rec-c)+1
               end if
               if rec <= 0
                    rec = 1
               end if
               c=1
          end if
     elseif k={^Home}
          if rec = c
               rec = 1
               c=1
          else
               rec = 1
               for c = 1 to dr
                   screen print (r1+c) c1+2 fg bg format fmt ptary[c]
               end for
'               drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
               c=1
          end if
     elseif k={End}
          if rec < recs and c < pl
               if drows < pl
                    rec = recs-pl+1
                    drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
                    rec = recs
                    c = pl
               else
                    if rec+(pl-c) < recs
                         rec = rec+(pl-c)
                    else
                         rec = recs
                    end if
                    if pl > recs
                         c = recs
                    else
                         c = pl
                    end if
               end if
          end if
     elseif k={^End}
        if dr >= recs
          c = recs
          rec = recs
        else
          rec = recs-pl+1
          c = 1
          drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
          c = pl
          rec = recs
        end if
     elseif k={PgDn}
       if dr >= recs
          c = recs
          rec = recs
       else
          if rec = recs and c = pl
               beep
          elseif c <= pl
               if rec = recs or rec+pl >= recs
                    rec = recs-pl+1
                    c = 1
                    drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
                    c = pl
                    rec = recs
               else
                    rec = rec+pl
                    drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
               end if
          end if
       end if
     elseif k={PgUp}
          if rec = 1 and c = 1
               beep
          else
               if (rec-pl)-c <= 1
                    if rec = c
                         rec = 1
                         c=1
                    else
                         rec = c
                         drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
                     end if
               else
                    rec=(rec-pl)
                    drows = regen(c,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
               end if
          end if
     elseif k={Esc}
          exit while
     end if
end while
end function  'actlist()


function regen(z,r1,c1,r2,c2,pl,rec,recs,lc,fg,bg,fmt)
local x t drows
screen clear box r1 c1 r2 c2 fg bg
drows = 0
for x=0 to pl-1
t = rec-z+x+1
     if t > recs
          exit for
     else
          if t > 0
               screen print x+1+r1 lc fg bg format fmt ptary[t]
               drows=drows+1
          end if
     end if
end for
return (drows)
end function  'regen()


FUNCTION wreplstr(s,f,r)
local t l p
' s  =  big string
' f  =  find string
' r  =  replacement string
t = s
l = len(f)
p = 0
while iserr(find(f,t,p)) = FALSE
     p = find(f,t,p)
     t  = replace(t,find(f,t,p),l,r)
end while
return (t)
END FUNCTION