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

OS/2 REXX Batch file | 1994-03-09 | 5KB | 249 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
  fInit    ='N'
  fDebug   = 'N'
  fDispStax= 'N'
  fDispHelp= 'N'

  CALL rParseParms p1

  if fDebug = '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 'BOUNCE1 - Unable to initialize the "RXPD" subsystem'
    exit 8
   end

  sGlobal.iMaxR = 25
  sGlobal.iMaxC = 80
  sGlobal.fDebug=fDebug

  bid = rxPDInit('BOUNCE1','GREENHI','RED','REDHI',,25,80)
  if bid = x2c(00000000) then
   do
    Call rSiren 2, 3
    say 'BOUNCE1 - Error to initializing the "RXPD" subsystem'
    exit 8
   end

  fInit    ='Y'

  Call rxPDZVarDefine
  sRow    = ''

  akey = rxPDDisplay(bid,'PANEL000')
  do while 0 = rDoBOUNCE(bid)
  end /* do while 0 = rDoBOUNCE() */

  rc = rxPDTerm(bid)

  exit 0

/**********************************************************************\
 rDoBOUNCE:
  This routine displays a dialog panel that bounces a ball
\**********************************************************************/
rDoBOUNCE:
parse arg bid

  r = 1
  c = 1
  rd = +1
  cd = +1
  do FOREVER

   if c > 1 then
    do
     sRow = LEFT(' ',c-1,' ')'DB'x
    end
   else
    do
     sRow = 'DB'x
    end

   akey = rxPDDisplay(bid, 'PANEL'RIGHT(r,3,'0'))

   r = r + rd
   if r < 1 then
    do
     Call BEEP 1024, 25
     r = 2
     rd = +1
    end
   else
   if r > sGlobal.iMaxR then
    do
     Call BEEP 1024, 25
     r = sGlobal.iMaxR - 1
     rd = -1
    end

   c = c + cd
   if c < 1 then
    do
     Call BEEP 1024, 25
     c = 2
     cd = +1
    end
   else
   if c > sGlobal.iMaxC then
    do
     Call BEEP 1024, 25
     c = sGlobal.iMaxC - 1
     cd = -1
    end

  end /*do FOREVER */

  return 0;

HaltExit:
  if fInit = 'Y' then
   do
    rc = rxPDTerm(bid)
   end
  Call BEEP 882, 40
  Call BEEP 882, 40
  say ''
  say 'BOUNCE1 processing halted by request;'
  exit 0

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

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

SyntaxExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'BOUNCE1 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
      fDebug='Y'
      p1 = SUBWORD(p1,2)
     end
    when TRANSLATE(f1) = 'D' then
     do
      fDebug = 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
      Call rSiren 8, 1
      say 'BOUNCE1 - Invalid parm specified; Parm "'w1'" unknown;'
      CALL rDispSyntax 0 8
     end
   end
  end

  return 0

rDispSyntax: Procedure
parse upper arg iHelp iExit

  say ' Syntax  : BOUNCE1 {<options>} '
  say '           BOUNCE1 {/?|/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 '    BOUNCE1 /h'
  say ' '
  say '    BOUNCE1'

  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