'**** HEADER ************************************************************
'DISPLIB.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: Display and screen handling functions

'**** FUNCTION DECLARATIONS *********************************************
'core
public   progress()      ' centers a status message
public   progtag()       ' prints a message line below progress()
public   scrollbox()     ' like progress, only msg scrolls left
public   showerr()       ' displays error num & long text
public   spinmark()      ' displays spinmark
public   fgetscncoord()  ' returns coordinates / size of saved screen
                         ' read binary from file
public   getdsacoord()   ' returns coordinates / size of saved screen
                         ' from actual screen variable dsa
public   relperf()       ' calculates a system "relative performance"
'**** VARIABLE DECLARATIONS *********************************************
'library
public  scc scr psa dsa ptstr ptval currlib
'core
global ret          ' return created by progress(), used by progtag()
global spin         ' spinmark incrementor

'**** CODE **************************************************************

MAIN
local ptpsl
ptpsl = "displib"
'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 scc = 0
     scc = int(scrwidth/2)
     lock module scc
end if
if scr = 0
     scr = int(scrheight/2)
     lock module scr
end if
if dsa = 0
     lock module dsa
end if
if psa = 0
     lock module psa
end if
if ptstr = 0
     ptstr = NULL
     lock module ptstr
end if
if ptval = 0
     ptval = BLANK
     lock module ptval
end if
ret = NULL
END MAIN


function progress(fg,bg,msg,ptag)
local mbox r1 r2 c1 c2 c3
ptstr = NULL
ret = NULL
mbox = scrwidth
if len(msg) + 4 > scrwidth
     return (-1)
end if
r1 = scr-2
r2 = scr+2
if ptag = 1
     r2=r2+1
end if
c3 = int((mbox-len(msg))/2)+1
c1 = c3-2
c2 = c3 + len(msg) + 1
if c1 <= 0
     c1 = 1
end if
if (c1-1) < 12
     while (c1-1) < (scrwidth-c2)
          c2=c2+1
     end while
end if
if c2 > scrwidth
     return (-1)
end if
screen save r1 c1 r2 c2 psa
screen clear box r1 c1 r2 c2 fg bg
screen print scr c3 fg bg msg
screen save r1 c1 r2 c2 dsa
ptstr = str(scr)&str(c1)&str(c2-c1)
ret   = str(scr)&str(c1)&str(c2-c1)
return (0)
end function 'progress()


function progtag(fg,bg,msg)
' utilizes the return from progress() function
local row col size
if exact(ret,NULL) = FALSE
     row=val(group(ret,1))+1
     col=val(group(ret,2))+1
     size=str(val(group(ret,3))-1)
     screen print row col fg bg (format(msg,"M"|size))
     return (0)
end if
return (-1)
end function


function showerr(enum)
local etxt
ptstr = NULL
etxt = errortext(enum)
if left(etxt,7) == "unknown"
     return (-1)
else
     ptstr = "ERROR"&str(enum)|": "|etxt
return (0)
end if
end function


function scrollbox(fg,bg,msg,w)
local mbox r1 r2 c1 c2 c3 i k x nmsg p1 p2
ptval = BLANK
mbox = scrwidth
if len(msg) + 4 > scrwidth
     return (-1)
end if
r1 = scr-2
r2 = scr+2
c3 = int((mbox-len(msg))/2)+1
c1 = c3 -2
c2 = c3 + len(msg) + 1
if c1 <= 0
     c1 = 1
end if
if (c1-1) < 12
     while (c1-1) < (scrwidth-c2)
          c2=c2+1
     end while
end if
if c2 > scrwidth
     return (-1)
