'**** HEADER ************************************************************
'ENVLIB.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 and application environment management function

'**** CHANGE HISTORY ****************************************************

'chg_dsc()     1.5  02/26/91 changed to work with SW2 Version 1.5


'**** FUNCTION DECLARATIONS *********************************************
'library
'core
public   to_dir()             '  create/goto directory path
public   chg_dsc()            '  checks/changes printer drv in tph
'**** VARIABLE DECLARATIONS *********************************************
'library
public currlib
'core
global file#
'**** CODE **************************************************************


MAIN
local ptpsl
ptpsl = "envlib"
'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
END MAIN


function to_dir(x,pth)
local cd e

' x option:    0 = check dir for valid path
'              1 = goto dir
'              2 = make dir if not exists
'              3 = make dir and goto it
'
x = case x (0,0)(1,1)(2,2)(3,3) else -1

if x < 0
     return (-4)              'invalid option parameter
end if

if right(pth,1) = "\"
     pth = left(pth,len(pth)-1)
end if
e = 0
cd = path(datapath)
clearerror
error off
tools directory new-directory pth
if lerror = 0
     if x = 0 or x = 2
          tools directory new-directory cd
     end if
else
     if x > 1
          clearerror
          tools directory make pth
          if lerror = 0
               if x = 3
                    clearerror
                    tools directory new-directory pth
                    if lerror > 0
                         e = -3
                    end if
               end if
          else
               e = -2
          end if
      else
          e = -1
      end if
end if
error on
return (e)
end function  'to_dir()

function chg_dsc(dscpass,msg,f)
local currdsc dscname dsc gdv dnarrows r rp mline mscn
local bp v line respos p# i
local c np p plist
file# = f
r = -6    ' will be returned if passed DSC is not in resource libraries
dscpass = upper(dscpass)
dsc = FALSE
smartpeek $_pdv currdsc
if currdsc == dscpass
     return (0)        'named dsc is current dsc... no need to change
elseif dscpass ! "\" or dscpass ! ".CPD" or dscpass ! ":"
     return (-1)     ' bad dsc name passed... contained path and/or extension
elseif len(dscpass) > 8 or dscpass = NULL
     return (-2)     ' dsc name NULL or too long
else
    if file("C:\ANGOSS\resource.srl")=TRUE
'     if file(path(syspath)|"resource.srl")=TRUE
          error off
          fopen "C:\ANGOSS\resource.srl" as file# options RO_SHARE
'          fopen path(syspath)|"resource.srl" as file# options RO_SHARE
          if cerror = 0
               fseek file# 20
               fread file# binary 2 into bp
               v = int(bp[1]+((bp[2]*256)))
               if v > 0
                    gdv = TRUE
               end if
               fseek file# 104
               fread file# binary 2 into bp
               p# = int(bp[1]+((bp[2]*256)))
               fread file# binary 4 into bp
               v = int(bp[1]+((bp[2]*256)+(bp[3]*65536)+(bp[4]*16777216)))
               fseek file# v
               for i = 1 to p#
                    fread file# length 13 into line
                    fread file# length 13 into line
                    if line ! dscpass
                         dsc = TRUE
                         exit for
                    end if
               end for
               fclose file#
          else
               r = (-3)    ' not able to open resource.srl
          end if
          error on
     end if
     if dsc = FALSE
          if file(path(homepath)|"resource.lrl")=TRUE
               error off
               fopen path(homepath)|"resource.lrl" as file# options RO_SHARE
               if cerror <> 0
                    error on
                    return (-4)    ' not able to open resource.srl
               end if
               fseek file# 20
               fread file# binary 2 into bp
               v = int(bp[1]+((bp[2]*256)))
               if v > 0
                    gdv = TRUE
               end if
               fseek file# 104
               fread file# binary 2 into bp
               p# = int(bp[1]+((bp[2]*256)))
               fread file# binary 4 into bp
               v = int(bp[1]+((bp[2]*256)+(bp[3]*65536)+(bp[4]*16777216)))
               fseek file# v
               for i = 1 to p#
                    fread file# length 13 into line
                    fread file# length 13 into line
                    if line ! dscpass
                         dsc = TRUE
                         exit for
                    end if
               end for
               fclose file#
               error on
          end if
     end if
end if
if dsc = TRUE
     smartpeek $_paint rp
     if rp = 1
          repaint off
     end if
     if exact(msg,NULL) = FALSE
          smartpeek $_l1 mline
          screen save mline 1 mline scrwidth  mscn
          screen clear box mline 1 mline scrwidth 0 0 no-border
          screen print mline 1 bginvpleasing bgstandard msg
     end if
     ' affectionately termed "the Dick Trump routine"
     ' **********************************************
     if gdv = 0
          dnarrows=1
     else
          dnarrows=2
     end if
     key define "#1000" "repeat,#"|str(dnarrows)|",Down"
     key define "#1001" """"|dscpass|""""
     tools preferences hardware
     keys look,#1000,look,#1001,f10,f10
     ' **********************************************
     key remove "#1000"
     key remove "#1001"
     smartpeek $_pdv currdsc
     if currdsc == dscpass
          r = 0
     else
          r = -5
     end if
     if rp = 1
          repaint on
     end if
     if exact(msg,NULL)= FALSE
          screen shortrestore mscn
     end if
end if
return (r)
end function  'chg_dsc()