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

OS/2 REXX Batch file | 1994-03-09 | 6KB | 332 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 'BOUNCE2 - Unable to initialize the "RXPD" subsystem'
    exit 8
   end

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

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

  fInit    ='Y'

  Call rxPDZVarDefine
  do i = 1 to sGlobal.iMaxR
   sRow.i  = ''
  end /* do i = 1 to sGlobal.iMaxR */

  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

  r2 = TRUNC(sGlobal.iMaxR/3)
  c2 = TRUNC(sGlobal.iMaxC/3)
  r2d = -1
  c2d = +1

  do FOREVER

   if r = r2 then                      /* Same row needs extra work */
    do
     if c < c2 then
      do
       cw1 = c
       cw2 = c2
      end
     else
      do
       cw2 = c
       cw1 = c2
      end
     if cw1 > 1 then
      do
       sWrk = LEFT(' ',cw1-1,' ')'DB'x
      end
     else
      do
       sWrk = 'DB'x
      end
     if cw2 <> cw1 then
      do
       sWrk = sWrk||LEFT(' ',cw2-cw1,' ')'DB'x
      end
     sRow.r  = sWrk
     akey = rxPDDisplay(bid, 'PANEL'RIGHT(r,3,'0'))
     sRow.r  = ''
    end
   else
    do
     if c > 1 then
      do
       sWrk = LEFT(' ',c-1,' ')'DB'x
      end
     else
      do
       sWrk = 'DB'x
      end
     if c2 > 1 then
      do
       sWrk2 = LEFT(' ',c2-1,' ')'DB'x
      end
     else
      do
       sWrk2 = 'DB'x
      end
     sRow.r  = sWrk
     sRow.r2 = sWrk2
     akey = rxPDDisplay(bid, 'PANEL'RIGHT(r,3,'0'))
     akey = rxPDDisplay(bid, 'PANEL'RIGHT(r2,3,'0'))
     sRow.r  = ''
     sRow.r2 = ''
    end

   akey = rxPDDisplay(bid, 'PANEL999')

   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

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

   c2 = c2 + c2d
   if c2 < 1 then
    do
     Call BEEP 1024, 25
     c2 = 2
     c2d = +1
    end
   else
   if c2 > sGlobal.iMaxC then
    do
     Call BEEP 1024, 25
     c2 = sGlobal.iMaxC - 1
     c2d = -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 'BOUNCE2 processing halted by request;'
  exit 0

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

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

SyntaxExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'BOUNCE2 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 'BOUNCE2 - Invalid parm specified; Parm "'w1'" unknown;'
      CALL rDispSyntax 0 8
     end
   end
  end

  return 0

rDispSyntax: Procedure
parse upper arg iHelp iExit

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

  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