Rexx: No Dog Here

From OS2World.Com Wiki
Revision as of 23:57, 21 February 2020 by Martini (talk | contribs) (Created page with "Some might say I'm a little Rexx-happy, or that I must be a programmer to be so interested in programming OS/2. I'm not, though, and that's what I've found so handy about Rexx...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

Some might say I'm a little Rexx-happy, or that I must be a programmer to be so interested in programming OS/2. I'm not, though, and that's what I've found so handy about Rexx. The day I started writing little programs was the day my computer started working for me rather than just with me. You can only get so much mileage from the latter, and once I'd learned to use OS/2's GUI I saw that there had to be a way that I didn't have to be there all the time.

Along came Rexx. It's not C, or Lisp or Perl, but it's the most performance for the (comprehensible) buck that I had, and best of all I had already paid for it when I bought OS/2.

Want so see some? Select one of these entries to view a few Rexx bits that OS/2 installs for you in the E editor. To leave E, press [F3].

c
\os2\HELP.CMD
A simple batch-like wrapper for the HELP command. This will look familiar, and isn't Rexx, but it shows you that you can still do batch files.
c
\os2\REXXTRY.CMD
This is Rexx, as denoted by the /* comment on line 1. A single-step program for you to try Rexx commands from the command line. For now, just browse through the code and see what you can make of it.
c
\mmos2\PLAY.CMD, c:\mmos2\RECORD.CMD
Only if you have MultiMedia installed. Manipulate WAV files (and others) from the command line or other Rexx programs. Demonstrates use of other function libraries.


HELP.CMD

@echo off
rem SCCSID = @(#)help.cmd	6.4 91/08/05
rem *
rem * Process HELP requests:  verify specification of 'ON' or 'OFF'
rem *
if '%1' == ''    goto msg
if '%1' == 'on'  goto yes
if '%1' == 'off' goto no
if '%1' == 'ON'  goto yes
if '%1' == 'OFF' goto no
if '%1' == 'On'  goto yes
if '%1' == 'oN'  goto yes
if '%1' == 'OFf' goto no
if '%1' == 'OfF' goto no
if '%1' == 'Off' goto no
if '%1' == 'oFF' goto no
if '%1' == 'oFf' goto no
if '%1' == 'ofF' goto no
helpmsg %1 %2
goto exit
:msg
helpmsg
goto exit
:yes
prompt $i[$p]
goto exit
:no
cls
prompt
:exit

REXXTRY.CMD

/* SAA-portable REXXTRY procedure     11/08/91  version 1.05
  Owned by IBM REXX Development.
    Loosely derived from an ancient formulation of Mike Cowlishaw.

  This procedure lets you interactively try REXX statements.
    If you run it with no parameter, or with a question mark
    as a parameter, it will briefly describe itself.
  You may also enter a REXX statement directly on the command line
    for immediate execution and exit.  Example:  rexxtry call show

  Enter 'call show' to see user variables provided by REXXTRY.
  Enter '=' to repeat your previous statement.
  Enter '?' to invoke system-provided online help for REXX.
  The subroutine named 'sub' can be CALLed or invoked as 'sub()'.
  REXXTRY can be run recursively with CALL.

  Except for the signal instructions after a syntax error, this
    procedure is an example of structured programming.
  The 'clear' routine illustrates system-specific SAA-portable coding.
*/
  parse arg argrx                      /* Get user's arg string.    */
  call house                           /* Go do some housekeeping.  */
  select                               /* 3 modes of operation...   */
    when argrx = '?' then call tell    /*   1.  Tell user how.      */
    when argrx = ''  then do           /*   2.  Interactive mode.   */
      call intro ; call main ; end
    otherwise push argrx ; call main   /*   3.  One-liner and exit. */
  end
done:  exit                            /* The only exit.            */

house:                                 /* Housekeeping.             */
  parse version version                /* Fill-in 2 user variables. */
  parse source source                  /*                           */
  parse source sysrx . procrx .        /* Get system & proc names.  */
  remindrx = "Enter 'exit' to end."    /* How to escape rexxtry.    */
  helprx=''                            /* Null if not CMS or OS/2.  */
  if sysrx = 'CMS' | sysrx = 'OS/2'    /*   Extra reminder for CMS  */
    then helprx = '   ',               /*     or OS/2.              */
    "  Or '?' for online REXX help."   /*   Not used in intro.      */
  promptrx=''                          /* Null if not one-liner.    */
  if argrx<>'' then promptrx=procrx' ' /*   Name part of user line. */
  if sysrx = 'OS/2' then do            /* OS/2-specific...          */
    posrx = lastpos('\',procrx)        /*   Find name separator.    */
    procrx = substr(procrx,posrx+1)    /*   Pick up the proc name.  */
    end
  temprx = ' 'procrx' on 'sysrx        /* Make border...            */
    posrx = 69-length(temprx)          /*   where to overlay name,  */
    bordrx = copies('.',68)            /*   background of periods,  */
    bordrx =,                          /*   name right-adjusted.    */
      overlay(temprx,bordrx,posrx)
  save = ''                            /* Don't save user input.    */
  trace = 'Off'                        /* Init user trace variable. */
  return result                        /* Preserve result contents. */

tell:  call clear ; do irx = 1 to 20   /* Tell about rexxtry by     */
  say sourceline(irx) ; end            /*   displaying the prolog.  */
  return result                        /* Preserve result contents. */

clear:  select                         /* SAA-portable code.        */
  when sysrx = 'CMS'  then 'VMFCLEAR'  /* No such command on        */
  when sysrx = 'OS/2' then 'CLS'       /*   OS/400 or TSO.          */
  otherwise nop ; end ; say
  return result                        /* Preserve result contents. */

intro:                                 /* Display brief             */
  say '  'procrx' lets you',           /*   introductory            */
    'interactively try REXX',          /*   remarks for             */
    'statements.'                      /*   interactive mode.       */
  say '    Each string is executed',
    'when you hit Enter.'
  say "      Enter 'call tell' for",   /* How to see description.   */
    "a description of the features."
  say '  Go on - try a few...   ',
    '         'remindrx
  return result                        /* Preserve result contents. */

sub:  say '  ...test subroutine',      /* User can CALL this        */
  "'sub'  ...returning 1234..."        /*   subroutine or           */
  return 1234                          /*   invoke with 'sub()'.    */

main:  signal on syntax                /* Enable syntax trap.       */
  do foreverrx = 1                     /* Loop forever.             */
    prev = inputrx                     /* User can repeat previous. */
    parse pull inputrx                 /* Input keyboard or queue.  */
    current = inputrx                  /* Current line for 'show'.  */
    if save <> '' then call save       /* Save before interpreting. */
    if inputrx = '=' then inputrx=prev /* '=' means repeat previous */
    select
      when inputrx = '' then say ' ',  /* If null line, remind      */
        procrx':  'remindrx helprx     /*   user how to escape.     */
      when inputrx='?' then call help  /* Request for online help.  */
      otherwise
        rc = 'X'                       /* Make rc change visible.   */
        call set2 ; trace (trace)      /* Need these on same line.  */
        interpret inputrx              /* Try the user's input.     */
        trace 'Off'                    /* Don't trace rexxtry.      */
        call border                    /* Go write the border.      */
    end
    if argrx <> '' & queued() = 0      /* For one-liner, loop until */
      then leave                       /*   queue is empty.         */
  end ; return result                  /* Preserve result contents. */

set1:  siglrx1 = sigl                  /* Save pointer to lineout.  */
  return result                        /* Preserve result contents. */

set2:  siglrx2 = sigl                  /* Save pointer to trace.    */
  return result                        /* Preserve result contents. */

save:                                  /* Save before interpreting. */
  call set1;rcrx=lineout(save,inputrx) /* Need on same line.        */
  if rcrx <> 0 then                    /* Catch non-syntax error    */
    say "  Error on save="save         /*   from lineout.           */
  return result                        /* Preserve result contents. */

help:  select                          /* Request for online help.  */
  when sysrx = 'CMS' then              /* Invoke CMS help menu for  */
    address CMS 'HELP REXX MENU'       /*   for REXX.               */
  when sysrx = 'OS/2' then             /* Invoke OS/2 online REXX   */
    'view rexx.inf'                    /*   Reference.              */
  otherwise say '  'sysrx' has',       /* Todate, only CMS and OS/2 */
    'no online help for REXX.'         /*   provide online help     */
    rc = 'Sorry !' ; end               /*   for REXX.               */
  call border ; return result          /* Preserve result contents. */

border:  if rc = 'X' then              /* Display border.           */
    say '  'bordrx
  else say ' ',                        /* Show return code if it    */
    overlay('rc = 'rc' ',bordrx)       /*   has changed.            */
  return result                        /* Preserve result contents. */

syntax:  trace 'Off'                   /* Stop any tracing.         */
  select
    when sigl = siglrx1 then do        /* User's 'save' value bad.  */
      say "  Invalid 'save' value",
        "'"save"', resetting to ''."
      save='' ; end
    when sigl = siglrx2 then do        /* User's 'trace' value bad. */
      say "  Invalid 'trace' value",
        "'"trace"', resetting to",
        "'Off'." ; trace='Off' ; end
    otherwise                          /* Some other syntax error.  */
                                       /* Show the error msg text.  */
         say '  Oooops ! ... try again.     'errortext(rc)

      parse version . rxlevel .
      if rxlevel > 4.00 then do        /* get the secondary message */
        secondary = condition('o')~message
        if .nil <> secondary then      /* get a real one?           */
                                       /* display it also           */
          say '                              'secondary; end

      if sysrx='CMS' then call cmstax  /* More syntax stuff for CMS */
  end ; call border                    /* Go write the border.      */
  if argrx <> '' & queued() = 0 then   /* One-liner not finished    */
    signal done                        /*   until queue is empty.   */
  signal main                          /* Resume main loop.         */

cmstax:  rcrx = rc                     /* More syntax stuff for CMS */
  if exist('PROMPT MODULE') then       /* User's input to cmd line. */
    'PROMPT' promptrx||'13'x||inputrx  /*   '13'x places cursor.    */
  if exist('REXX EXEC') & argrx=''     /* Not for one-liners.       */
  then do; more='EXEC REXX' rcrx+20000 /* CMS rc is 20,000 higher.  */
    say "  Enter 'more' to see",       /* Prepare 'more' to access  */
      'information about this',        /*  REXX IOSLIB information. */
      'syntax error.' ; end            /* Tell user what to do.     */
  rc = rcrx ; return result            /* Preserve result contents. */

exist:  arg inrx ; outrx = 0           /* Assume file is missing.   */
  address command 'ESTATE' inrx        /* Does the file exist ?     */
  if rc = 0 then outrx = 1             /* estate says it exists.    */
  return outrx                         /* 1 makes condition true.   */

show:  trace 'Off' ; call clear        /* Display user variables    */
  say '  'procrx' provides',           /*   provided by rexxtry.    */
    'these user variables.'
  say '  The current values are...'    /* Show current values.      */
  say
  say "    'version'   = '"version"'"  /* What level of REXX.       */
  say "    'source'    = '"source"'"   /* What oper system etc.     */
  say "    'result'    = '"result"'"   /* REXX special variable.    */
  say
  say '     Previous line entered by',
    'user.  Initial value=INPUTRX.'
  say "    'prev'      = '"prev"'"     /* Previous user statement.  */
  say "    'current'   = '"current"'"  /* Compare curr with prev.   */
  say
  say '     Save your input with',
    'save=filespec.',
    " Stop saving with save=''."
  say "    'save'      = '"save"'"     /* Filespec for input keep.  */
  say
  say '     Enter trace=i, trace=o',
    ' etc. to control tracing.'
  say "    'trace'     = '"trace"'"    /* Trace user statements.    */
  return result                        /* Preserve result contents. */

PLAY.CMD

/*-----------------------------------------------------------------------------

  Name:                   play.cmd
  Date Created:    12/27/92
                Copyright (c) IBM Corporation  1992, 1993
                          All Rights Reserved


  OS/2 REXX command file that uses MultiMedia REXX functions
  to play a file.

 -----------------------------------------------------------------------------*/

address cmd      /* Send commands to OS/2 command processor.  */
signal on error   /* When commands fail, call "error" routine. */
signal on halt    /* When user does a ctrl break               */

trace off
/*trace ?r*/

/* initialize variables */
FILE=''
FROM=''
TO=''
DEV=''
TIMEFMT=''

/* Setup keyword string array */
kwd.0 = 5
kwd.1 = 'FILE'
kwd.2 = 'DEV'
kwd.3 = 'TO'
kwd.4 = 'FROM'
kwd.5 = 'TIMEFMT'

/* Clear out argx variables */
do i = 1 to 5
  junk = value('arg'i,'')
end

arg inline                      /* Get the command line parms */
if (inline='' | inline='?') then
   do
     call Help
     exit 0
   end

/*
 * Check for each keyword
 * If "FILE" is found, look for quotes which signify possible embedded
 *   blanks.
 * Set argx (x is 1 to 5) to the entire keyword string, which ends in
 *   either a blank or a quote.
 */
do i = 1 to kwd.0

  kwdpos = pos(kwd.i, inline)   /* Position of matching keyword */
  if kwdpos > 0  then           /* Found a keyword */
  do

    if kwd.i = 'FILE' then      /* Check for quote after FILE= */
    do
      endchar = substr(inline, kwdpos+length(kwd.i)+1,1)
      if endchar <> '"' then endchar = ' '
    end

    else  endchar = ' '         /* Not FILE=, use blank as delimiter */

    /*  Find delimiter (either next quote or blank) */
    fnend = pos(endchar, inline, kwdpos+length(kwd.i)+2)
    if fnend = 0 then           /* Ending quote/blank not found */
    do
      if endchar = '"' then
        say 'Missing ending quote mark for' kwd.i 'keyword'
      fnend = length(inline)    /* Assume it's just end of line */
    end

    /* Set argx to the keyword=data */
    junk = value('arg'i, substr(inline, kwdpos, fnend-kwdpos+1))

  end                           /* End if a keyword was found */

end                             /* End do i = 1 to num of keywords */

/* display values of the argx variables */
/* do i = 1 to 5
    say 'arg'i 'is' value('arg'i)
   end        */

parse var arg1 arg1a'='arg1b
parse var arg2 arg2a'='arg2b
parse var arg3 arg3a'='arg3b
parse var arg4 arg4a'='arg4b
parse var arg5 arg5a'='arg5b


/* Set the variables. */
call keyword arg1a, arg1b
call keyword arg2a, arg2b
call keyword arg3a, arg3b
call keyword arg4a, arg4b
call keyword arg5a, arg5b



/* Load the DLL, initialize MCI REXX support */
rc = RXFUNCADD('mciRxInit','MCIAPI','mciRxInit')
InitRC = mciRxInit()
MciCmd = 'open'

/*
** Check to see if the FILE && DEV variables are valid.
*/
     if FILE<>'' then
        do
          if DEV<>'' then
             MciCmd = MciCmd FILE 'type' DEV
          else
             MciCmd = MciCmd FILE
        end
     else if DEV<>'' then
        MciCmd = MciCmd DEV
     else
           do
             call Help
             exit 0
           end

/*
** Append the rest of the command line.
*/
    MciCmd = MciCmd 'alias rexxalias wait'

/*
** Issue the open command.
*/
    MacRC = SendString(MciCmd)
     if MacRC <> 0 then signal ErrExit
     else
     do
       if DEV='' then    /* device not specified */
         do     /* determine the device type */
          MacRC = SendString("capability rexxalias device type wait")
          if MacRC <> 0 then
              do
                 junk = SendString("close rexxalias wait")
                 signal ErrExit
              end
         end
       else   /* set the device specified as the device type */
         RetSt = DEV

       /* If a wave file is to be played then do a status length */
       /* to determine if the wave file exists.  A wave file is  */
       /* the only type of device that if it doesn't exist and   */
       /* you play it, it won't come back as file not found      */
       if TRANSLATE(RetSt) = 'WAVEAUDIO' then
         do
            MacRC = SendString("status rexxalias length wait")      /* If length is 0 no file exists */
             if MacRC <> 0 then
              do
                 junk = SendString("close rexxalias wait")
                 signal ErrExit
              end
             if RetSt = 0 then
              do
                 junk = SendString("close rexxalias wait")
                 ErrRC = 70555
                 MacRC = mciRxGetErrorString(ErrRC, 'ErrStVar')
                 say 'mciRxGetErrorString('ErrRC') =' ErrStVar
                 signal ErrExit
              end
         end
     end

/*
** Exercise mciRxGetDeviceID function
*/
DeviceID = mciRxGetDeviceID(""rexxalias"")

/*
**  Check to see if a time format was given.
*/
if TIMEFMT <> '' then
do
    MciCmd = 'set rexxalias time format' TIMEFMT 'wait'
    MacRC = SendString(MciCmd)
     if MacRC <> 0 then
        do
         junk = SendString("close rexxalias wait")
         signal ErrExit
        end
end

/*
** Formulate the play command.
*/
MciCmd = 'play rexxalias'

/*
** check to see if an origin was set.
*/
 if FROM<>'' then
        MciCmd = MciCmd 'from' FROM

/*
** check to see if a terminating point was given.
*/
 if TO<>'' then
        MciCmd = MciCmd 'to' TO

/*
** append a wait onto the end of the play string.
*/
MciCmd = MciCmd 'wait'

/*
** actually send the play string.
*/
MacRC = SendString(MciCmd)
     if MacRC <> 0 then
        do
         junk = SendString("close rexxalias wait")
         signal ErrExit
        end

/*
** close the instance.
*/
MacRC = SendString("close rexxalias wait")
if MacRC <> 0 then signal ErrExit

/*
** Exit, return code = 0.
*/
exit 0

/*   --- SendString --
** Call DLL function.  Pass the command to process and the
** name of a REXX variable that will receive textual return
** information.
*/
SendString:
   arg CmndTxt
   /* Last two parameters are reserved, must be set to 0           */
   /* Future use of last two parms are for notify window handle    */
   /* and userparm.                                                 */
   MacRC = mciRxSendString(CmndTxt, 'RetSt', '0', '0')
   if MacRC<>0 then
      do
      ErrRC = MacRC
      say 'MciCmd=' CmndTxt
      say 'Err:mciRxSendString RC=' ErrRC RetSt
      MacRC = mciRxGetErrorString(ErrRC, 'ErrStVar')
      say 'mciRxGetErrorString('ErrRC') =' ErrStVar
      MacRC = ErrRC /* return the error rc */
      end
   return MacRC

/* -- keywords --
**
** Parse the arguments according to the keywords.
*/
keyword:
        arg key, value
        if key='FILE' then
            FILE=value
        else if key='DEV' then
            DEV=value
        else if key='FROM' then
             FROM=value
        else if key='TO' then
              TO=value
        else if key='TIMEFMT' then
                TIMEFMT=value

return

/*  -- help --
** Display help text
*/
Help:
   say
   say 'This command file plays a file or device using the MultiMedia'
   say 'REXX string interface.'
   say
   say 'play [FILE="filename"] [DEV=device] [TIMEFMT=timefmt]'
   say '         [FROM=from_position] [TO=to_position]'
return

/*  --- ErrExit --
** Common routine for error clean up/program exit.
** Gets called when commands to DLL fail.
*/
ErrExit:
   MacRC = mciRxExit()   /* Tell the DLL we're going away        */
   exit 1;               /* exit, tell caller things went poorly */


/*   ---- error --
** Routine gets control when any command to the external
** environment (usually OS/2) returns a non-zero RC.
** This routine does not get called when the macapi.dll
** returns non-zero as it is a function provider rather
** than a command environment.
*/
error:
   ErrRC = rc
   say 'Error' ErrRC 'at line' sigl ', sourceline:' sourceline(sigl)
   MacRC = mciRxExit()       /* Tell the DLL we're going away */
   exit ErrRC                /* exit, tell caller things went poorly */

/*   ---- halt --
** Routine gets control when user hits ctrl break to end
*/
halt:
   say 'Halting...'
   MacRC = SendString("close rexxalias wait")
   if MacRC <> 0 then signal ErrExit
   exit 0

RECORD.CMD

/*-----------------------------------------------------------------------------

  Name:                   record.cmd
  Date Created:    12/27/92
                Copyright (c) IBM Corporation  1992, 1993
                          All Rights Reserved

  OS/2 REXX command file that uses MultiMedia REXX API's
  to record a wave file with the default settings of the audio
  card from the microphone in jack.

-----------------------------------------------------------------------------*/

address cmd      /* Send commands to OS/2 command processor.  */
signal on error   /* When commands fail, call "error" routine. */

trace off
/*trace ?r */


parse arg WaveFileName              /* Fetch command line parms */

if WaveFileName='' | WaveFileName='?' then
   do
     call Help
     exit 0
   end

/* Load the DLL, initialize MCI REXX support */
rc = RXFUNCADD('mciRxInit','MCIAPI','mciRxInit')
InitRC = mciRxInit()

/*
** Open the instance.
*/
MciCmd = 'open' WaveFileName 'alias rexxalias type waveaudio wait'
MacRC = SendString(''MciCmd'')       /* Put double single quotes around the command */
if MacRC <> 0 then signal ErrExit

MacRC = SendString("delete rexxalias from 0 wait")
if MacRC <> 0 then signal ErrExit

/*
** Exercise mciRxGetDeviceID function
*/
DeviceID = mciRxGetDeviceID(""rexxalias"")

/*
** Get the connector.
*/
MacRC = SendString("connection rexxalias query type wave stream alias rexxmic wait")
if MacRC <> 0 then signal ErrExit

/*
** Set the monitor attribute to off.
*/
MacRC = SendString("set rexxmic monitor off wait")
if MacRC <> 0 then signal ErrExit

/*
** Get the microphone connection.
*/
MacRC = SendString("connector rexxmic enable type microphone wait")
if MacRC <> 0 then signal ErrExit

/*
** Start the record operation.
*/
MacRC = SendString("record rexxalias")
if MacRC <> 0 then signal ErrExit
/*
** Notify users that recording is in progress.
*/
say 'Record operation is now in progress.'
say '<Press Enter to stop recording.>'

/*
** Wait for a key to be pressed:
 */
   pull trash

/*
** Stop recording
*/
MacRC = SendString("stop rexxalias wait")
if MacRC <> 0 then signal ErrExit

/*
** Save the file
*/
MacRC = SendString("save rexxalias wait")
if MacRC <> 0 then signal ErrExit

/*
** Close the instance
*/
MacRC = SendString("close rexxalias wait")
if MacRC <> 0 then signal ErrExit

/*
** Exit, return code = 0.
*/
exit 0

/*   --- SendString --
** Call DLL function.  Pass the command to process and the
** name of a REXX variable that will recieve textual return
** information.
*/
SendString:
   arg CmndTxt
   /* Last two parameters are reserved, must be set to 0           */
   /* Future use of last two parms are for notify window handle    */
   /* and userparm.                                                 */
   MacRC = mciRxSendString(CmndTxt, 'RetSt', '0', '0')
   if MacRC<>0 then
      do
      ErrRC = MacRC
      say 'MciCmd=' CmndTxt
      say 'Err:mciRxSendString RC=' ErrRC RetSt
      MacRC = mciRxGetErrorString(ErrRC, 'ErrStVar')
      say 'mciRxGetErrorString('ErrRC') =' ErrStVar
      MacRC = ErrRC /* return the error rc */
      end
   return MacRC


/*  -- help --
** Display help text
*/
Help:
   say
   say 'This command file records a wave file using the MultiMedia'
   say 'REXX string interface.'
   say
   say 'record filename'
   say
   return

/*  --- ErrExit --
** Common routine for error clean up/program exit.
** Gets called when commands to DLL fail.
*/
ErrExit:
   MacRC = mciRxExit()   /* Tell the DLL we're going away        */
   exit 1;               /* exit, tell caller things went poorly */


/*   ---- error --
** Routine gets control when any command to the external
** environment (usually OS/2) returns a non-zero RC.
** This routine does not get called when the macapi.dll
** returns non-zero as it is a function provider rather
** than a command environment.
*/
error:
   ErrRC = rc
   say 'Error' ErrRC 'at line' sigl ', sourceline:' sourceline(sigl)
   MacRC = mciRxExit()       /* Tell the DLL we're going away */
   exit ErrRC                /* exit, tell caller things went poorly */