home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software of the Month Club 1994 October
/
SOFM_Oct1994.bin
/
pc
/
os2
/
pds
/
snake1.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-03-09
|
7KB
|
373 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
sGlobal.fDebug = 'N'
sGlobal.fRetain = 'N'
sGlobal.sInitChar = ' '
sGlobal.xTrailer = 'B0'x
fInit ='N'
fDebug = 'N'
fDispStax= 'N'
fDispHelp= 'N'
fRetainQ = '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 'SNAKE1 - Unable to initialize the "RXPD" subsystem'
exit 8
end
sGlobal.iMaxR = 25
sGlobal.iMaxC = 80
sGlobal.fDebug=fDebug
sGlobal.fRetain=fRetainQ
bid = rxPDInit('SNAKE1','GREENHI','RED','REDHI',,25,80)
if bid = x2c(00000000) then
do
Call rSiren 2, 3
say 'SNAKE1 - 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
sGlobal.r.1 = 4
sGlobal.c.1 = 4
sGlobal.rd.1 = +1
sGlobal.cd.1 = +1
sGlobal.x.1 = 'DB'x
sGlobal.r.2 = 3
sGlobal.c.2 = 3
sGlobal.rd.2 = +1
sGlobal.cd.2 = +1
sGlobal.x.2 = 'B2'x
sGlobal.r.3 = 2
sGlobal.c.3 = 2
sGlobal.rd.3 = +1
sGlobal.cd.3 = +1
sGlobal.x.3 = 'B1'x
sGlobal.r.4 = 1
sGlobal.c.4 = 1
sGlobal.rd.4 = +1
sGlobal.cd.4 = +1
sGlobal.x.4 = 'B0'x
if sGlobal.fRetain = 'Y' then
do
sI = sGlobal.xTrailer
end
else
do
sI = sGlobal.sInitChar
end
do i = 1 to 4
sGlobal.p.i = sI
end
do FOREVER
/* Always create sprites in lower to higher layers. */
Call rDoBuildRow(4)
Call rDoBuildRow(3)
Call rDoBuildRow(2)
Call rDoBuildRow(1)
akey = rxPDDisplay(bid, 'PANEL'RIGHT(sGlobal.r.1,3,'0'))
Call rDoUpdateRow(4)
Call rDoUpdateRow(3)
Call rDoUpdateRow(2)
Call rDoUpdateRow(1)
end /*do FOREVER */
return 0;
rDoBuildRow: Procedure Expose sRow. sGlobal.
parse arg iItem
iR = sGlobal.r.iItem
iC = sGlobal.c.iItem
iX = sGlobal.x.iItem
if iItem = 1 then
do
if sGlobal.fRetain = 'Y' then
do
sC = SUBSTR(sRow.iR,iC,1)
if sC = sGlobal.sInitChar then
do
sC = sGlobal.xTrailer
end
else
do
sC = sGlobal.sInitChar
end
i = 3
j = 4
do i
sGlobal.p.j = sGlobal.p.i
i = i - 1
j = j - 1
end
sGlobal.p.1 = sC
end
end
if iC = 1 then
do
sRow.iR = iX||RIGHT(sRow.iR,sGlobal.iMaxC-1)
end
else
do
sRow.iR = LEFT(sRow.iR,iC-1)||iX||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
end
return 0;
rDoUpdateRow: Procedure Expose sRow. sGlobal.
parse arg iItem
iR = sGlobal.r.iItem
iRD= sGlobal.rd.iITem
iC = sGlobal.c.iItem
iCD= sGlobal.cd.iITem
if iItem = 4 then
do
sI = sGlobal.sInitChar
if sGlobal.fRetain = 'Y' then
do
sI = sGlobal.p.4
end
if iC = 1 then
do
sRow.iR = sI||RIGHT(sRow.iR,sGlobal.iMaxC-1)
end
else
do
sRow.iR = LEFT(sRow.iR,iC-1)||sI||RIGHT(sRow.iR,sGlobal.iMaxC-iC)
end
end
iR = iR + iRD
if iR < 1 then
do
if iItem = 1 then Call BEEP 1024, 25
iR = 2
iRD = +1
end
else
if iR > sGlobal.iMaxR then
do
if iItem = 1 then Call BEEP 1024, 25
iR = sGlobal.iMaxR - 1
iRD = -1
end
iC = iC + iCD
if iC < 1 then
do
if iItem = 1 then Call BEEP 1024, 25
iC = 2
iCD = +1
end
else
if iC > sGlobal.iMaxC then
do
if iItem = 1 then Call BEEP 1024, 25
iC = sGlobal.iMaxC - 1
iCD = -1
end
sGlobal.r.iItem = iR
sGlobal.rd.iITem = iRD
sGlobal.c.iItem = iC
sGlobal.cd.iITem = iCD
return 0;
HaltExit:
if fInit = 'Y' then
do
rc = rxPDTerm(bid)
end
Call BEEP 882, 40
Call BEEP 882, 40
say ''
say 'SNAKE1 processing halted by request;'
exit 0
ErrorExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE1 processing failed due to unknown error;'
exit 24
FailureExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE1 processing failed due to unknown failure;'
exit 32
SyntaxExit:
Call BEEP 882, 40
Call BEEP 882, 40
say 'SNAKE1 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(f1) = 'T' then
do
fRetainQ='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 'SNAKE1 - Invalid parm specified; Parm "'w1'" unknown;'
CALL rDispSyntax 0 8
end
end
end
return 0
rDispSyntax: Procedure
parse upper arg iHelp iExit
say ' Syntax : SNAKE1 {<options>} '
say ' SNAKE1 {/?|/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 ' /t - Leave a trail where snake has traveled.'
say ' Examples:'
say ' SNAKE1 /h'
say ' '
say ' SNAKE1'
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