Software of the Month Club 1994 October/SOFM_Oct1994.bin/pc/os2/uguess/uguessit.cmd

OS/2 REXX Batch file | 1994-03-29 | 14KB | 661 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
  fPDInit  = 'N'
  fDebug   = 'N'
  fDispStax= 'N'
  fDispHelp= 'N'
  fUnique  = 'N'
  fWav     = 0
  fWavEnable = 'Y'
  fQuiet   = 'N'
  fGDay    = 'N'
  iUGUPanelRow=1

  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 = rWinInit(p1)
  if rc <> 0 then
   do
    exit rc
   end

  do while 0 = rUGuessIt()
  end /*do while 0 = rUGuessIt()*/

  rc = rWinTerm()

  exit 0

rUGuessIt:
  akey = ''
  do iUGUPanelRow = 1 to 10
   rc = rUGuessItPanel(iUGUPanelRow)
   select
    when rc = 0 then
     do
      iterate                          /* U Missed it */
     end
    when rc = 4 then
     do
      return 0                         /* U Guessed it */
     end
    when rc = 8 then
     do
      return 8                         /* U Guessed it */
     end
    otherwise
     do
      return rc                        /* U Quit it */
     end
   end /* select */
  end /* do iUGUPanelRow = 1 to 10 */
  return 0;

rUGuessItPanel:
parse arg iUGUPanelRow
  sPnlNdx = RIGHT(iUGUPanelRow,4,'0')
  akey = ''
  do while akey <> ZENTER
   do i = 1 to 4
    iG.i = ''
   end
   iGuess = FORMAT(iUGUPanelRow,2)
   akey = ZESC
   do while akey = ZESC
    akey = rxPDDisplay(bid,'UGIT'sPnlNdx)
    if akey = Z_S_A then
     do
      if fWavEnable = 'N' then
       do
        fWavEnable = 'Y'
       end
      else
       do
        fWavEnable = 'N'
       end
      akey = ZESC
      iterate      /* continue */
     end
   end /* do while akey = ZESC */
   if akey = Z_U_A then
    do
     if fUnique = 'Y' then
      do
       fUnique = 'N'
      end
     else
      do
       fUnique = 'Y'
      end
     Call rWinReset
     return 4                          /* Restart */
    end
   if akey = ZF1 then
    do
     svid = rxPDSaveScreen(bid)
     Call rxPDDisplay bid, 'HELP001'
     rc = rxPDRestoreScreen(bid,svid)
     akey = ''
     iterate      /* continue */
    end
   if akey = ZF3 then
    do
     return 8
    end
  end /*do while akey <> 'ESC' & akey <> 'F3'*/

  return rWinEnter(iUGUPanelRow)

rWinInit:
parse arg p1

  mrc = rLoadFuncs('SysLoadFuncs', 'REXXUTIL', 'SysLoadFuncs')
  if mrc <> 0 then
   do
    Call BEEP 882, 40
    say 'UGUESSIT.CMD - Unable to initialize "SysLoadFuncs/RexxUtil"'
    return mrc
   end

  mrc = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
  if mrc <> 0 then
   do
    Call BEEP 882, 40
    say 'UGUESSIT.CMD - Unable to initialize "RXPD system"'
    return mrc
   end

  bid = rxPDInit('UGUESSIT',,,,,25,80)
  if c2d(bid) = 0 then
   do
    Call BEEP 882, 40
    say 'UGUESSIT.CMD - Unable to initialize "Panel Display SubSystem"'
    return rc
   end
  fPDInit='Y'

  Call rxPDZVarDefine

  if fQuiet = 'Y' then
   do
    fWavEnable = 'N'
   end
  do i = 1 to 4
   iG.i = ''
   sScrlMsg.i = ''
   iM.i = ''
  end
  do i = 1 to 2
   iA.i = ''
  end

  mrc = rmciRxInit()
  if mrc = 0 then
   do
    mrc=rMciStrng('open waveaudio shareable alias wDev wait')
    if mrc = 0 then
     do
       mrc=rMciStrng('capability wDev can play wait')
       if mrc = 0 then
        do
         fWav=1
         mrc = rMciStrng('close wDev wait')
        end
       else
        do
         mrc = rMciStrng('close wDev wait')
        end
     end
   end
  else
   do
    fWavEnable = 'N'
   end
  Call rxPDDisplay bid, 'UGITINIT'
  CALL rWinReset
  return 0

