DELAY.REX: Difference between revisions

From Rosetta Code
Content added Content deleted
(adjusted SLEEP time for specific systems. -- ~~~~)
m (added a comment concerning fractional seconds.)
 
(8 intermediate revisions by the same user not shown)
Line 1: Line 1:
This the   '''DELAY.REX'''   REXX program which emulates the '''delay''' bif function for some REXX programs.
This the   '''DELAY.REX'''   REXX program which emulates the   '''delay'''   BIF function as implemented by the PC/REXX and Personal REXX interpreters.
<lang rexx>/**/trace o;parse arg !;if !all(arg()) then exit;if !cms then address '';signal on halt;signal on novalue;signal on syntax


This REXX program (below) will work with most REXXes:
/*┌────────────────────────────────────────────────────────────────────┐
:::* CMS REXX
┌─┘ └─┐
:::* PC/REXX &nbsp; (see note)
│ The DELAY function to delay a specific amount of (wall-clock) time │
:::* Personal REXX &nbsp; (see note)
(specified in whole seconds).
:::* REGINA REXX
:::* ROO REXX
│ If the REXX program invoking DELAY function is running under PC/REXX,│
:::* R4 REXX
│ this REXX routine should never be invoked as PC/REXX has its own built-│
:::* TSO REXX
│ in function (BIF). │
:::* (Microsoft) DOS
└─┐ ┌─┘
:::* (Microsoft) Windows
└────────────────────────────────────────────────────────────────────┘*/
:::* any system that supports the PING command
in conjunction with the following program (either external or imbedded).


<br>Note: &nbsp; when PC/REXX or Personal REXX are used, those REXXes already have a built-in function (BIF), so the &nbsp; '''delay''' &nbsp; subroutine (below) will never be executed, but the REXX &nbsp; '''DELAY''' &nbsp; BIF will be used instead.
@cpsleep = 'CP SLEEP' /*point to (CP) SLEEP cmd*/
@ping = 'PING' /*point to the dos PING cmd*/


For non-Regina REXXes, &nbsp; this REXX program only uses whole seconds &nbsp; (fractional seconds are ignored).
parse var ! n _ /*parse argument from parms*/
if _\=='' | arg()>1 then call er 59 /*are there too many args? */
if n=='' then n=1 /*no arg? Then assume 1 sec*/
if \isnum(n) then call er 53,dsec 'delay-seconds' /*is n numeric?*/
n=n/1 /*remove any decimal point.*/
if n<=0 then return 0


=={{header|REXX}}==
/*┌─────────────────────────────┐
<lang rexx> select
│ delay nn seconds. │
when !cms then @cpsleep n "SEC" /*Is this CMS? Use CP SLEEP. */
└─────────────────────────────┘*/
when !tso then call sleep n /*Is this TSO? Use SLEEP cmd. */

when !regina then do /*Is this Regina? */
select
when !cms then @cpsleep n%1 "SEC" /*CMS? Use CP SLEEP*/
if nFrac=n then call sleep n /*whole seconds? */
when !tso then call sleep n%1 /*TSO? Use SLEEP*/
else call beep 32767, nFrac * 1000 /*uses fraction. */
when !regina then call sleep n%1 /*Regina? Use SLEEP*/
/* [↑] sound MAY be heard, faint tic.*/
when !dos then @ping '-n' n "127.0.0.1 > NUL" /*DOS? use PING */
end
when !dos then @ping @pingArgs /*Is this DOS? Use PING command.*/
otherwise nop
otherwise nop /*don't know what this environment is.*/
end /*select*/
end /*select*/


return 0 /*return a zero value. */


return 0 /*return a zero value (if a function).*/


halt: return 1 /*return a zero value (if a function).*/

