home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pds.zip / SNAKE1.CMD < prev    next >
OS/2 REXX Batch file  |  1994-03-09  |  7KB  |  373 lines
  1. /*REXX*/
  2.  
  3.   signal on HALT    name HaltExit
  4.   /***
  5.   signal on ERROR   name ErrorExit
  6.   signal on FAILURE name FailureExit
  7.   signal on SYNTAX  name SyntaxExit
  8.   ***/
  9.  
  10. main:
  11. parse arg p1
  12.   sGlobal.fDebug   = 'N'
  13.   sGlobal.fRetain = 'N'
  14.   sGlobal.sInitChar  = ' '
  15.   sGlobal.xTrailer   = 'B0'x
  16.  
  17.   fInit    ='N'
  18.   fDebug   = 'N'
  19.   fDispStax= 'N'
  20.   fDispHelp= 'N'
  21.   fRetainQ = 'N'
  22.  
  23.   CALL rParseParms p1
  24.  
  25.   if fDebug = 'Y' then
  26.    do
  27.     trace ?r
  28.    end
  29.  
  30.   if fDispStax = 'Y' then
  31.    do
  32.     CALL rDispSyntax 0, 0
  33.    end
  34.  
  35.   if fDispHelp = 'Y' then
  36.    do
  37.     CALL rDispSyntax 1, 0
  38.    end
  39.  
  40.   /* Actual routine */
  41.   rc   = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  42.   if rc <> 0 then
  43.    do
  44.     Call rSiren 1, 1
  45.     say 'SNAKE1 - Unable to initialize the "RXPD" subsystem'
  46.     exit 8
  47.    end
  48.  
  49.   sGlobal.iMaxR = 25
  50.   sGlobal.iMaxC = 80
  51.   sGlobal.fDebug=fDebug
  52.   sGlobal.fRetain=fRetainQ
  53.  
  54.   bid = rxPDInit('SNAKE1','GREENHI','RED','REDHI',,25,80)
  55.   if bid = x2c(00000000) then
  56.    do
  57.     Call rSiren 2, 3
  58.     say 'SNAKE1 - Error to initializing the "RXPD" subsystem'
  59.     exit 8
  60.    end
  61.  
  62.   fInit    ='Y'
  63.  
  64.   Call rxPDZVarDefine
  65.   do i = 1 to sGlobal.iMaxR
  66.    sRow.i  = ''
  67.   end /* do i = 1 to sGlobal.iMaxR */
  68.  
  69.   akey = rxPDDisplay(bid,'PANEL000')
  70.   do while 0 = rDoBOUNCE(bid)
  71.   end /* do while 0 = rDoBOUNCE() */
  72.  
  73.   rc = rxPDTerm(bid)
  74.  
  75.   exit 0
  76.  
  77. /**********************************************************************\
  78.  rDoBOUNCE:
  79.   This routine displays a dialog panel that bounces a ball
  80. \**********************************************************************/
  81. rDoBOUNCE:
  82. parse arg bid
  83.  
  84.   sGlobal.r.1 = 4
  85.   sGlobal.c.1 = 4
  86.   sGlobal.rd.1 = +1
  87.   sGlobal.cd.1 = +1
  88.   sGlobal.x.1 = 'DB'x
  89.  
  90.   sGlobal.r.2 = 3
  91.   sGlobal.c.2 = 3
  92.   sGlobal.rd.2 = +1
  93.   sGlobal.cd.2 = +1
  94.   sGlobal.x.2 = 'B2'x
  95.  
  96.   sGlobal.r.3 = 2
  97.   sGlobal.c.3 = 2
  98.   sGlobal.rd.3 = +1
  99.   sGlobal.cd.3 = +1
  100.   sGlobal.x.3 = 'B1'x
  101.  
  102.   sGlobal.r.4 = 1
  103.   sGlobal.c.4 = 1
  104.   sGlobal.rd.4 = +1
  105.   sGlobal.cd.4 = +1
  106.   sGlobal.x.4 = 'B0'x
  107.  
  108.   if sGlobal.fRetain = 'Y' then
  109.    do
  110.     sI = sGlobal.xTrailer
  111.    end
  112.   else
  113.    do
  114.     sI = sGlobal.sInitChar
  115.    end
  116.  
  117.   do i = 1 to 4
  118.    sGlobal.p.i = sI
  119.   end
  120.  
  121.   do FOREVER
  122.  
  123.    /* Always create sprites in lower to higher layers. */
  124.    Call rDoBuildRow(4)
  125.    Call rDoBuildRow(3)
  126.    Call rDoBuildRow(2)
  127.    Call rDoBuildRow(1)
  128.  
  129.    akey = rxPDDisplay(bid, 'PANEL'RIGHT(sGlobal.r.1,3,'0'))
  130.  
  131.    Call rDoUpdateRow(4)
  132.    Call rDoUpdateRow(3)
  133.    Call rDoUpdateRow(2)
  134.    Call rDoUpdateRow(1)
  135.  
  136.   end /*do FOREVER */
  137.  
  138.   return 0;
  139.  
  140. rDoBuildRow: Procedure Expose sRow. sGlobal.
  141. parse arg iItem
  142.  
  143.   iR = sGlobal.r.iItem
  144.   iC = sGlobal.c.iItem
  145.   iX = sGlobal.x.iItem
  146.  
  147.   if iItem = 1 then
  148.    do
  149.     if sGlobal.fRetain = 'Y' then
  150.      do
  151.       sC = SUBSTR(sRow.iR,iC,1)
  152.       if sC = sGlobal.sInitChar then
  153.        do
  154.         sC = sGlobal.xTrailer
  155.        end
  156.       else
  157.        do
  158.         sC = sGlobal.sInitChar
  159.        end
  160.       i = 3
  161.       j = 4
  162.       do i
  163.        sGlobal.p.j = sGlobal.p.i
  164.        i = i - 1
  165.        j = j - 1
  166.       end
  167.       sGlobal.p.1 = sC
  168.      end
  169.    end
  170.  
  171.   if iC = 1 then
  172.    do
  173.     sRow.iR = iX||RIGHT(sRow.iR,sGlobal.iMaxC-1)
  174.    end
  175.   else
  176.    do
  177.     sRow.iR = LEFT(sRow.iR,iC-1)||iX||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
  178.    end
  179.  
  180.   return 0;
  181.  
  182. rDoUpdateRow: Procedure Expose sRow. sGlobal.
  183. parse arg iItem
  184.  
  185.   iR = sGlobal.r.iItem
  186.   iRD= sGlobal.rd.iITem
  187.   iC = sGlobal.c.iItem
  188.   iCD= sGlobal.cd.iITem
  189.  
  190.   if iItem = 4 then
  191.    do
  192.     sI = sGlobal.sInitChar
  193.     if sGlobal.fRetain = 'Y' then
  194.      do
  195.       sI = sGlobal.p.4
  196.      end
  197.     if iC = 1 then
  198.      do
  199.       sRow.iR = sI||RIGHT(sRow.iR,sGlobal.iMaxC-1)
  200.      end
  201.     else
  202.      do
  203.       sRow.iR = LEFT(sRow.iR,iC-1)||sI||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
  204.      end
  205.    end
  206.  
  207.   iR = iR + iRD
  208.   if iR < 1 then
  209.    do
  210.     if iItem = 1 then Call BEEP 1024, 25
  211.     iR = 2
  212.     iRD = +1
  213.    end
  214.   else
  215.   if iR > sGlobal.iMaxR then
  216.    do
  217.     if iItem = 1 then Call BEEP 1024, 25
  218.     iR = sGlobal.iMaxR - 1
  219.     iRD = -1
  220.    end
  221.  
  222.   iC = iC + iCD
  223.   if iC < 1 then
  224.    do
  225.     if iItem = 1 then Call BEEP 1024, 25
  226.     iC = 2
  227.     iCD = +1
  228.    end
  229.   else
  230.   if iC > sGlobal.iMaxC then
  231.    do
  232.     if iItem = 1 then Call BEEP 1024, 25
  233.     iC = sGlobal.iMaxC - 1
  234.     iCD = -1
  235.    end
  236.  
  237.   sGlobal.r.iItem  = iR
  238.   sGlobal.rd.iITem = iRD
  239.   sGlobal.c.iItem  = iC
  240.   sGlobal.cd.iITem = iCD
  241.  
  242.   return 0;
  243.  
  244. HaltExit:
  245.   if fInit = 'Y' then
  246.    do
  247.     rc = rxPDTerm(bid)
  248.    end
  249.   Call BEEP 882, 40
  250.   Call BEEP 882, 40
  251.   say ''
  252.   say 'SNAKE1 processing halted by request;'
  253.   exit 0
  254.  
  255. ErrorExit:
  256.   Call BEEP 882, 40
  257.   Call BEEP 882, 40
  258.   say 'SNAKE1 processing failed due to unknown error;'
  259.   exit 24
  260.  
  261. FailureExit:
  262.   Call BEEP 882, 40
  263.   Call BEEP 882, 40
  264.   say 'SNAKE1 processing failed due to unknown failure;'
  265.   exit 32
  266.  
  267. SyntaxExit:
  268.   Call BEEP 882, 40
  269.   Call BEEP 882, 40
  270.   say 'SNAKE1 processing failed due to syntax error;'
  271.   exit 64
  272.  
  273. rParseParms:
  274. parse arg p1
  275.  
  276.   do Forever
  277.    w1 = word(p1,1)
  278.    parse var w1 with "/" f1 ":" v1
  279.    select
  280.     when (w1 = '') then
  281.      do
  282.       return 0
  283.      end
  284.     when TRANSLATE(f1) = 'T' then
  285.      do
  286.       fRetainQ='Y'
  287.       p1 = SUBWORD(p1,2)
  288.      end
  289.     when TRANSLATE(w1) = '/DEBUG' then
  290.      do
  291.       fDebug='Y'
  292.       p1 = SUBWORD(p1,2)
  293.      end
  294.     when TRANSLATE(f1) = 'D' then
  295.      do
  296.       fDebug = TRANSLATE(v1)
  297.       p1 = SUBWORD(p1,2)
  298.      end
  299.     when TRANSLATE(f1) = '?' then
  300.      do
  301.       fDispStax='Y'
  302.       fDispHelp='N'
  303.       p1 = SUBWORD(p1,2)
  304.      end
  305.     when TRANSLATE(f1) = 'H' then
  306.      do
  307.       fDispStax='N'
  308.       fDispHelp='Y'
  309.       p1 = SUBWORD(p1,2)
  310.      end
  311.     otherwise
  312.      do
  313.       Call rSiren 8, 1
  314.       say 'SNAKE1 - Invalid parm specified; Parm "'w1'" unknown;'
  315.       CALL rDispSyntax 0 8
  316.      end
  317.    end
  318.   end
  319.  
  320.   return 0
  321.  
  322. rDispSyntax: Procedure
  323. parse upper arg iHelp iExit
  324.  
  325.   say ' Syntax  : SNAKE1 {<options>} '
  326.   say '           SNAKE1 {/?|/h}'
  327.   if iHelp > 0 then
  328.    do
  329.     CALL rDispHelp
  330.    end
  331.  
  332.   exit iExit
  333.  
  334. rDispHelp: Procedure
  335.  
  336.   say ' Options : /?         - Display command syntax.'
  337.   say '           /h         - Display this help info.'
  338.   say '           /t         - Leave a trail where snake has traveled.'
  339.   say ' Examples:'
  340.   say '    SNAKE1 /h'
  341.   say ' '
  342.   say '    SNAKE1'
  343.  
  344.   return ''
  345.  
  346. /* rSiren: does the siren bit by running the scale based upon a       */
  347. /*    frequency specified by the caller.                              */
  348. rSiren: Procedure
  349.    Parse Arg freq, cycle
  350.    note.1 = 262 * freq /* middle C */
  351.    note.2 = 294 * freq /* D */
  352.    note.3 = 330 * freq /* E */
  353.    note.4 = 349 * freq /* F */
  354.    note.5 = 392 * freq /* G */
  355.    note.6 = 440 * freq /* A */
  356.    note.7 = 494 * freq /* B */
  357.    note.8 = 524 * freq /* C */
  358.    do j = 1 to cycle
  359.     call beep note.8,250 /* hold each note for a 1/4 second */
  360.     call beep note.1,250 /* hold each note for a 1/4 second */
  361.    end j
  362.    Return
  363.  
  364. rLoadFuncs:
  365. parse arg sREP, sDll, sRtn
  366.   rxrc = RxFuncAdd(sREP, sDll, sRtn)
  367.   signal on syntax name xLoadFuncs
  368.   interpret 'Call 'sRtn
  369.   return 0
  370.  
  371. xLoadFuncs:
  372.   return 127
  373.