'**** HEADER ************************************************************
'UINTLIB.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: User Interface Functions for input and selection

'**** FUNCTION DECLARATIONS *********************************************
'core
public   fentrybox()     'centered/formatted input box for string or value
public   keybox()        'centered,horizontal hot key box w/ prompt
public   messbox()       'centered "yes/no" message box
public   popuplist()     'centered arrow select type box
                         '1.04 02/26/91 MS / now accumulates select list as
                         'as selections made, in select order, using a copy
                         'of delstr() to remove choices deselected
public   vkeybox()       'vertical hot key box at row/col

global uistrcnt()        'required by popuplist (from strlib.psl)
global udelstr()         'required by popuplist (from strlib.psl)
'**** VARIABLE DECLARATIONS *********************************************
'library
public fgi bgi scr scc psa dsa fgp bgp fge bge fgs bgs ptstr ptval
public currlib
'core
'    used by popuplist
global   refresh()
global   c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr
global   plist[1,3] drows
'**** CODE **************************************************************

MAIN
local ptpsl
ptpsl = "uintlib"
'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 fgi = 0
     fgi = fginvpleasing
     lock module fgi
end if
if bgi = 0
     bgi = bginvpleasing
     lock module bgi
end if
if fgp = 0
     fgp = fgpleasing
     lock module fgp
end if
if bgp = 0
     bgp = bgpleasing
     lock module bgp
end if
if fge = 0
     fge = fgerror
     lock module fge
end if
if bge = 0
     bge = bgerror
     lock module bge
end if
if fgs = 0
     fgs = fgstandard
     lock module fgs
end if
if bgs = 0
     bgs = bgstandard
     lock module bgs
end if
if ptstr = 0
     ptstr = NULL
     lock module ptstr
end if
if ptval = 0
     ptval = BLANK
     lock module ptval
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
     dsa = NULL
     lock module dsa
end if
if psa = 0
     psa = NULL
     lock module psa
end if
END MAIN


FUNCTION fentrybox(msg,elen,msk,dfalt)
local tgt lmsg mbox r1 r2 c1 c2 c3 c4 errscn
ptstr = NULL
tgt = BLANK
lmsg=len(msg)
mbox = scrwidth
if (lmsg+4) > scrwidth
     return (-2)
end if
r1 = scr-4
r2 = scr+2
if lmsg >= elen
     c3 = int((mbox-lmsg)/2)+1
     c4 = int((mbox-elen)/2)+1
     c2 = c3 + lmsg + 1
     c1 = c3-2
else
     c3 = int((mbox-lmsg)/2)+1
     c4 = int((mbox-elen)/2)+1
     if c4 < 3
          c4 = 3
     end if
     c2 = c4 + elen + 1
     if c2 > scrwidth
          c2 = scrwidth
     end if
     c1 = c4-2
end if
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 (-2)
end if
screen save r1 c1 r2 c2 psa
screen clear box r1 c1 r2 c2 fgp bgp
screen print r1+2 c3 fgp bgp msg
if exact(msk,NULL)=FALSE
     screen input scr c4 fgi bgi elen tgt MASK msk dfalt
else
     if dfalt = NULL
          screen input scr c4 fgi bgi elen tgt
     else
          screen input scr c4 fgi bgi elen tgt dfalt
     end if
end if
screen save r1 c1 r2 c2 dsa
screen shortrestore psa
if tgt = BLANK
     ptstr = NULL
     return (-1)
else
     ptstr = str(tgt)
     return (0)
end if
END FUNCTION 'fentrybox()


function messbox(msg,q,c,e)   'D. Lynn
' msg=message     q=filter for yes/no (0=no filter,1=filter)
' c=color (0=error colors, 1=pleasing)   e=allow escape from "q" filter
local fc2 bc2 fc1 bc1 r1 r2 c1 c2 c3 lmsg mbox k err
err = 0
k=0
if c=0
  fc1=fge
  bc1=bge
  fc2=fge
  bc2=bge
else
  fc1=fgp
  bc1=bgp
  fc2=fgi
  bc2=bgi
end if
mbox = scrwidth
lmsg=len(msg)
if lmsg + 4 > scrwidth
     return (-2)
end if
r1 = scr-2
r2 = scr+2
c3 = int((mbox-lmsg)/2)+1
c1 = c3-2
c2 = c3+lmsg+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 (-2)
end if
screen save r1 c1 r2 c2 psa
screen clear box r1 c1 r2 c2 fc1 bc1
screen print scr c3 fc2 bc2 msg
screen save r1 c1 r2 c2 dsa
if q=0
  wait 2
else
   WHILE "yn" !! k
     locate  scr (c3+lmsg) 1
     k=inchar
     if e=0 and k={Esc}
          err = -1
          exit while
     end if
     k = lower(chr(k))
   END WHILE
     locate  scr (c3+lmsg) 0
