home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pds.zip / SNAKE2.CMD < prev    next >
OS/2 REXX Batch file  |  1994-03-09  |  21KB  |  840 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.  
  13.   sGlobal.iMaxR    = 25
  14.   sGlobal.iMaxC    = 80
  15.   sGlobal.fDebug   = 'N'
  16.   sGlobal.fRetain = 'N'
  17.   sGlobal.fInitChar = ' '
  18.   sGlobal.sInitChar = ' '
  19.   sGlobal.i1Row    = 1
  20.   sGlobal.i1Col    = 1
  21.   sGlobal.i2Row    = sGlobal.iMaxR
  22.   sGlobal.i2Col    = sGlobal.iMaxC
  23.   sGlobal.fCollide   = 'N'
  24.   sGlobal.fHome      = 'N'
  25.   sGlobal.fCollision = 'N'
  26.   sGlobal.fBackHome = 'N'
  27.   sGlobal.fBeepTrail = 'N'
  28.   sGlobal.fBeepHeads = 'N'
  29.   sGlobal.fBeepWalls = 'N'
  30.   sGlobal.fBeepHome  = 'N'
  31.   sGlobal.xTrailer   = 'B0'x
  32.  
  33.   fInit    ='N'
  34.   fDebug   = 'N'
  35.   fDispStax= 'N'
  36.   fDispHelp= 'N'
  37.   fRetainQ = 'N'
  38.   fInitCHQ = 'N'
  39.   sInitCH  = ' '
  40.   fInitRow1Q = 'N'
  41.   iInitRow1 = sGlobal.i1Row
  42.   fInitCol1Q = 'N'
  43.   iInitCol1 = sGlobal.i1Col
  44.   fInitRow2Q = 'N'
  45.   iInitRow2 = sGlobal.i2Row
  46.   fInitCol2Q = 'N'
  47.   iInitCol2 = sGlobal.i2Col
  48.   fCollideQ = sGlobal.fCollide
  49.   fHomeQ = sGlobal.fHome
  50.   fBeepTrailQ = sGlobal.fBeepTrail
  51.   fBeepHeadsQ = sGlobal.fBeepHeads
  52.   fBeepWallsQ = sGlobal.fBeepWalls
  53.   fBeepHomeQ  = sGlobal.fBeepHome
  54.  
  55.   CALL rParseParms p1
  56.  
  57.   if fDebug = 'Y' then
  58.    do
  59.     trace ?r
  60.    end
  61.  
  62.   if fDispStax = 'Y' then
  63.    do
  64.     CALL rDispSyntax 0, 0
  65.    end
  66.  
  67.   if fDispHelp = 'Y' then
  68.    do
  69.     CALL rDispSyntax 1, 0
  70.    end
  71.  
  72.   /* Actual routine */
  73.   rc   = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  74.   if rc <> 0 then
  75.    do
  76.     Call rSiren 1, 1
  77.     say 'SNAKE2 - Unable to initialize the "RXPD" subsystem'
  78.     exit 8
  79.    end
  80.  
  81.   sGlobal.iMaxR = 25
  82.   sGlobal.iMaxC = 80
  83.   sGlobal.fDebug=fDebug
  84.   sGlobal.fRetain=fRetainQ
  85.   sGlobal.fInitChar=fInitCHQ
  86.   sGlobal.sInitChar=sInitCH
  87.   sGlobal.i1Row=iInitRow1
  88.   sGlobal.i1Col=iInitCol1
  89.   sGlobal.i2Row=iInitRow2
  90.   sGlobal.i2Col=iInitCol2
  91.   sGlobal.fCollide=fCollideQ
  92.   sGlobal.fHome=fHomeQ
  93.   sGlobal.fBeepTrail=fBeepTrailQ
  94.   sGlobal.fBeepHeads=fBeepHeadsQ
  95.   sGlobal.fBeepWalls=fBeepWallsQ
  96.   sGlobal.fBeepHome =fBeepHomeQ
  97.  
  98.   sGlobal.sBid = rxPDInit('SNAKE2','GREENHI','RED','REDHI',,25,80)
  99.   if sGlobal.sBid = x2c(00000000) then
  100.    do
  101.     Call rSiren 2, 3
  102.     say 'SNAKE2 - Error to initializing the "RXPD" subsystem'
  103.     exit 8
  104.    end
  105.  
  106.   fInit    ='Y'
  107.  
  108.   Call rxPDZVarDefine
  109.  
  110.   fAttr1 = ZVTYPE_LONG+ZVTYPE_RIGHTADJUST+ZVTYPE_LZEROFILL
  111.   fAttr2 = ZVTYPE_DOUBLE+ZVTYPE_RIGHTADJUST+ZVTYPE_LZEROFILL
  112.   Call rxPDVarDefine sGlobal.sBid, 'sGlobal.row.1', fAttr1
  113.   Call rxPDVarDefine sGlobal.sBid, 'sGlobal.col.1', fAttr1
  114.   Call rxPDVarDefine sGlobal.sBid, 'sGlobal.row.5', fAttr1
  115.   Call rxPDVarDefine sGlobal.sBid, 'sGlobal.col.5', fAttr1
  116.   Call rxPDVarDefine sGlobal.sBid, 'iESecs', fAttr2, 3
  117.  
  118.   do i = 1 to sGlobal.iMaxR
  119.    sRow.i = LEFT(sGlobal.sInitChar,sGlobal.iMaxC,sGlobal.sInitChar)
  120.   end /* do i = 1 to sGlobal.iMaxR */
  121.  
  122.   akey = rxPDDisplay(sGlobal.sBid,'PANEL000')
  123.  
  124.   do while 0 = rDoBOUNCE(sGlobal.sBid)
  125.   end /* do while 0 = rDoBOUNCE() */
  126.  
  127.  
  128.   rc = rxPDTerm(sGlobal.sBid)
  129.  
  130.   exit 0
  131.  
  132. /**********************************************************************\
  133.  rDoBOUNCE:
  134.   This routine displays a dialog panel that bounces a ball
  135. \**********************************************************************/
  136. rDoBOUNCE:
  137. parse arg sGlobal.sBid
  138.  
  139.   /* Determine direction of sprite # 1*/
  140.   if sGlobal.i1Row < sGlobal.iMaxR-4 then /* Bottom part of display */
  141.    do
  142.     i1RD = +1
  143.    end
  144.   else
  145.    do
  146.     i1RD = -1
  147.    end
  148.  
  149.   if sGlobal.i1Col < sGlobal.iMaxC-4 then /* Left side of display */
  150.    do
  151.     i1CD = +1
  152.    end
  153.   else
  154.    do
  155.     i1CD = -1
  156.    end
  157.  
  158.   /* Initialize Sprite # 1 */
  159.   sGlobal.row.4 = sGlobal.i1Row
  160.   sGlobal.col.4 = sGlobal.i1Col
  161.   sGlobal.rd.4 = i1RD
  162.   sGlobal.cd.4 = i1CD
  163.   sGlobal.x.4 = 'B0'x
  164.  
  165.   sGlobal.row.3 = sGlobal.row.4 + i1RD
  166.   sGlobal.col.3 = sGlobal.col.4 + i1CD
  167.   sGlobal.rd.3 = i1RD
  168.   sGlobal.cd.3 = i1CD
  169.   sGlobal.x.3 = 'B1'x
  170.  
  171.   sGlobal.row.2 = sGlobal.row.3 + i1RD
  172.   sGlobal.col.2 = sGlobal.col.3 + i1CD
  173.   sGlobal.rd.2 = i1RD
  174.   sGlobal.cd.2 = i1CD
  175.   sGlobal.x.2 = 'B2'x
  176.  
  177.   sGlobal.row.1 = sGlobal.row.2 + i1RD
  178.   sGlobal.col.1 = sGlobal.col.2 + i1CD
  179.   sGlobal.rd.1 = i1RD
  180.   sGlobal.cd.1 = i1CD
  181.   sGlobal.x.1 = 'DB'x
  182.  
  183.   /* Initialize Sprite # 1 with "Where I've been" info */
  184.   if sGlobal.fRetain = 'Y' then
  185.    do
  186.     sI = sGlobal.xTrailer
  187.    end
  188.   else
  189.    do
  190.     sI = sGlobal.sInitChar
  191.    end
  192.   do i = 1 to 3
  193.    j = i + 1
  194.    sGlobal.p.1.i = sI','sGlobal.row.j','sGlobal.col.j
  195.   end
  196.  
  197.   /* Determine direction of sprite # 2*/
  198.   if sGlobal.i2Row > 5 then            /* Bottom part of display */
  199.    do
  200.     i2RD = -1
  201.    end
  202.   else
  203.    do
  204.     i2RD = +1
  205.    end
  206.  
  207.   if sGlobal.i2Col > 5 then            /* Bottom part of display */
  208.    do
  209.     i2CD = -1
  210.    end
  211.   else
  212.    do
  213.     i2CD = +1
  214.    end
  215.  
  216.   /* Initialize Sprite # 1 */
  217.   sGlobal.row.8 = sGlobal.i2Row
  218.   sGlobal.col.8 = sGlobal.i2Col
  219.   sGlobal.rd.8 = i2RD
  220.   sGlobal.cd.8 = i2CD
  221.   sGlobal.x.8 = 'B0'x
  222.  
  223.   sGlobal.row.7 = sGlobal.row.8 + i2RD
  224.   sGlobal.col.7 = sGlobal.col.8 + i2CD
  225.   sGlobal.rd.7 = i2RD
  226.   sGlobal.cd.7 = i2CD
  227.   sGlobal.x.7 = 'B1'x
  228.  
  229.   sGlobal.row.6 = sGlobal.row.7 + i2RD
  230.   sGlobal.col.6 = sGlobal.col.7 + i2CD
  231.   sGlobal.rd.6 = i2RD
  232.   sGlobal.cd.6 = i2CD
  233.   sGlobal.x.6 = 'B2'x
  234.  
  235.   sGlobal.row.5 = sGlobal.row.6 + i2RD
  236.   sGlobal.col.5 = sGlobal.col.6 + i2CD
  237.   sGlobal.rd.5 = i2RD
  238.   sGlobal.cd.5 = i2CD
  239.   sGlobal.x.5 = 'DB'x
  240.  
  241.   /* Initialize Sprite # 1 with "Where I've been" info */
  242.   if sGlobal.fRetain = 'Y' then
  243.    do
  244.     sI = sGlobal.xTrailer
  245.    end
  246.   else
  247.    do
  248.     sI = sGlobal.sInitChar
  249.    end
  250.   do i = 1 to 3
  251.    j = i + 5
  252.    sGlobal.p.5.i = sI','sGlobal.row.j','sGlobal.col.j
  253.   end
  254.  
  255.   /* Get the starting time for "I'm Home!" and start "Collision" timer*/
  256.   sGlobal.sStartTime = TIME('S')
  257.   iESecs = TIME('R')
  258.  
  259.   do FOREVER
  260.  
  261.    /* Always create sprites in lower to higher layers. */
  262.    Call rDoBuildRow(8)                 /* Sprite # 2 */
  263.    Call rDoBuildRow(4)                 /* Sprite # 1 */
  264.    Call rDoBuildRow(7)                 /* Sprite # 2 */
  265.    Call rDoBuildRow(3)                 /* Sprite # 1 */
  266.    Call rDoBuildRow(6)                 /* Sprite # 2 */
  267.    Call rDoBuildRow(2)                 /* Sprite # 1 */
  268.    Call rDoBuildRow(5)                 /* Sprite # 2 */
  269.    Call rDoBuildRow(1)                 /* Sprite # 1 */
  270.  
  271.    /* Display rows where sprite # 1 lives */
  272.    akey = rxPDDisplay(sGlobal.sBid,'PANEL'RIGHT(sGlobal.row.1,3,'0'))
  273.    /* If sprite # 2 is on a different row, display rows where it lives */
  274.    /* This was done just for speed but most folks won't know the */
  275.    /* difference because the "if" statement consumes time itself.*/
  276.    /* Also, except in those cases where someone starts both sprites */
  277.    /* on the same row where they end up going in the same direction,*/
  278.    /* usually the sprites are on different rows 24/25 % of the time.*/
  279.    if sGlobal.row.1 <> sGlobal.row.5 then
  280.     do
  281.      akey = rxPDDisplay(sGlobal.sBid,'PANEL'RIGHT(sGlobal.row.5,3,'0'))
  282.     end
  283.    /* Flush the composite display to the screen */
  284.    akey = rxPDDisplay(sGlobal.sBid,'PANEL999')
  285.  
  286.    /* Did we had a collision? */
  287.    if sGlobal.fCollision = 'Y' then
  288.     do
  289.      /* Yes, get the elapsed time. */
  290.      iESecs = TIME('E')                /* Elapsed time since */
  291.      /* If we are being noisy then beep */
  292.      if sGlobal.fBeepHeads = 'Y'then
  293.       do
  294.        Call rSiren 1, 0, 'U'
  295.        Call rSiren 1, 0, 'D'
  296.       end
  297.      sGlobal.fCollision = 'N'
  298.      /* If asked, popup a panel stating where we collided */
  299.      if sGlobal.fCollide = 'Y' then
  300.       do
  301.        svid = rxPDSaveScreen(sGlobal.sBid)
  302.        akey = rxPDDisplay(sGlobal.sBid,'TIME003')
  303.        rc = rxPDRestoreScreen(sGlobal.sBid,svid)
  304.        if akey = ZESC then
  305.         do
  306.          return 1
  307.         end
  308.       end
  309.      iESecs = TIME('R')                /* Restart for this iteration */
  310.     end
  311.  
  312.    /* Are we back home? */
  313.    if sGlobal.fBackHome = 'Y' then
  314.     do
  315.      /* Yes, if we are being noisy then beep */
  316.      if sGlobal.fBeepHome = 'Y'then
  317.       do
  318.        Call rSiren 5, 0, 'U'
  319.        Call rSiren 5, 0, 'D'
  320.        Call rSiren 5, 0, 'U'
  321.        Call rSiren 5, 0, 'D'
  322.       end
  323.      sGlobal.fBackHome = 'N'
  324.      /* If asked, popup a panel stating "We're Back!" */
  325.      if sGlobal.fHome = 'Y' then
  326.       do
  327.        iESecs = (TIME('S') - sGlobal.sStartTime) / 60
  328.        svid = rxPDSaveScreen(sGlobal.sBid)
  329.        akey = rxPDDisplay(sGlobal.sBid,'HOME001')
  330.        rc = rxPDRestoreScreen(sGlobal.sBid,svid)
  331.        if akey = ZESC then
  332.         do
  333.          return 1
  334.         end
  335.       end
  336.      sGlobal.sStartTime = TIME('S')
  337.     end
  338.  
  339.    /* Move each pieces parts to its next position */
  340.    Call rDoUpdateRow(8)
  341.    Call rDoUpdateRow(4)
  342.    Call rDoUpdateRow(7)
  343.    Call rDoUpdateRow(3)
  344.    Call rDoUpdateRow(6)
  345.    Call rDoUpdateRow(2)
  346.    Call rDoUpdateRow(5)
  347.    Call rDoUpdateRow(1)
  348.  
  349.   end /*do FOREVER */
  350.  
  351.   return 0;
  352.  
  353. rDoBuildRow: Procedure Expose sRow. sGlobal.
  354. parse arg iItem
  355.  
  356.   iR = sGlobal.row.iItem
  357.   iC = sGlobal.col.iItem
  358.   sX = sGlobal.x.iItem
  359.  
  360.   /* Are we moving the head of a snake? */
  361.   if iItem = 5 | iItem = 1 then
  362.    do
  363.     /* Yes, get the character at our target position */
  364.     sC = SUBSTR(sRow.iR,iC,1)
  365.     /* Are we leaving a trail? */
  366.     if sGlobal.fRetain = 'Y' then
  367.      do
  368.       Call rDoRetain iItem, iR, iC, sC
  369.      end
  370.     /* Did we collide with the other snake? */
  371.     if sC = sX then
  372.      do
  373.       sGlobal.fCollision = 'Y'
  374.      end
  375.     else
  376.      do
  377.       /* If we are stepping on a trail and if noisy then beep */
  378.       if sC <> sGlobal.sInitChar then
  379.        do
  380.         if sGlobal.fBeepTrail = 'Y' then
  381.          do
  382.           Call BEEP 512,15
  383.          end
  384.        end
  385.      end
  386.     sGlobal.fBackHome = 'N'
  387.     /* If sprite # 1 and back home, flag it */
  388.     if iItem = 1 then
  389.      do
  390.       if iR = sGlobal.i1Row & iC = sGlobal.i1Col then
  391.        do
  392.         sGlobal.fBackHome = 'Y'
  393.        end
  394.      end
  395.    end
  396.  
  397.   /* Construct the row */
  398.   if iC = 1 then
  399.    do
  400.     sRow.iR = sX||RIGHT(sRow.iR,sGlobal.iMaxC-1)
  401.    end
  402.   else
  403.    do
  404.     sRow.iR = LEFT(sRow.iR,iC-1)||sX||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
  405.    end
  406.  
  407.   return 0;
  408.  
  409. rDoRetain: Procedure Expose sRow. sGlobal.
  410. parse arg iItem, iR, iC, sC
  411.   /* Is the stepped on character the initialization character? */
  412.   if sC = sGlobal.sInitChar then
  413.    do
  414.     /* Yes, then we will leave the trailer character behind. */
  415.     sC = sGlobal.xTrailer
  416.    end
  417.   else
  418.    do
  419.     /* No, then we might leave the initialization character behind. */
  420.     sC = sGlobal.sInitChar
  421.     if iItem = 1 then                  /* Sprite # 1 stepped on # 2? */
  422.      do
  423.       i1 = 5                           /* Test Sprite # 2 first      */
  424.       i2 = 1                           /* Test Sprite # 1 second     */
  425.      end
  426.     else                               /* Sprite # 2 stepped on # 1? */
  427.      do
  428.       i1 = 1                           /* Test Sprite # 1 first      */
  429.       i2 = 5                           /* Test Sprite # 2 second     */
  430.      end
  431.     /* We might be stepping on the other sprite or ourselves so we */
  432.     /* will try to find this row/col in either sprite. */
  433.     /* If we do, then we need to invert what was there previously */
  434.     do j = 1 to 4
  435.      parse var sGlobal.p.i1.j sTstCH','sTstRow','sTstCol
  436.      if sTstRow = iR & sTstCol = iC then
  437.       do
  438.        if sTstCH = sGlobal.sInitChar then
  439.         do
  440.          sC = sGlobal.xTrailer
  441.         end
  442.        else
  443.         do
  444.          sC = sGlobal.sInitChar
  445.         end
  446.        LEAVE j
  447.       end
  448.      parse var sGlobal.p.i2.j sTstCH','sTstRow','sTstCol
  449.      if sTstRow = iR & sTstCol = iC then
  450.       do
  451.        if sTstCH = sGlobal.sInitChar then
  452.         do
  453.          sC = sGlobal.xTrailer
  454.         end
  455.        else
  456.         do
  457.          sC = sGlobal.sInitChar
  458.         end
  459.        LEAVE j
  460.       end
  461.     end /*do j = 1 to 4*/
  462.    end
  463.   /* Push the "Trail" characters thru the stack */
  464.   i = 3
  465.   j = 4
  466.   do i
  467.    sGlobal.p.iItem.j = sGlobal.p.iItem.i
  468.    i = i - 1
  469.    j = j - 1
  470.   end
  471.   sGlobal.p.iItem.1 = sC','iR','iC
  472.  
  473.   return 0;
  474.  
  475. rDoUpdateRow: Procedure Expose sRow. sGlobal.
  476. parse arg iItem
  477.  
  478.   iR = sGlobal.row.iItem
  479.   iRD= sGlobal.rd.iITem
  480.   iC = sGlobal.col.iItem
  481.   iCD= sGlobal.cd.iITem
  482.  
  483.   /* If we are the trailing part of a sprite then we need to either */
  484.   /* leave behind the initialization character or in the case where */
  485.   /* we are leaving a trail, whatever the inverted state character  */
  486.   /* for this position must be.                                     */
  487.   if iItem = 4 | iItem = 8 then
  488.    do
  489.     sI = sGlobal.sInitChar
  490.     if sGlobal.fRetain = 'Y' then
  491.      do
  492.       if iItem = 4 then
  493.        do
  494.         i = 1
  495.        end
  496.       else
  497.        do
  498.         i = 5
  499.        end
  500.       parse var sGlobal.p.i.4 sI','sTstRow','sTstCol
  501.      end
  502.     if iC = 1 then
  503.      do
  504.       sRow.iR = sI||RIGHT(sRow.iR,sGlobal.iMaxC-1)
  505.      end
  506.     else
  507.      do
  508.       sRow.iR = LEFT(sRow.iR,iC-1)||sI||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
  509.      end
  510.    end
  511.  
  512.   /* Compute the next row. If we hit a wall then beep (maybe) and    */
  513.   /* reverse the direction.                                          */
  514.   iR = iR + iRD
  515.   if iR < 1 then
  516.    do
  517.     if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
  518.      do
  519.       Call BEEP 1024, 25
  520.      end
  521.     iR = 2
  522.     iRD = +1
  523.    end
  524.   else
  525.   if iR > sGlobal.iMaxR then
  526.    do
  527.     if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
  528.      do
  529.       Call BEEP 1024, 25
  530.      end
  531.     iR = sGlobal.iMaxR - 1
  532.     iRD = -1
  533.    end
  534.  
  535.   /* Compute the next column. If we hit a wall then beep (maybe) and */
  536.   /* reverse the direction.                                          */
  537.   iC = iC + iCD
  538.   if iC < 1 then
  539.    do
  540.     if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
  541.      do
  542.       Call BEEP 1024, 25
  543.      end
  544.     iC = 2
  545.     iCD = +1
  546.    end
  547.   else
  548.   if iC > sGlobal.iMaxC then
  549.    do
  550.     if (iItem = 1 | iItem = 5) & sGlobal.fBeepWalls = 'Y' then
  551.      do
  552.       Call BEEP 1024, 25
  553.      end
  554.     iC = sGlobal.iMaxC - 1
  555.     iCD = -1
  556.    end
  557.  
  558.   sGlobal.row.iItem = iR
  559.   sGlobal.rd.iITem  = iRD
  560.   sGlobal.col.iItem = iC
  561.   sGlobal.cd.iITem  = iCD
  562.  
  563.   return 0;
  564.  
  565. HaltExit:
  566.   if fInit = 'Y' then
  567.    do
  568.     rc = rxPDTerm(sGlobal.sBid)
  569.    end
  570.   Call BEEP 882, 40
  571.   Call BEEP 882, 40
  572.   say ''
  573.   say 'SNAKE2 processing halted by request;'
  574.   exit 0
  575.  
  576. ErrorExit:
  577.   Call BEEP 882, 40
  578.   Call BEEP 882, 40
  579.   say 'SNAKE2 processing failed due to unknown error;'
  580.   exit 24
  581.  
  582. FailureExit:
  583.   Call BEEP 882, 40
  584.   Call BEEP 882, 40
  585.   say 'SNAKE2 processing failed due to unknown failure;'
  586.   exit 32
  587.  
  588. SyntaxExit:
  589.   Call BEEP 882, 40
  590.   Call BEEP 882, 40
  591.   say 'SNAKE2 processing failed due to syntax error;'
  592.   exit 64
  593.  
  594. rParseParms:
  595. parse arg p1
  596.  
  597.   do Forever
  598.    w1 = word(p1,1)
  599.    parse var w1 with "/" f1 ":" v1
  600.    select
  601.     when (w1 = '') then
  602.      do
  603.       return 0
  604.      end
  605.     when TRANSLATE(w1) = '/DEBUG' then
  606.      do
  607.       fDebug='Y'
  608.       p1 = SUBWORD(p1,2)
  609.      end
  610.     when TRANSLATE(f1) = 'D' then
  611.      do
  612.       fDebug = TRANSLATE(v1)
  613.       p1 = SUBWORD(p1,2)
  614.      end
  615.     when TRANSLATE(f1) = '?' then
  616.      do
  617.       fDispStax='Y'
  618.       fDispHelp='N'
  619.       p1 = SUBWORD(p1,2)
  620.      end
  621.     when TRANSLATE(f1) = 'H' then
  622.      do
  623.       fDispStax='N'
  624.       fDispHelp='Y'
  625.       p1 = SUBWORD(p1,2)
  626.      end
  627.     when TRANSLATE(f1) = 'T' then
  628.      do
  629.       fRetainQ='Y'
  630.       p1 = SUBWORD(p1,2)
  631.      end
  632.     when TRANSLATE(f1) = 'PC' then
  633.      do
  634.       v1 = TRANSLATE(v1)
  635.       fCollideQ = v1
  636.       if v1 = '' then
  637.        do
  638.         fCollideQ = 'Y'
  639.        end
  640.       p1 = SUBWORD(p1,2)
  641.      end
  642.     when TRANSLATE(f1) = 'PH' then
  643.      do
  644.       v1 = TRANSLATE(v1)
  645.       fHomeQ = v1
  646.       if v1 = '' then
  647.        do
  648.         fHomeQ = 'Y'
  649.        end
  650.       p1 = SUBWORD(p1,2)
  651.      end
  652.     when TRANSLATE(f1) = 'SB' then
  653.      do
  654.       v1 = TRANSLATE(v1)
  655.       fBeepTrailQ = v1
  656.       if v1 = '' then
  657.        do
  658.         fBeepTrailQ = 'Y'
  659.        end
  660.       p1 = SUBWORD(p1,2)
  661.      end
  662.     when TRANSLATE(f1) = 'CB' then
  663.      do
  664.       v1 = TRANSLATE(v1)
  665.       fBeepHeadsQ = v1
  666.       if v1 = '' then
  667.        do
  668.         fBeepHeadsQ = 'Y'
  669.        end
  670.       p1 = SUBWORD(p1,2)
  671.      end
  672.     when TRANSLATE(f1) = 'WB' then
  673.      do
  674.       v1 = TRANSLATE(v1)
  675.       fBeepWallsQ = v1
  676.       if v1 = '' then
  677.        do
  678.         fBeepWallsQ = 'Y'
  679.        end
  680.       p1 = SUBWORD(p1,2)
  681.      end
  682.     when TRANSLATE(f1) = 'HB' then
  683.      do
  684.       v1 = TRANSLATE(v1)
  685.       fBeepHomeQ = v1
  686.       if v1 = '' then
  687.        do
  688.         fBeepHomeQ = 'Y'
  689.        end
  690.       p1 = SUBWORD(p1,2)
  691.      end
  692.     when TRANSLATE(f1) = 'I' then
  693.      do
  694.       fInitCHQ='Y'
  695.       sInitCH =v1
  696.       p1 = SUBWORD(p1,2)
  697.      end
  698.     when TRANSLATE(f1) = 'R1' then
  699.      do
  700.       fInitRow1Q ='Y'
  701.       iInitRow1 =v1
  702.       if DATATYPE(iInitRow1) <> 'NUM' then
  703.        do
  704.         Call rSiren 8, 1
  705.         say 'SNAKE2 - Invalid ROW specified; Value "'v1'" not numeric;'
  706.         CALL rDispSyntax 0 8
  707.        end
  708.       p1 = SUBWORD(p1,2)
  709.      end
  710.     when TRANSLATE(f1) = 'C1' then
  711.      do
  712.       fInitCol1Q ='Y'
  713.       iInitCol1 =v1
  714.       if DATATYPE(iInitCol1) <> 'NUM' then
  715.        do
  716.         Call rSiren 8, 1
  717.         say 'SNAKE2 - Invalid COL specified; Value "'v1'" not numeric;'
  718.         CALL rDispSyntax 0 8
  719.        end
  720.       p1 = SUBWORD(p1,2)
  721.      end
  722.     when TRANSLATE(f1) = 'R2' then
  723.      do
  724.       fInitRow2Q ='Y'
  725.       iInitRow2 =v1
  726.       if DATATYPE(iInitRow2) <> 'NUM' then
  727.        do
  728.         Call rSiren 8, 1
  729.         say 'SNAKE2 - Invalid ROW specified; Value "'v1'" not numeric;'
  730.         CALL rDispSyntax 0 8
  731.        end
  732.       p1 = SUBWORD(p1,2)
  733.      end
  734.     when TRANSLATE(f1) = 'C2' then
  735.      do
  736.       fInitCol2Q ='Y'
  737.       iInitCol2 =v1
  738.       if DATATYPE(iInitCol2) <> 'NUM' then
  739.        do
  740.         Call rSiren 8, 1
  741.         say 'SNAKE2 - Invalid COL specified; Value "'v1'" not numeric;'
  742.         CALL rDispSyntax 0 8
  743.        end
  744.       p1 = SUBWORD(p1,2)
  745.      end
  746.     otherwise
  747.      do
  748.       Call rSiren 8, 1
  749.       say 'SNAKE2 - Invalid parm specified; Parm "'w1'" unknown;'
  750.       CALL rDispSyntax 0 8
  751.      end
  752.    end
  753.   end
  754.  
  755.   return 0
  756.  
  757. rDispSyntax: Procedure
  758. parse upper arg iHelp iExit
  759.  
  760.   say ' Syntax  : SNAKE2 {<options>} '
  761.   say '           SNAKE2 {/?|/h}'
  762.   if iHelp > 0 then
  763.    do
  764.     CALL rDispHelp
  765.    end
  766.  
  767.   exit iExit
  768.  
  769. rDispHelp: Procedure
  770.  
  771.   say ' Options : /?         - Display command syntax.'
  772.   say '           /h         - Display this help info.'
  773.   say '           /t         - Leave a trail where snake has traveled.'
  774.   say '           /pc        - Pause when there is a collision.'
  775.   say '           /ph        - Pause when the snakes get home.'
  776.   say '           /sb        - NOISY! Beep when step on a snake''s trail.'
  777.   say '           /cb        - NOISY! Beep when snakes collide.'
  778.   say '           /wb        - NOISY! Beep when snakes bump into walls.'
  779.   say '           /hb        - NOISY! Beep when snakes get back home.'
  780.   say '           /i:char    - Character to initialize display with.'
  781.   say '           /r1:row     - Starting row for 1st snake.'
  782.   say '           /c1:col     - Starting column for 1st snake.'
  783.   say '           /r2:row     - Starting row for 2nd snake.'
  784.   say '           /c2:col     - Starting column for 2nd snake.'
  785.   say ' Examples:'
  786.   say '    SNAKE2 /h'
  787.   say ' '
  788.   say '    SNAKE2 /t /wb /ph /hb /pc /cb /c2:1'
  789.  
  790.   return ''
  791.  
  792. /* rSiren: does the siren bit by running the scale based upon a       */
  793. /*    frequency specified by the caller.                              */
  794. rSiren: Procedure
  795.    Parse Arg freq, cycle, fStyle
  796.    note.1 = 262 * freq /* middle C */
  797.    note.2 = 294 * freq /* D */
  798.    note.3 = 330 * freq /* E */
  799.    note.4 = 349 * freq /* F */
  800.    note.5 = 392 * freq /* G */
  801.    note.6 = 440 * freq /* A */
  802.    note.7 = 494 * freq /* B */
  803.    note.8 = 524 * freq /* C */
  804.    select
  805.     when fStyle = 'U' then
  806.      do
  807.       j = 1
  808.       do 8
  809.        call beep note.j,25  /* hold each note for a 1/400 second */
  810.        j = j + 1
  811.       end /*8*/
  812.      end
  813.     when fStyle = 'D' then
  814.      do
  815.       j = 8
  816.       do 8
  817.        call beep note.j,25  /* hold each note for a 1/400 second */
  818.        j = j - 1
  819.       end /*8*/
  820.      end
  821.     otherwise
  822.      do
  823.       do j = 1 to cycle
  824.        call beep note.8,250 /* hold each note for a 1/4 second */
  825.        call beep note.1,250 /* hold each note for a 1/4 second */
  826.       end j
  827.      end
  828.    end /*select*/
  829.    Return
  830.  
  831. rLoadFuncs:
  832. parse arg sREP, sDll, sRtn
  833.   rxrc = RxFuncAdd(sREP, sDll, sRtn)
  834.   signal on syntax name xLoadFuncs
  835.   interpret 'Call 'sRtn
  836.   return 0
  837.  
  838. xLoadFuncs:
  839.   return 127
  840.