rWinEnter:
parse arg iUGUPanelRow
  do i = 1 to 4
   kval.i = iG.i
  end /* do i = 1 to 4 */
  gotit = rWinTest(iUGUPanelRow,kval.1,kval.2,kval.3,kval.4)
  parse var gotit hit_ctr almost_ctr
  if hit_ctr = 4 then
   do
    sTellNum = kval.1||kval.2||kval.3||kval.4
  /*svid = rxPDSaveScreen(bid)*/
    akey = rxPDDisplay(bid,'UGITUWON')
  /*rc = rxPDRestoreScreen(bid,svid)*/
    if akey = ZENTER then
     do
      CALL rWinReset
      return 4
     end
    else
     do
      return 8
     end
   end
  if iUGUPanelRow < 10 then
   do
    return 0
   end
  else
   do
    sTellNum = iM.1||iM.2||iM.3||iM.4
  /*svid = rxPDSaveScreen(bid)*/
    akey = rxPDDisplay(bid,'UGITULOSE')
  /*rc = rxPDRestoreScreen(bid,svid)*/
    if akey = ZENTER then
     do
      CALL rWinReset
      return 4
     end
    else
     do
      return 8
     end
   end
  return 0

rWinTest:
parse arg iUGUPanelRow, gval1, gval2, gval3, gval4
  sPnlHitNdx = RIGHT(iUGUPanelRow,4,'0')
  do i = 1 to 4; itest = iM.i; end;/*TEST*/
  hit_ctr = 0
  almost_ctr = 0
  num_1_hit = 0
  num_2_hit = 0
  num_3_hit = 0
  num_4_hit = 0
  num_1_almost = 0
  num_2_almost = 0
  num_3_almost = 0
  num_4_almost = 0
  if gval1 = iM.1 then
   do
    hit_ctr = hit_ctr + 1
    num_1_hit = 1
   end
  if gval2 = iM.2 then
   do
    hit_ctr = hit_ctr + 1
    num_2_hit = 1
   end
  if gval3 = iM.3 then
   do
    hit_ctr = hit_ctr + 1
    num_3_hit = 1
   end
  if gval4 = iM.4 then
   do
    hit_ctr = hit_ctr + 1
    num_4_hit = 1
   end

  if num_1_hit = 0 then
   do
    if gval1 = iM.2 & num_2_hit = 0 then
     do
      almost_ctr = almost_ctr + 1
      num_2_almost = 1
     end
    else
     do
      if gval1 = iM.3 & num_3_hit = 0 then
       do
        almost_ctr = almost_ctr + 1
        num_3_almost = 1
       end
      else
       do
        if gval1 = iM.4 & num_4_hit = 0 then
         do
          almost_ctr = almost_ctr + 1
          num_4_almost = 1
         end
       end
     end
   end

  if num_2_hit = 0 then
   do
    if gval2 = iM.1 & num_1_hit = 0 then
     do
      almost_ctr = almost_ctr + 1
      num_1_almost = 1
     end
    else
     do
      if gval2 = iM.3 & num_3_hit = 0 & num_3_almost = 0 then
       do
        almost_ctr = almost_ctr + 1
        num_3_almost = 1
       end
      else
       do
        if gval2 = iM.4 & num_4_hit = 0 & num_4_almost = 0 then
         do
          almost_ctr = almost_ctr + 1
          num_4_almost = 1
         end
       end
     end
   end

  if num_3_hit = 0 then
   do
    if gval3 = iM.1 & num_1_hit = 0 & num_1_almost = 0 then
     do
      almost_ctr = almost_ctr + 1
      num_1_almost = 1
     end
    else
     do
      if gval3 = iM.2 & num_2_hit = 0 & num_2_almost = 0 then
       do
        almost_ctr = almost_ctr + 1
        num_2_almost = 1
       end
      else
       do
        if gval3 = iM.4 & num_4_hit = 0 & num_4_almost = 0 then
         do
          almost_ctr = almost_ctr + 1
          num_4_almost = 1
         end
       end
     end
   end

  if num_4_hit = 0 then
   do
    if gval4 = iM.1 & num_1_hit = 0 & num_1_almost = 0 then
     do
      almost_ctr = almost_ctr + 1
      num_1_almost = 1
     end
    else
     do
      if gval4 = iM.2 & num_2_hit = 0 & num_2_almost = 0 then
       do
        almost_ctr = almost_ctr + 1
        num_2_almost = 1
       end
      else
       do
        if gval4 = iM.3 & num_3_hit = 0 & num_3_almost = 0 then
         do
          almost_ctr = almost_ctr + 1
          num_3_almost = 1
         end
       end
     end
   end

  iA.1 = hit_ctr
  iA.2 = almost_ctr
  Call rxPDDisplay bid, 'UGITHIT'||sPnlHitNdx
  CALL rWinScroll "Guess # "iUGUPanelRow"; "hit_ctr" in correct position, "almost_ctr" in incorrect position;"

  if iUGUPanelRow = 5 & hit_ctr <> 4 then
   do
    mrc = rMciPlay('UGITHRRY')
    CALL rWinScroll "Better hurry, you've only got 5 guesses left!"
   end

  if iUGUPanelRow = 9 & hit_ctr <> 4 then
   do
    mrc = rMciPlay('UGITGWIN')
    CALL rWinScroll "I'm gonna win! You've only got 1 guess left!"
   end

  if iUGUPanelRow = 10 & hit_ctr <> 4 then
   do
    mrc = rMciPlay('UGITHAHA')
   end

  if hit_ctr = 4 then
   do
    CALL rWinScroll "Congratulations! You've guessed it!"
    CALL rWinScroll "  "||gval1||gval2||gval3||gval4" is correct!"
    CALL rWinScroll "   (Pure luck if you ask me.) |:-("
    mrc = rMciPlay('UGITLDOG', 'WAIT')
   end
  return hit_ctr almost_ctr