end if
screen shortrestore psa
if k = 0
     ptstr = NULL
else
     ptstr = k
end if
return (err)
end function   'messbox()


function popuplist(r1,c1,br,list,msg,num,mnu)
'                                 ^
' requires:                      dsl
'              uistrcnt()

local t hml hm cnum mscn pad padc ret

if exact(trim(list),NULL)=FALSE
     recs = uistrcnt(lisist)
     if recs = 0
          return (-3)
     end if
else
     return (-2)
end if

redimension plist[recs,3]
smartpeek $_l1 hml

if br-r1<1
     return (-4)
elseif br+1 > scrheight
     mr=rheight-1
     msg = ""
else
     mr=br
end if
if br >= hml
     mnu = 0
end if

screen save hml 1 hml scrwidth mscn
if recs > scrheight
     if mnu = 1
          screen clear box hml 1 hml scrwidth 0 0 no-border
          screen print hml 1 bgi bgs "Building list..."
     end if
end if
ptstr=NULL
if mnu = 1
     hm =  case num (0,"Enter = select/unselect   F10 = done   Esc = exit") \
                    (1,"Enter = select   Esc = exit      (select: 1 item)") \
                    else "Enter = select/unselect   F10 = done   Esc = exit  " & \
                         "   (select up to:" & str(num) & "items)"
else
     hm = NULL
end if
sym = spsymmap(28)
cnum=0
blen=0
l=blen
for c=1 to recs
     plist[c,2]=group(list,c)
     l=len(plist[c,2])
     plist[c,1]=0
     if l>blen
        blen=l
     end if
end for
c2=c1+blen+2
r2=r1+recs
if r2>mr
     r2=mr
end if
dc=(c2-c1)
lc=c1+1
pad = case num (1,1) else 2
sc=c1+pad-1
pl=(r2-r1)
padc = repeat(chr(32),pad)
for i = 1 to recs
     pc = 1
     plist[i,2]=padc|format(plist[i,2],"l",dc-1)
     plist[i,3] = i
     if i = pl
          pc=pc+1
     end if
end for
if recs > scrheight
    screen shortrestore mscn
end if
screen save r1 c1 r2+2 c2+pad psa
screen clear box r1 c1 r2+1 c2+pad fgp bgp
pc=1
for c=1 to pl
     screen print c+r1 lc fgp bgp plist[c,2]
end for
if msg > null
     screen print r2+2 c1 fgi bgi str(format(left(msg,dc+pad+1),"M"|str(dc+pad+1)))
end if
if mnu = 1
     screen clear box hml 1 hml scrwidth fgs bgs no-border
     screen print hml 1 fgs bgs (format(hm,"L"|str(scrwidth)))
end if

c=1
rec=1
screen print r1+c lc fgi bgi plist[rec,2]
drows = pl

while TRUE
     k=inchar
     screen print r1+c lc fgp bgp plist[rec,2]
     if plist[rec,1]=1
          screen print r1+c sc fgp bgp sym
     end if
     if k={Down}
          if rec=recs
               if recs<=pl
                    rec=1
                    c=1
               else
                    beep
               end if
          else
               if c = pl
                    screen scroll up r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 1
               end if
               c= case c (pl,c) else (c+1)
               rec=rec+1
          end if
     elseif k={Up}
          if rec=1
               if recs <= pl
                    rec = recs
                    c = pl
               else
                    beep
               end if
          else
               if c = 1
                    screen scroll down r1+1 lc r2 (c2+case num (1,0) else 1) fgp bgp 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
               c=1
          else
               rec=1
               c=1
          end if
     elseif k={^Home}
          if rec = c
               rec = 1
               c=1
          else
               rec = 1
               c=1
               refresh(c,r1,c1,r2,c2,pad)
          end if
     elseif k={End}
          if rec < recs and c < pl
               if drows < pl
                    rec = recs-pl+1
                    refresh(c,r1,c1,r2,c2,pad)
                    rec = recs
                    c = pl
               else
                    if rec+(pl-c) < recs
                         rec = rec+(pl-c)
                         c = pl
                    else
                         rec = recs
                         c = pl
                    end if
               end if
          end if
     elseif k={^End}
          rec = recs-pl+1
          c = 1
          refresh(c,r1,c1,r2,c2,pad)
          c = pl
          rec = recs
     elseif k={PgDn}
          if rec = recs and c = pl
               beep
          elseif c <= pl
               if rec = recs or rec+pl >= recs
                    rec = recs-pl+1
                    c = 1
                    refresh(c,r1,c1,r2,c2,pad)
                    c = pl
                    rec = recs
               else
                    rec = rec+pl
                    refresh(c,r1,c1,r2,c2,pad)
               end if
          end if
     elseif k={PgUp}
          if rec = 1 and c = 1
               beep
          else
               if recs > pl
                    if (rec-pl)-c <= 1
                         c = rec-pl
                         if c < 1
                              c = 1
                         end if
                         rec = 1
                         refresh(1,r1,c1,r2,c2,pad)
                         rec = c
                    else
                         rec=(rec-pl)
                         refresh(1,r1,c1,r2,c2,pad)
                    end if
               else
                    if rec > 1
                         rec=1
                         c=1
                    end if
               end if
          end if
     elseif k={Enter}
          screen print r1+c lc fgi bgi plist[rec,2]
          if num = 1
                    ret=trim(plist[rec,2])
                    exit while
          end if
          if plist[rec,1] = 1
               if udelstr(trim(plist[rec,2]),ret) = 0
                    ret = ptstr
               end if
               plist[rec,1] = 0
               cnum=cnum-1
          else
               if cnum = num and not(num=0)
                    beep
               else
                    ret=trim(ret&plist[rec,2])
                    plist[rec,1] = 1
                    cnum=cnum+1
               end if
          end if
          if rec < recs
               smartpoke $_key {Down}
          end if
     elseif k={Esc}
               ret=null
               exit while
     elseif k={F10}
