'**** HEADER ************************************************************
'EXINDX04.PF3 (release .02)
'Copyright (c) 1990-1991 Applied Resource Technologies, Inc.
'P.O. Box 64381, Dallas, Texas 75206 U.S.A. (214) 855-0449
'Description: Demonstrates practical applications of INDEXLIB functions
'**** FUNCTION DECLARATIONS *********************************************
'library
external progress() scrollbox() relperf() progtag()         'displib
external messbox() fentrybox()                              'uintlib
external navrecs()                                          'dfilelib
external remove()                                           'filelib
external vloadif()                                          'dfilelib
external chkstr() delstr()  strcount()                      'strlib()
external makeidx() addidxrec() delidxrec()                  'indexlib()
'core
global scr_setup() clr_scr()
global scr_select() add_item() del_item() find_item() scr_done()
global confirm() scr_exit() abort()
'**** VARIABLE DECLARATIONS *********************************************
'library
external fgs bgs fgi bgi fgp bgp fge bge rpi                'environment
external scw sch lpath psa dsa scc currlib ptstr ptval      'environment
external dpath      ' release .02
'core
global dfname       'main data file
global idxname      'temporary index name
global fnum         'file number for index I/O
global sview        'select view (scratch)
global iview        'index view (delete)
global sprec        'selected record physical record number
global sel_str      'selection string
global scount       'selection count
global pline        'prompt line
global pline_scr    'prompt line saved prior screen area
'**** CODE **************************************************************

MAIN
if scr_setup() = 0
     scr_select()
     scr_exit(0)
else
     abort()
     scr_exit(-1)
end if
END MAIN

function scr_select()
local k
scount = 0
sel_str = NULL
repaint on
repaint
while TRUE
     screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
     k = navrecs()
     sprec = precord
     if k = {Esc}
          if confirm("cancel") = TRUE
               exit while
          end if
     elseif k = {A} or k = {a}
          if chkstr(str(precord),sel_str)=TRUE
               beep
          else
               sel_str = sel_str & str(precord)
               scount = scount+1
               add_item(precord)
          end if
     elseif k = {D} or k = {d}
          del_item()
     elseif k = {F} or k = {f}
          find_item()
     elseif k = {F10}
          if confirm("save selections") = TRUE
               scr_done()
               exit while
          end if
     else
          beep
     end if
end while
repaint off
end function  'scr_select()

function add_item(p)
local crec
repaint off
screen print pline-1 1 fgi bgi format "L"|str(scw) (format("    ADD   ","M40"))
data goto window next
crec = record
order change physical
addidxrec(idxname,p,fnum)
repaint on
order change index idxname
screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
data goto window next
screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE    ","M40"))
end function   'add_item()

function del_item()
local crec k cpos
repaint off
data goto window next
repaint
screen shortrestore pline_scr
while TRUE
     repaint on
     screen print pline-1 1 fgi bgi format "L"|str(scw) (format("    ACTIVE   ","M40"))
     k = navrecs()
     sprec = precord
     crec = record
     if k = {Esc}
          exit while
     elseif k = {D} or k = {d}
          repaint off
          order change physical
          delidxrec(idxname,crec,fnum)
          scount = scount-1
          repaint on
          order change index idxname
          if chkstr(str(sprec),sel_str)=TRUE
               sel_str=delstr(str(sprec),sel_str)
          end if
          if records = 0
               exit while
          end if
     else
          beep
     end if
end while
repaint on
screen print pline-1 1 fgi bgi format "R"|str(scw) (format("    ACTIVE   ","M40"))
data goto window next
screen shortrestore pline_scr
end function   'del_item()

function find_item()
local descr fscn
screen save sch 1 sch scw fscn
screen print sch 1 fgi bgi (format("REMEMBER:  Description searches are case sensitive and left justified.","M"|str(scw)))
' release .02
'------------
if fentrybox("Enter part or all of description to find",40,"","") = 0
     data find "[scr_prod_descr]" equal ptstr options "g"
end if
'------------
screen shortrestore fscn
end function   'find_item()

function confirm(opt)
messbox("Are you sure you want to"&opt&"(y/n) ?",1,0,1)
return (case lower(ptstr) ("y",TRUE) else FALSE)
end function  'confirm()()

function scr_done()
repaint off
data goto window next
repaint on
data goto record first
screen print 1 1 fgi bgi (format("Simulation... setting up customer invoice for editing. Total:"&str(scount)&"items","M"|str(scw)))
wait 2
while record <= records
     wait 1
     data goto record next
end while
wait 3
end function   'scr_done()

function scr_setup()
local c f
smartpeek $_l1 pline
screen save pline 1 pline scw pline_scr
screen print pline 2 fgs bgs "Initializing..."
repaint off
clr_scr()
error off
clearerror
while cerror = 0
     window close
end while
window border
clearerror
idxname = "scr_sel.idx"
dfname= "scratch"
fnum=6
sview = "scr_sel.vw"
iview = "scratch.vw"
currlib = "displib.psl uintlib.psl indexlib.psl dfilelib.psl filelib.psl strlib.psl"
for c = 1 to 6
     f = group(currlib,c)
     load lpath|f in-memory
     if c = 1
          relperf()
          rpi = ptval
          screen shortrestore pline_scr
          progress(fgi,bgi,"Setting up for INDEXLIB.PSL demo",0)
     end if
     progtag(bgi,fgi,"Loading:"&f)
     milli-wait 500
end for
screen clear box pline 1 pline scw 0 0 no-border
progtag(bgi,fgi,"Preparing data environment")
remove(idxname)
makeidx(dfname,idxname,0,fnum)
vloadif(dpath|sview)          ' release .02
order change index idxname
window split vertical 38
data goto window next
vloadif(dpath|iview)          ' release .02
order change key [scr_prod_descr]

return (case lerror (0,0) else -1)
end function  'scr_setup()

function clr_scr()
local m1 m2 m3
m1 = "Pop-Tools (tm) Smartware II Language Enhancement Libraries"
m2 = "Index Library Example - EXINDX04.PF3"
m3 = "Copyright 1990-1991 Applied Resource Technologies, Inc."
screen clear box 1 1 sch scw fgs bgs no-border
screen print 1 1 fgp bgp (format(m1,"M"|str(scw)))
screen print 2 1 fgp bgp (format(m2,"M"|str(scw)))
screen print 3 1 fgp bgp (format(m3,"M"|str(scw)))
end function  'clrscr()

function scr_exit(e)
local c cnt
clr_scr()
if e = 0
     progress(fgi,bgi,"Exiting indexlib example...",0)
     remove(idxname)
     wait 2
end if
file unload all
cnt = strcount(currlib)
for c = 2 to cnt
     unload group(currlib,c)
end for
error off
window close
window border
error on
if e = 0
     screen shortrestore psa
     screen print sch 1 fgp bgp (format("Press any key to exit","M"|str(scw)))
     scrollbox(fgp,bgp,"Thank you for purchasing Pop-Tools!",rpi)
end if
unload group(currlib,1)
end function

function abort()
beep
clr_scr()
screen print pline 2 fgs bgs "Sorry... not able to initialize! Press any key to end"
inchar
end function