OS/2 Shareware BBS: 10 Tools/10-Tools.zip/pds.zip/IVP.CMD

OS/2 REXX Batch file | 1994-06-19 | 6KB | 244 lines

/*REXX*/

  /***
  signal on HALT    name HaltExit
  signal on ERROR   name ErrorExit
  signal on FAILURE name FailureExit
  signal on SYNTAX  name SyntaxExit
  ***/

main:
parse arg p1
  sGlobal.fDebug  = 'N'
  fDebugQ  = sGlobal.fDebug
  fDispStax= 'N'
  fDispHelp= 'N'

  CALL rParseParms p1

  if fDebugQ = 'Y' then
   do
    trace ?r
   end

  if fDispStax = 'Y' then
   do
    CALL rDispSyntax 0, 0
   end

  if fDispHelp = 'Y' then
   do
    CALL rDispSyntax 1, 0
   end

  /* Actual routine */
  rc   = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  if rc <> 0 then
   do
    Call rSiren 1, 1
    say 'IVP - Unable to define and initialize the "RXPD" subsystem to REXX'
    say '      Verify that HSSPD.DLL is in a directory listed in the'
    say '      "LIBPATH" statement in the "CONFIG.SYS".'
    exit 8
   end

  sGlobal.fDebug  = fDebugQ

  sGlobal.zBid = rInitPDS()
  if sGlobal.zBid = -1 then
   do
    Call rSiren 2, 3
    say 'IVP - Unable to initialize an instance of the "RXPD" subsystem'
    say '      for this "Installation and Verification Procedure".'
    say '      "RXPD" subsystem was defined but the IVP was unable to'
    say '      execute the "rxPDInit" routine. Possibly a conflict with'
    say '      another REXX extension package.'
    exit 8
   end
  if sGlobal.zBid = x2c(00000000) then
   do
    Call rSiren 2, 3
    say 'IVP - Unable to initialize an instance of the "RXPD" subsystem'
    say '      for this "Installation and Verification Procedure".'
    say '      Verify that IVP.PNL is in a directory listed in the'
    say '      "DPATH" statement in the "CONFIG.SYS".'
    exit 8
   end

  Call rxPDZVarDefine

  if SYMBOL('ZVERSION') = 'LIT' then
   do
    Call rSiren 1, 1
    ZVERSION = 1
    ZRELEASE = 3
    ZPRODUCT = 'Panel Display System V1.05'
    ZCOPYRIGHT = 'All Rights Reserved; '
    ZCOPYRIGHT = ZCOPYRIGHT||' Copyright (c) 1994, Rick W. Hodgson'
   end

  sZVERSION = ZVERSION
  sZRELEASE = ZRELEASE
  sZPRODUCT = ZPRODUCT
  sZCOPYRIGHT = ZCOPYRIGHT

  akey = rxPDDisplay(sGlobal.zBid,'PANEL000')
  do while 0 = rDoDisplay(sGlobal.zBid)
  end /* do while 0 = rDoDisplay() */

  rc = rxPDTerm(sGlobal.zBid)

  exit 0

/**********************************************************************\
 rDoDisplay:
  This routine displays the panel which shows:
         Product, Version, Release and Copyright
\**********************************************************************/
rDoDisplay:
parse arg sGlobal.zBid

  akey = 0

  do while akey <> ZESC
   akey = rxPDDisplay(sGlobal.zBid, 'PANEL001')
  end /*do while akey <> ZESC*/

  return 8;

HaltExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'IVP processing halted by request;'
  exit 0

ErrorExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'IVP processing failed due to unknown error;'
  exit 24

FailureExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'IVP processing failed due to unknown failure;'
  exit 32

SyntaxExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'IVP processing failed due to syntax error;'
  exit 64

rParseParms:
parse arg p1

  do Forever
   w1 = word(p1,1)
   parse var w1 with "/" f1 ":" v1
   select
    when (w1 = '') then
     do
      return 0
     end
    when TRANSLATE(w1) = '/DEBUG' then
     do
      fDebugQ='Y'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = 'D' then
     do
      fDebugQ = TRANSLATE(v1)
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = '?' then
     do
      fDispStax='Y'
      fDispHelp='N'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = 'H' then
     do
      fDispStax='N'
      fDispHelp='Y'
      p1 = SUBWORD(p1,2)
     end
    otherwise
     do
      select
       when fFlSpecQ <> 'Y' then
        do
         fFlSpecQ = 'Y'
         sFlSpec = w1
         p1 = SUBWORD(p1,2)
        end
       otherwise
        do
         Call rSiren 8, 1
         say 'IVP - Too many parms specified; Parm "'w1'" unknown;'
         CALL rDispSyntax 0 8
        end
      end /*select*/
     end
   end
  end

  return 0

rDispSyntax: Procedure
parse upper arg iHelp iExit

  say ' Syntax  : IVP '
  say '           IVP {/?|/h}'
  if iHelp > 0 then
   do
    CALL rDispHelp
   end

  exit iExit

rDispHelp: Procedure

  say ' Options : /?         - Display command syntax.'
  say '           /h         - Display this help info.'
  say ' Examples:'
  say '    IVP /h'

  return ''

/* rSiren: does the siren bit by running the scale based upon a       */
/*    frequency specified by the caller.                              */
rSiren: Procedure
   Parse Arg freq, cycle
   note.1 = 262 * freq /* middle C */
   note.2 = 294 * freq /* D */
   note.3 = 330 * freq /* E */
   note.4 = 349 * freq /* F */
   note.5 = 392 * freq /* G */
   note.6 = 440 * freq /* A */
   note.7 = 494 * freq /* B */
   note.8 = 524 * freq /* C */
   do j = 1 to cycle
    call beep note.8,250 /* hold each note for a 1/4 second */
    call beep note.1,250 /* hold each note for a 1/4 second */
   end j
   Return

rLoadFuncs:
parse arg sREP, sDll, sRtn
  rxrc = RxFuncAdd(sREP, sDll, sRtn)
  signal on syntax name xLoadFuncs
  interpret 'Call 'sRtn
  return 0

xLoadFuncs:
  return 127

rInitPDS:
  signal on syntax name xInitPDS
  bid = rxPDInit('IVP','GREENHI','YELLOWHI','LBLUEHI',,25,80)
  return bid

xInitPDS:
  return -1