rWinScroll:
parse arg sMsg
  do i = 2 to 4
   j = i - 1
   sScrlMsg.j = sScrlMsg.i
  end /* do i = 2 to 4 */
  sScrlMsg.4 = sMsg
  Call rxPDDisplay bid, 'UGITSCROLL'
  return

rWinReset:
  if fUnique = 'N' then
   sWinTitle = CENTER('UGuessIt - (Not Necessarily Unique Digits)',80,' ')
  else
   sWinTitle = CENTER('UGuessIt - (Unique Digits)',80,' ')
  iGuess = ' 1'
  Call rxPDDisplay bid, 'UGITRESET'
  if fUnique = 'N' then
   do
    cRandom = 'not necessarily unique'
   end
  else
   do
    cRandom = 'unique'
   end
  CALL rWinScroll "Ok, I'm thinking of a 4 digit number where each digit is "
  CALL rWinScroll " "cRandom". Your mission is to guess the number"
  CALL rWinScroll "  within ten tries otherwise I win."
  CALL rWinScroll "I *LIKE* winning! I *HATE* quitters!"
  if fUnique = 'N' then
   do
    secret = RANDOM(9999)
    secret = RIGHT(secret,4,'0')
    iM.1 = substr(secret,1,1)
    iM.2 = substr(secret,2,1)
    iM.3 = substr(secret,3,1)
    iM.4 = substr(secret,4,1)
   end
  else
   do
    testit = 'N'
    do while testit = 'N'
     secret = RANDOM(9999)
     secret = RIGHT(secret,4,'0')
     iM.1 = substr(secret,1,1)
     iM.2 = substr(secret,2,1)
     iM.3 = substr(secret,3,1)
     iM.4 = substr(secret,4,1)
     if iM.1 <> iM.2 & iM.1 <> iM.3 & iM.1 <> iM.4 & iM.2 <> iM.3 & iM.2 <> iM.4 & iM.3 <> iM.4 then testit = 'Y'
    end
   end
  if fGDay = 'N' then
   do
    mrc = rMciPlay('UGITGDAY')
    fGDay = 'Y'
   end
  return