'          for c=recs to 1 step -1
'               if plist[c,1]=1
'                    ret=ret & trim(plist[c,2])
'               end if
'          end for
          exit while
     end if
if k<> {Enter}
     screen print r1+c lc fgi bgi plist[rec,2]
end if
     if plist[rec,1]=1
          screen print r1+c sc fgi bgi sym
     end if
end while
screen save r1 c1 r2+2 c2+1+pad dsa
screen shortrestore mscn
screen shortrestore psa
clear c k dc lc sc recs c2 r2 l blen pl mr pc sym pg i rec tr drows
redimension  plist[1,3]
if trim(ret) = NULL
     ptstr = NULL
     return (-1)
else
     ptstr = trim(ret)
     return (0)
end if
end function  'popuplist()


function refresh(z,r1,c1,r2,c2,pad)
local x t
screen clear box r1 c1 r2+1 c2+pad fgp bgp
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 fgp bgp plist[t,2]
               drows=drows+1
               if plist[t,1]=1
                    screen print x+1+r1 sc fgp bgp sym
               end if
          end if
     end if
end for
end function  'refresh()


function keybox(lst,msg)
local i t pr tlst l1 l2 mb r1 c1 r2 c2 c3 c4 mc klst c cp dc k
'-----------------------------------------------------------------
'i        = counter
'pr       = user prompt
'r1       = calculated start row for box      / together:
'c1       = calculated start column for box   \ upper left corner
'r2       = calculated end row for box      / together:
'c2       = calculated end column for box   \ lower right corner
'c3       = calculated prompt print column (analysis only)
'c4       = calculated choices print column
'dc       = delta c1,c2
'lst      = passed string group of hot key position|selection item
'msg      = message passed as string
'klst     = a constructed hot key list
'm        = maximum string length
't        = target string in lst
'cp       = passed hot key position for target string
'n        = number of target strings (selection items) & rows
'k        = key pressed
'-----------------------------------------------------------------
pr = "Select, or press Esc:"
ptstr = NULL
tlst = NULL
klst = NULL
l1 = len(pr)
i = 1
while TRUE
     c = value(group(lst,i))
     t = mid(group(lst,i),len(str(c))+1)
     if c > len(t)
          ptstr = "keybox():"&str(chr(34))|mid(group(lst,i),2)|str(chr(34))|", is not"& str(c) & "characters in length"
          return (-2)
     end if
     if c = 0
          if t = NULL
               exit while
          else
               ptstr = "keybox(): no hot key defined for"&str(chr(34))|group(lst,i)|str(chr(34))|", item#"& str(i)
               return (-3)
          end if
     end if
     if lower(klst) ! lower(mid(t,c,1))
          ptstr = "HOT Key duplication:"&"keybox("|str(chr(34)) \
                  |t& \
                  mid(group(lst,match(lower(klst),lower(mid(t,c,1)))),2) \
                  |str(chr(34))| \
                  ") for ->"&str(chr(34))|mid(t,c,1)|str(chr(34))
          return (-4)
     else
          tlst=tlst&t
          klst=klst|mid(t,c,1)
          i=i+1
     end if
end while
tlst = trim(tlst)
l2 = len(tlst)
mb = scrwidth
c3 = int((mb-len(pr))/2) + 1
c4 = int((mb-len(tlst))/2) + 1
if l2 >= l1
     c2 = c4 + len(tlst) + 1
     c1 = c4 - 2
else
     c2 = c3 + len(pr) + 1
     c1 = c3 - 2