/*══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=3=='f3'x; if !crx then !env='DOS'; return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm, 1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space( dosenv( arg(1) ) ); return space( value( arg(1), , !env) )
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1, 2) !fid(1)) _2; if _1<0 then return _1; exit result
p: return word( arg(1), 1)
halt: call er .1
isNum: return datatype( arg(1), 'N')
noValue: !sigl=sigl; call er 17, !fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
syntax: !sigl=sigl; call er 13, !fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>

Coding note: &nbsp; the &nbsp; '''!<small>xxx</small>''' &nbsp; subroutines (above) deal mostly with determining what version of REXX is being invoked and what operating system is being used; &nbsp; and based on that information, appropriate flags (variables) are set. &nbsp; This is an example of a robust boilerplate code checking for various versions of REXX and operating systems, and it also defines additional flags not used within this particular program.


Programming note: &nbsp; The subroutine &nbsp; '''$ERR''' &nbsp; isn't included here; &nbsp; so here is the gist of the error messages:
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
::* &nbsp; '''er 59''' &nbsp; &nbsp; &nbsp; too many arguments specified for the ─── DELAY ─── command.
!all:!!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
::* &nbsp; '''er 53''' &nbsp; &nbsp; &nbsp; argument ─── xxx ─── isn't numeric for the option ─── delay-seconds ─── for the ─── DELAY ─── command.
!cal: if symbol('!CALL')\=="VAR" then !call=;return !call
!env: !env='ENVIRONMENT';if !sys=='MSDOS'|!brexx|!r4|!roo then !env='SYSTEM';if !os2 then !env='OS2'!env;!ebcdic=1=='f0'x;return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .;call !sys;if !dos then do;_=lastpos('\',!fn);!fm=left(!fn,_);!fn=substr(!fn,_+1);parse var !fn !fn '.' !ft;end;return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .;!brexx='BY'==!vernum;!kexx='KEXX'==!ver;!pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver;!r4='REXX-R4'==!ver;!regina='REXX-REGINA'==left(!ver,11);!roo='REXX-ROO'==!ver;call !env;return
!sys: !cms=!sys=='CMS';!os2=!sys=='OS2';!tso=!sys=='TSO'|!sys=='MVS';!vse=!sys=='VSE';!dos=pos('DOS',!sys)\==0|pos('WIN',!sys)\==0|!sys=='CMD';call !rex;return
!var: call !fid;if !kexx then return space(dosenv(arg(1)));return space(value(arg(1),,!env))
er: parse arg _1,_2;call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2;if _1<0 then return _1;exit result
p: return word(arg(1),1)
halt: call er .1
isint: return datatype(arg(1),'W')
isnum: return datatype(arg(1),'N')
novalue:!sigl=sigl;call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
syntax: !sigl=sigl;call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>

Latest revision as of 11:33, 26 February 2021

This the   DELAY.REX   REXX program which emulates the   delay   BIF function as implemented by the PC/REXX and Personal REXX interpreters.

This REXX program (below) will work with most REXXes:

  • CMS REXX
  • PC/REXX   (see note)
  • Personal REXX   (see note)
  • REGINA REXX
  • ROO REXX
  • R4 REXX
  • TSO REXX
  • (Microsoft) DOS
  • (Microsoft) Windows
  • any system that supports the PING command

in conjunction with the following program (either external or imbedded).


Note:   when PC/REXX or Personal REXX are used, those REXXes already have a built-in function (BIF), so the   delay   subroutine (below) will never be executed, but the REXX   DELAY   BIF will be used instead.

For non-Regina REXXes,   this REXX program only uses whole seconds   (fractional seconds are ignored).

REXX

<lang rexx> select

 when !cms     then @cpsleep   n    "SEC"        /*Is this  CMS?      Use   CP SLEEP.  */
 when !tso     then call sleep n                 /*Is this  TSO?      Use   SLEEP cmd. */
 when !regina  then do                           /*Is this Regina?                     */
                    if nFrac=n  then call sleep n                     /*whole seconds? */
                                else call beep 32767, nFrac * 1000    /*uses fraction. */
                                                 /* [↑]  sound MAY be heard, faint tic.*/
                    end
 when !dos     then @ping  @pingArgs             /*Is this  DOS?    Use  PING  command.*/
 otherwise          nop                          /*don't know what this environment is.*/
 end   /*select*/


return 0 /*return a zero value (if a function).*/


halt: return 1 /*return a zero value (if a function).*/

/*══════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/ !all:  !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1 !cal: if symbol('!CALL')\=="VAR" then !call=; return !call !env: !env='ENVIRONMENT'; if !sys=='MSDOS' | !brexx | !r4 | !roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=3=='f3'x; if !crx then !env='DOS'; return !fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm, 1+('0'arg(1))) !rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver | 'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return !sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO' | !sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0 | pos('WIN',!sys)\==0 | !sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return !var: call !fid; if !kexx then return space( dosenv( arg(1) ) ); return space( value( arg(1), , !env) ) er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1, 2) !fid(1)) _2; if _1<0 then return _1; exit result p: return word( arg(1), 1) halt: call er .1 isNum: return datatype( arg(1), 'N') noValue: !sigl=sigl; call er 17, !fid(2) !fid(3) !sigl condition('D') sourceline(!sigl) syntax: !sigl=sigl; call er 13, !fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>

Coding note:   the   !xxx   subroutines (above) deal mostly with determining what version of REXX is being invoked and what operating system is being used;   and based on that information, appropriate flags (variables) are set.   This is an example of a robust boilerplate code checking for various versions of REXX and operating systems, and it also defines additional flags not used within this particular program.

Programming note:   The subroutine   $ERR   isn't included here;   so here is the gist of the error messages:

  •   er 59       too many arguments specified for the ─── DELAY ─── command.
  •   er 53       argument ─── xxx ─── isn't numeric for the option ─── delay-seconds ─── for the ─── DELAY ─── command.