'**** HEADER ************************************************************
'EXINDX05.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: Multiple indexing from one pass through data file
'**** FUNCTION DECLARATIONS *********************************************
'library
external scrollbox()
external progress()
external makeidx()
external relperf()
external popuplist()
external bpopdb()
'core
global   init()     'load files and setup
global   mindx()    'multiple indexing routine
global   mexit()    'main exit routine
global   mainscr()  'main display screen
global   scrbox1()  'screen box to display function
global   scrbox2()  'screen box to display progress summary
global   scrbox3()  'screen box for summary data update
global   see_idx()  'user can view the indices created
'**** VARIABLE DECLARATIONS *********************************************
'library
external fgs bgs fgi bgi fgp bgp sch scw scc psa dsa
external lpath dpath ptval rpi ptstr
'core
global   cat_sort p# end_file rc rec_buff rec cat tmp_idx db fnum
global   r1 r2 c1 c2 m1 m2 m1l boxw m1c p1l sl1 sl2 sl3 sl4 rpc rpl
'**** CODE **************************************************************

main
   init()
   mindx()
   mexit(0)
end main

function mindx()
scrbox2()
scrbox3("t",str(p#))
error off
tools file erase left(db,3)|repeat("?",len(cat))|".mdx"
error on
data goto record first
end_file = FALSE
rec = 1
while end_file = FALSE
     cat = [scr_prod_cat]
     tmp_idx = left(db,3)|cat
     scrbox3("i",upper(tmp_idx))
     scrbox1("Reading")
          while [scr_prod_cat] = cat and end_file = FALSE
          scrbox3("p",str(round(97*(rec/p#),0)))
               if rec = p#
                    end_file = TRUE
               end if
               scrbox3("r",str(rec))
               rec_buff=rec_buff&str(precord)
               data goto record next
               rec=rec+1
          end while
          scrbox1("Writing")
          makeidx(db,tmp_idx|".mdx",rec_buff,fnum)
          rec_buff = NULL
          if rec = p#
               end_file = TRUE
          end if
end while
scrbox3("p","100")
beep
scrbox1("Done!")
wait 2
end function  'mindx()


function init()
repaint off
if dpath = 0
     execute "exindx03" in-memory
end if
mainscr()
scrbox1("Initializing")
load lpath|"indexlib.psl" in-memory
load lpath|"displib.psl" in-memory
if rpi = 0
     relperf()
     rpi = ptval
end if
db = "scratch"
fnum = 6
cat_sort = "idxmulti"         ' if a file sort is used (idxmulti.dfs)
rec_buff = NULL
file load standard-view dpath|db
p# = records
'order sort execute cat_sort index cat_sort  ' if a file sort is used
'order change index cat_sort                 ' if a file sort is used
order change key [scr_prod_cat]
mainscr()
end function  'init()


function mainscr()
local m2c t1 t2 t3
t1 = "Pop-Tools (tm) Smartware II Language Enhancement Libraries"
t2 = "Index Library Example - EXINDX05.PF3"
t3 = "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(t1,"M"|str(scw)))
screen print 2 1 fgp bgp (format(t2,"M"|str(scw)))
screen print 3 1 fgp bgp (format(t3,"M"|str(scw)))
m1 = "INDEXLIB Multi-index Demo"
m2 = "[ Pop-Tools ]"
boxw = len(m1)+4
m1l = len(m1)
r1 = 5
r2 = 10
c1 = int(scc-(boxw/2))
m1c = c1+2
m2c =int(scc-(len(m2)/2))
c2 = c1+boxw-1
sl1 = r2+2
sl2 = r2+3
sl3 = r2+4
sl4 = r2+5
screen clear box r1 c1 r2 c2 fgs bgs
screen print r1 m2c fgs bgs m2
screen print r1+2 m1c fgi bgi (format(m1,"M"|str(m1l)))
end function   'mainscr()


function scrbox1(msg)
screen print r1+4 m1c fgs bgs (format(msg,"M"|str(m1l)))
end function  'scrbox1()

function scrbox2()
local p1 p2 p3 p4
p1 = "Total Records :"
p2 = "On Record #   :"
p3 = "Index         :"
p4 = "% Complete    :"
p1l = len(p1)
rpc = m1c+p1l+3
rpl = c2-rpc-1
screen print sl1 m1c fgs bgs (format(p1,"L"|str(m1l)))
screen print sl2 m1c fgs bgs (format(p2,"L"|str(m1l)))
screen print sl3 m1c fgs bgs (format(p3,"L"|str(m1l)))
screen print sl4 m1c fgs bgs (format(p4,"L"|str(m1l)))
end function  'scrbox()


function scrbox3(l,m)
case l
when "t"
     screen print sl1 rpc fgs bgs (format(m,"R"|str(rpl)))
when "r"
     screen print sl2 rpc fgs bgs (format(m,"R"|str(rpl)))
when "i"
     screen print sl3 rpc fgs bgs (format(m,"R"|str(rpl)))
when "p"
     screen print sl4 rpc fgs bgs (format(m,"R"|str(rpl)))
end case
end function  'scrbox1()


function mexit(e)
unload "indexlib.psl"
if e = 0
     beep
     ptval = 0
     screen print sch 1 fgp bgp (format("Would you like to see the indices (y/n) ?","M"|str(scw)))
     scrollbox(fgi,bgi,"Thank you for purchasing Pop-Tools!",rpi)
     if ptval = {Y} or ptval = {y}
          see_idx()
     end if
end if
file unload view db|".vws"
unload "displib.psl"
end function   'mexit()


function see_idx()
local idxlist iname
repaint off
screen shortrestore psa
progress(fgi,bgi,"Standby... setting up for view",0)
load lpath|"bpopdb.psl" from-file
load lpath|"uintlib.psl" in-memory
idxlist = getfnames("*.mdx",0)
screen clear 0 0         'release .02
while TRUE
     screen print sch 1 fgi bgi \
          (format("Press Esc to exit index viewing","M"|str(scw)))
     beep
     if popuplist(4,5,17,idxlist,"Indices",1,1) < 0
          exit while
     end if
     iname = ptstr
     screen shortrestore dsa
     screen print sch 1 fgi bgi \
          (format("Press Esc to return to index selection","M"|str(scw)))
     order change index iname|".mdx"
     bpopdb(db,0,"","[scr_prod_num]","L10","[scr_prod_descr]","L40", \
            "[scr_prod_num]",4,20,17,72,"",0)
     repaint off    ' release .02
end while
unload "bpopdb.psl"
unload "uintlib.psl"
end function 'see_idx()