end if
screen save r1 c1 r2 c2 psa
screen clear box r1 c1 r2 c2 fg bg
screen print scr c3 fg bg msg
screen save r1 c1 r2 c2 dsa
wait .2
k = 0
while k = 0
     screen print scr c3 fg bg msg
     nmsg=msg|chr(32)
     for i = 1 to len(msg) step 1
          for x = 1 to 5*w
               k = nextkey
          end for
          if k <> 0
               exit for
          end if
          p1 = mid(nmsg,2)
          p2 = left(nmsg,1)
          nmsg = p1|p2
          screen print scr c3 fg bg left(nmsg,len(msg))
     end for
     screen print scr c3 fg bg msg
     if k <> 0
          exit while
     end if
     for x = 1 to w*5
          k = nextkey
          if k <> 0
               exit for
          end if
     end for
     if k <> 0
          exit while
     end if
     for i = len(msg)-1 to 0 step -1
          screen print scr c3+i fg bg "."
          for x = 1 to w
               k = nextkey
          end for
          if k <> 0
               exit for
          end if
     end for
     if k <> 0
          exit while
     end if
     for i = 0 to len(msg)-1 step 1
          screen print scr c3+i fg bg mid(msg,i+1,1)
          for x = 1 to w
               k = nextkey
          end for
          if k <> 0
               exit for
          end if
     end for
end while
ptval = k
inchar
return (0)
end function 'scrollbox()


function spinmark(r,c,f,b)
local m
m="|/-\|/-\"
spin = case spin (8,1) else spin+1
screen print r c f b mid(m,spin,1)
end function 'spinmark()


function fgetscncoord(scn,fnum)
local r nr c nc x e fsize
'-------------------------------------------------------------
'scn = <path>filename to valid saved screen
'r   = starting row
'nr  = number of rows in screen
'c   = starting column
'nc  = number of columns
'x   = memory variable read from saved screen
'e   = cummulative error
'-------------------------------------------------------------
'returns: (0) if successful
'         ptstr = string (r nr c nc)
'         -1, not able to open file
'         -2, not a valid saved screen
'-------------------------------------------------------------
ptstr = NULL
fopen scn as fnum
if cerror = 0
     fseek fnum EOF
     fposition fnum into fsize
     fseek fnum 0
     fread fnum binary 10 into x
     fclose fnum
     if x[1] = 0x00 and x[2] = 0x53
          r  = (int(x[3]+(x[4]*256)))
          nr = (int(x[5]+(x[6]*256)))
          c  = (int(x[7]+(x[8]*256)))
          nc = (int(x[9]+(x[10]*256)))
          ptstr = str(r) & str(nr) & str(c) & str(nc) & str(fsize)
     else
          e = -2
     end if
else
     e = -1
end if
return (e)
end function  'fgetscncoord()


function getdsacoord()
local r nr c nc e
'-------------------------------------------------------------
'get coordinates for saved screen variable "dsa"
'r   = starting row
'nr  = number of rows in screen
'c   = starting column
'nc  = number of columns
'e   = cummulative error
'-------------------------------------------------------------
'returns: string (r nr c nc) if successful
'         -1, not a valid saved screen
'-------------------------------------------------------------
ptstr = NULL
if dsa[1] = 0x00 and dsa[2] = 0x53
     r  = (int(dsa[3]+(dsa[4]*256)))
     nr = (int(dsa[5]+(dsa[6]*256)))
     c  = (int(dsa[7]+(dsa[8]*256)))
     nc = (int(dsa[9]+(dsa[10]*256)))
     ptstr = str(r) & str(nr) & str(c) & str(nc)
else
     e = -1
end if
return (e)
end function  'getdsacoord()


function relperf()
' calculated relative performance index "rpi"
local rpi i j scn l1
smartpeek $_l1 l1
ptval = BLANK
rpi = 0
j = now
screen save l1 1 l1 scrwidth scn
screen print l1 1 bginvpleasing bgstandard \
     (format("Computing relative performance index","L"|str(scrwidth)))
while now-j < .00003
     rpi=rpi+.01
end while
ptval=round(rpi,0)
screen shortrestore scn
end function  'relperf()