home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software of the Month Club 1994 October
/
SOFM_Oct1994.bin
/
pc
/
os2
/
pds
/
bounce2.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-03-09
|
6KB
|
332 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
fInit ='N'
fDebug = 'N'
fDispStax= 'N'
fDispHelp= 'N'
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 = rLoadFuncs('rxPDLoadFuncs', 'HSSPD', 'rxPDLoadFuncs')
if rc <> 0 then
do
Call rSiren 1, 1
say 'BOUNCE2 - Unable to initialize the "RXPD" subsystem'
exit 8
end
sGlobal.iMaxR = 25
sGlobal.iMaxC = 80
sGlobal.fDebug=fDebug
bid = rxPDInit('BOUNCE2','GREENHI','RED','REDHI',,25,80)
if bid = x2c(00000000) then
do
Call rSiren 2, 3
say 'BOUNCE2 - Error to initializing the "RXPD" subsystem'
exit 8
end
fInit ='Y'
Call rxPDZVarDefine
do i = 1 to sGlobal.iMaxR
sRow.i = ''
end /* do i = 1 to sGlobal.iMaxR */
akey = rxPDDisplay(bid,'PANEL000')
do while 0 = rDoBOUNCE(bid)
end /* do while 0 = rDoBOUNCE() */
rc = rxPDTerm(bid)
exit 0
/**********************************************************************\
rDoBOUNCE:
This routine displays a dialog panel that bounces a ball
\**********************************************************************/
rDoBOUNCE:
parse arg bid
r = 1
c = 1
rd = +1
cd = +1
r2 = TRUNC(sGlobal.iMaxR/3)
c2 = TRUNC(sGlobal.iMaxC/3)
r2d = -1
c2d = +1
do FOREVER
if r = r2 then /* Same row needs extra work */
do
if c < c2 then
do
cw1 = c
cw2 = c2
end
else
do
cw2 = c
cw1 = c2
end
if cw1 > 1 then
do
sWrk = LEFT(' ',cw1-1,' ')'DB'x
end
else
do
sWrk = 'DB'x
end
if cw2 <> cw1 then
do
sWrk = sWrk||LEFT(' ',cw2-cw1,' ')'DB'x
end
sRow.r = sWrk
akey = rxPDDisplay(bid, 'PANEL'RIGHT(r,3,'0'))
sRow.r = ''
end
else
do
if c > 1 then
do
sWrk = LEFT(' ',c-1,' ')'DB'x
end
else
do
sWrk = 'DB'x
end
if c2 > 1 then
do
sWrk2 = LEFT(' ',c2-1,' ')'DB'x
end
else
do
sWrk2 = 'DB'x
end
sRow.r = sWrk
sRow.r2 = sWrk2
akey = rxPDDisplay(bid, 'PANEL'RIGHT(r,3,'0'))
akey = rxPDDisplay(bid, 'PANEL'RIGHT(r2,3,'0'))
sRow.r = ''
sRow.r2 = ''
end
akey = rxPDDisplay(bid, 'PANEL999')
r = r + rd
if r < 1 then
do
Call BEEP 1024, 25
r = 2
rd = +1
end
else
if r > sGlobal.iMaxR then
do
Call BEEP 1024, 25
r = sGlobal.iMaxR - 1
rd = -1
end
c = c + cd
if c < 1 then
do
Call BEEP 1024, 25
c = 2
cd = +1
end
else
if c > sGlobal.iMaxC then
do
Call BEEP 1024, 25
c = sGlobal.iMaxC - 1
cd = -1
end
r2 = r2 + r2d
if r2 < 1 then
do
Call BEEP 1024, 25
r2 = 2
r2d = +1
end
else
if r2 > sGlobal.iMaxR then
do
Call BEEP 1024, 25
r2 = sGlobal.iMaxR - 1
r2d = -1
end
c2 = c2 + c2d
if c2 < 1 then
do
Call BEEP 1024, 25
c2 = 2
c2d = +1
end
else
if c2 > sGlobal.iMaxC then
do
Call BEEP 1024, 25
c2 = sGlobal.iMaxC - 1
c2d = -1
end
end /*do FOREVER */
return 0;
HaltExit:
if fInit = 'Y' then
do
rc = rxPDTerm(bid)
end
Call BEEP 882, 40
Call BEEP 882, 40
say ''
say 'BOUNCE2 processing halted by request;'
exit 0
ErrorExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'BOUNCE2 processing failed due to unknown error;'
exit 24
FailureExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'BOUNCE2 processing failed due to unknown failure;'
exit 32
SyntaxExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'BOUNCE2 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 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 'BOUNCE2 - Invalid parm specified; Parm "'w1'" unknown;'
CALL rDispSyntax 0 8
end
end
end
return 0
rDispSyntax: Procedure
parse upper arg iHelp iExit
say ' Syntax : BOUNCE2 {<options>} '
say ' BOUNCE2 {/?|/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 ' Examples:'
say ' BOUNCE2 /h'
say ' '
say ' BOUNCE2'
return ''
/* rSiren: does the siren bit by running the scale based upon a */
/* frequency specified by the caller. */
rSiren: Procedure
Parse Arg freq, cycle
note.1 = 262 * freq /* middle C */
note.2 = 294 * freq /* D */
note.3 = 330 * freq /* E */
note.4 = 349 * freq /* F */
note.5 = 392 * freq /* G */
note.6 = 440 * freq /* A */
note.7 = 494 * freq /* B */
note.8 = 524 * freq /* C */
do j = 1 to cycle
call beep note.8,250 /* hold each note for a 1/4 second */
call beep note.1,250 /* hold each note for a 1/4 second */
end j
Return
rLoadFuncs:
parse arg sREP, sDll, sRtn
rxrc = RxFuncAdd(sREP, sDll, sRtn)
signal on syntax name xLoadFuncs
interpret 'Call 'sRtn
return 0
xLoadFuncs:
return 127