rWinTerm:
  if fWav = 1 then
   do
    mrc = rMciPlay('UGITQUIT', 'WAIT')
    fWav = 0
   end

  rc=rxPDTerm(bid)

  return 0

rMciRxInit:
  rxrc = RxFuncAdd('mciRxInit', 'MCIAPI', 'mciRxInit')
  signal on syntax name xmciRxInit
  mrc = mciRxInit()
  return 0

xMciRxInit:
  return 127

rMciPlay:
parse arg pwave, asynchQ
  if fWav = 1 & fWavEnable = 'Y' then
   do
    sPWaveFlSpec=SysSearchPath('DPATH',pwave'.wav')
    rc = rMciStrng('play 'sPWaveFlSpec' wait')
    if rc <> 0 then
     do
      pwave = '"'pwave'"'
      sMCIErr = '"'sMCIErr'"'
      Call rSiren 8, 3
      if fPDInit = 'Y' then
       do
        svid = rxPDSaveScreen(bid)
        akey = rxPDDisplay(bid,'UGITWAVERR')
        rc = rxPDRestoreScreen(bid,svid)
       end
      else
       do
        say 'Unable to play ''.WAV'' file 'pwave
        say 'MCI Error Message:'
        say sMCIErr
        '@pause'
       end
      fWavEnable = 'N'
     end
   end
  return 0

rMciStrng:
parse arg ctext
   mrc = mciRxSendString(ctext, 'retstr', '0', '0')
   if mrc <> 0 then
    do
     erc = mrc
     sMCIErr = 'RC='erc';'
     mrc = mciRxGetErrorString(erc, 'errstr')
     sMCIErr = sMCIErr errstr';'
     mrc = erc
    end
   return mrc

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

xLoadFuncs:
  return 127

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

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

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

SyntaxExit:
  Call BEEP 882, 40
  Call BEEP 882, 40
  say 'UGUESSIT 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 0 <> ABBREV('/SHHHHHHHH',TRANSLATE(w1),3) then
     do
      fQuiet='Y'
      p1 = SUBWORD(p1,2)
     end
    when 0 <> ABBREV('/UNIQUE',TRANSLATE(w1),3) then
     do
      fUnique='Y'
      p1 = SUBWORD(p1,2)
     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 'UGUESSIT - Invalid parm specified; Parm "'w1'" unknown;'
      CALL rDispSyntax 0 8
     end
   end
  end

  return 0

rDispSyntax: Procedure
parse upper arg iHelp iExit

  say ' Syntax  : UGUESSIT {<options>} '
  say '           UGUESSIT {/?|/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 '           /shhh      - No sounds please.'
  say '           /unique    - Guesses to use all unique digits.'
  say ' Examples:'
  say '    UGUESSIT /h'
  say ' '
  say '    UGUESSIT'

  return ''

/* rSiren: does the siren bit by running the scale based upon a       */
/*    frequency specified by the caller.                              */
rSiren: Procedure
   Parse Arg freq, cycle
   do j = 1 to cycle
    call beep 524*freq,250 /* hold each note for a 1/4 second */
    call beep 262*freq,250 /* hold each note for a 1/4 second */
   end j
   Return