end if
r1 = scr-2
r2 = scr+2
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
     ptstr = "keybox():"&str(r1)&str(c1)&str(r2)&str(c2)&"outside of screen dimensions!"
     return (-5)
end if
dc = c2-c1
screen save r1-1 c1 r2+1 c2 psa
screen clear box r1 c1 r2 c2 fgp bgp
screen print scr c4 fgp bgp tlst
screen print r1-1 c1 fgi bgi str(format(pr,"M"|str(dc+1)))
if msg > null
     screen print r2+1 c1 fgi bgi str(format(left(msg,dc+1),"M"|str(dc+1)))
end if
i = 1
while TRUE
     t = group(tlst,i)
     if t = NULL
          exit while
     end if
     c = mid(klst,i,1)
     cp = value(group(lst,i))
     screen print scr c4+cp-1 fgi bgi c
     c4=c4+len(t)+1
     i=i+1
end while
k = NULL
while lower(klst) !! lower(k)
     key name inchar k
     if k = "Esc"
          k = NULL
          exit while
     end if
end while
screen save r1-1 c1 r2+1 c2 dsa
screen shortrestore psa
if k = NULL
     return (-1)
else
     ptstr = lower(k)
     return (0)
end if
end function


function vkeybox(r1,c1,lst,msg)
local klst i m t cp ch[20,6] n r2 c2 k dc
'-----------------------------------------------------------------
'r1       = passed start row for box      / together:
'c1       = passed start column for box   \ upper left corner
'lst      = passed string group of hot key position|selection item
'msg      = message passed as string
'klst     = a constructed hot key list
'i        = counter
'm        = maximum string length
't        = target string in lst
'cp       = passed hot key position for target string
'ch[]     = array used for display of box contents
'ch[i,1]  = target string (selection item)
'ch[i,2]  = "           " display row
'ch[i,3]  = "           " display column
'ch[i,4]  = "           " hot key
'ch[i,5]  = "           " hot key display row
'ch[i,6]  = "           " hot key display column
'n        = number of target strings (selection items) & rows
'r2       = calculated end row for box      / together:
'c2       = calculated end column for box   \ lower right corner
'dc       = delta c1,c2
'k        = key pressed
'-----------------------------------------------------------------
ptstr = NULL
klst=NULL
i = 1
m = 0
while true
     t = group(lst,i)
     if exact(t,NULL) = TRUE
          exit while
     end if
     cp = value(t)
     t = mid(t,len(str(cp))+1)
     ch[i,1] = t
     ch[i,2] = r1+i
     ch[i,3] = c1+2
     ch[i,4] = mid(t,cp,1)
     ch[i,5] = ch[i,2]
     ch[i,6] = ch[i,3]+cp-1
     if cp > len(t)
          ptstr = "vkeybox():"&str(chr(34))|mid(group(lst,i),2)|str(chr(34))|", is not"& str(cp) & "characters in length"
          return (-2)
     elseif cp = 0
          ptstr = "vkeybox(): no hot key defined for"&str(chr(34))|group(lst,i)|str(chr(34))|", item#"& str(i)
          return (-3)
     end if
     if lower(klst) ! lower(ch[i,4])
          ptstr = "HOT Key duplication:"&"vkeybox("|str(chr(34))|ch[i,1]&ch[match(lower(klst),lower(ch[i,4])),1]|str(chr(34))|")  for ->"&str(chr(34))|ch[i,4]|str(chr(34))
          return (-4)
     else
          klst = klst|ch[i,4]
     end if
     if len(t) > m
          m=len(t)
     end if
     i=i+1
end while
n = i-1
r2 = r1+n+1
c2 = c1+m+3
dc = c2-c1
if r2 > scrheight or c2 > scrwidth
     ptstr = "vkeybox():"&str(r1)&str(c1)&str(r2)&str(c2)&"outside of screen dimensions!"
     return (-5)
end if
screen save r1 c1 r2+1 c2 psa
screen clear box r1 c1 r2 c2 fgp bgp
for i = 1 to n step 1
     screen print ch[i,2] ch[i,3] fgp bgp ch[i,1]
     screen print ch[i,5] ch[i,6] fgi bgi ch[i,4]
end for
if msg > null
     screen print r2+1 c1 fgi bgi str(format(left(msg,dc+1),"M"|str(dc+1)))
end if
     screen save r1 c1 r2+1 c2 dsa
k = NULL
while lower(klst) !! lower(k)
     key name inchar k
     if k = "Esc"
          k = NULL
          exit while
     end if
end while
screen shortrestore psa
if k = NULL
     return (-1)
else
     ptstr = lower(k)
     return (0)
end if
end function


function uistrcnt(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
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
return (i)
end function  'uistrcnt()

function udelstr(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  'udelstr()