home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 5 Edit
/
05-Edit.zip
/
epmrex.zip
/
TICTAC.ERX
< prev
next >
Wrap
Text File
|
1992-08-10
|
13KB
|
404 lines
/* Rexx and roll */
arg char next
if char='CLICK' then do /* if activated by a mouse */
'MH_GotoPosition' /* click, move to that location */
char = next /* and set the char to next */
end
if char='' then
call init /* set up board */
else if char='X' then
call X /* Do the X thing */
else if char='O' then
call O /* Do the O thing */
else if char='END' then
call endgame /* End game if end was pressed */
else
'sayerror Unrecognised argument.' /* You fool! */
exit
init:
'xcom e /n' /* Edit new file */
call etksetfilefield 'autosave',0 /* Turn off autosave */
call etksetfilefield 'filename','Tic Tac Toe' /*change filename */
/* set .userstring to empty board... */
parse source . . direct
'extract /userstring/line/col'
userstring.1='.........'||line.1 5
call etksetfilefield 'userstring', userstring.1
/* Define accelerator keys */
AF_CHAR = 1 /* key style constants */
AF_VIRTUALKEY = 2
VK_END = 19
'buildaccel ttt' AF_CHAR 88 9002 'rx' direct 'X'
'buildaccel ttt' AF_CHAR 120 9003 'rx' direct 'X'
'buildaccel ttt' AF_CHAR 79 9004 'rx' direct 'O'
'buildaccel ttt' AF_CHAR 111 9005 'rx' direct 'O'
'buildaccel ttt' AF_VIRTUALKEY VK_END 9006 'rx' direct 'end'
'activateaccel ttt'
/* Set mouse control */
'register_mouse 1 1 SECONDCLK 0 rx' direct 'click X' /* MB1 */
'register_mouse 1 2 SECONDCLK 0 rx' direct 'click O' /* MB2 */
/* 'togglecontrol 8 1'
'setmessageline X=dbl-click MB1; O=dbl-click MB2; End=end game' */
'browse off'
/* Draw board */
call etkinserttext ' ║ ║ '
call etkinserttext ' ═╬═╬═'
call etkinserttext ' ║ ║ '
call etkinserttext ' ═╬═╬═'
call etkinserttext ' ║ ║ '
call etkinserttext ' '
call etkinserttext ' '
call setattributes
call etksetfilefield 'modify', 0
/* Disable changes to file */
'browse on'
call saytext 'And now for something completely different.... The EPM Tic-Tac-Toe Game!' ,
' Press X or double-click MB1 to move X, O or double-click MB2 to move O; End to end game early.'
EXIT
setattributes:
/* Set up fonts */
'processfontrequest Courier.24.0.0.0.0'
call etkprocesseditkey "UNMARK"
'extract /line'
getl()+5
call etkprocesseditkey "MARK_LINE"
getl()+6
call etkprocesseditkey "MARK_LINE"
'processfontrequest Helv.12.0.1.1.1'
call etkprocesseditkey "UNMARK"
/* Set color */
'insert_attr_val_pair 1 159' getl()+5 getl()+6 1 1
line.1
return
saytext:
text=arg(1)
/* 'sayerror text' text */
'browse off'
'extract /windowwidth/line'
/* Fit text 2 window and display */
i=0
do while length(text)>(windowwidth.1*2)
p=lastpos(' ',text,(windowwidth.1*2))
if p=0 then
p=windowwidth.1
getl()+6+i
'extract /getline'
if getline.1='' then
call etkinserttext center(substr(text,1,p),(windowwidth.1*2))
else
call etkreplacetext center(substr(text,1,p),(windowwidth.1*2))
text=delstr(text,1,p)
i=i+1
end /* do */
getl()+6+i
'extract /getline'
if getline.1='' then
call etkinserttext center(text,(windowwidth.1*2))
else
call etkreplacetext center(text,(windowwidth.1*2))
i=i+1
getl()+6+i
/* delete excess lines */
'extract /getline'
do while \(getline.1='')
call etkdeletetext
getl()+6+i
'extract /getline'
end /* do */
line.1
'browse on'
return
getl:
/* return line where board is located */
if symbol('USERSTRING.1')<>'VAR' then
'extract /userstring'
return substr(userstring.1,10,pos(' ',userstring.1)-10)
getc:
/* return col where board is located */
if symbol('USERSTRING.1')<>'VAR' then
'extract /userstring'
return substr(userstring.1,pos(' ',userstring.1)+1)
X:
/* the X proc */
valid=checkboard(X) /* Cursor on board ? */
if valid then
do
numbx=countchar() /* Correct player ? */
if numbx//2=0 then
call placechar X
else
call saytext "It's O's turn "||insult() /* You Fool! */
end
else
call saytext "The cursor isn't on the board "||insult() /*You Fool!*/
if qwin() then call winner X /* Winner ? */
EXIT
O:
/* The O proc */
valid=checkboard(O) /* Cursor on board ? */
if valid then
do
numbx=countchar() /* Correct player ? */
if \(numbx//2=0) then
call placechar O
else
call saytext "It's X's turn "||insult() /* You Fool! */
end
else
call saytext "The cursor isn't on the board "||insult() /* You Fool! */
if qwin() then call winner O
EXIT
countchar:
numbchar=0 /* Count number of blank spaces */
do l = 1 to 9
if \(substr(userstring.1,l,1)='.') then
numbchar=numbchar+1
end /* do */
return numbchar
checkboard:
player=arg(1) /* Cursor on board ? */
'extract /userstring/line/col/autosave'
parse var userstring.1 board 10 boardline boardcol
onboard=0
ypos=line.1-boardline
xpos=col.1-boardcol
if (xpos%2<3)&(xpos%2>-1)&(ypos%2<3)&(ypos%2>-1)&(xpos//2=0)&(ypos//2=0) then
do
xpos=xpos%2
ypos=ypos%2
/* 'sayerror xpos' xpos 'ypos' ypos*/
onboard=1
end
if autosave.1 > 0 then
call etksetfilefield 'autosave',0 /* Turn off autosave if it is on */
RETURN onboard
delmessage:
/* Delete existing message */
'extract /line'
getl()+6
'extract /getline'
'browse off'
do while \(getline.1='')
call etkdeletetext
getl()+6
'extract /getline'
end /* do */
'browse on'
line.1
return
placechar:
player=arg(1)
/* Put character on board */
do
board=substr(userstring.1,1,9)
if '.'=substr(board,xpos+1+(3*ypos),1) then /* Position Taken ? */
do
'extract /getline'
'browse off'
call etkreplacetext overlay(player,getline.1,xpos*2+getc()) /* Replace line in file */
call etkprocesseditkey "refresh"
'browse on'
newusers=overlay(player,userstring.1,xpos+1+(3*ypos))
call etksetfilefield 'userstring', newusers /* Replace userstring */
'sayerror "Take that!" says '||player||'.' /* Message */
call delmessage
end
else
call saytext 'Position already taken '||insult() /* You fool! */
end
return
insult:
/* Put them in their place. */
nasty='you ' /* the insult starts here. */
i=0
do until i=5 /* loop for adjatives */
wordnumb=random(1,26) /* pick a number */
select
when wordnumb=1 then addin='chair-insulting' /* profuse vulgarities */
when wordnumb=2 then addin='liver-eating'
when wordnumb=3 then addin='olive-green' /*author's favorite!*/
when wordnumb=4 then addin='slime-covered'
when wordnumb=5 then addin='mattress-abusing'
when wordnumb=6 then addin='lyric-singing'
when wordnumb=7 then addin='wheel-turning'
when wordnumb=8 then addin='box-closing'
when wordnumb=9 then addin='bookshelf-reading'
when wordnumb=10 then addin='camel-pushing'
when wordnumb=11 then addin='mud-sniffing'
when wordnumb=12 then addin='cactus-stomping'
when wordnumb=13 then addin='16-ton-weight-dropping'
when wordnumb=14 then addin='sidewalk-hopping'
when wordnumb=15 then addin='basketball-kicking'
when wordnumb=16 then addin='door-slamming'
when wordnumb=17 then addin='paperclip-throwing'
when wordnumb=18 then addin='name-calling'
when wordnumb=19 then addin='pogo-stick-hating'
when wordnumb=20 then addin='sewage-filled'
when wordnumb=21 then addin='squalid'
when wordnumb=22 then addin='vile'
when wordnumb=23 then addin='rancid'
when wordnumb=24 then addin='cheating'
when wordnumb=25 then addin='silly'
when wordnumb=26 then addin='dovalicotionating'
end
if pos(addin,nasty)=0 then /* Has the insult been picked already? */
do
nasty=nasty||addin||', ' /* Comma, anyone? */
i=i+1
end /* do */
end /* do */
nasty=substr(nasty,1,length(nasty)-2)
wordnumb=random(1,19) /* pick a noun */
select
when wordnumb=1 then nasty=nasty 'snarf.'
when wordnumb=2 then nasty=nasty 'it''s man.' /* Thank U Python(Monty)! */
when wordnumb=3 then nasty=nasty 'nick-nack.'
when wordnumb=4 then nasty=nasty 'person.'
when wordnumb=5 then nasty=nasty 'ant.'
when wordnumb=6 then nasty=nasty 'good-for-nothing.'
when wordnumb=7 then nasty=nasty 'thing.'
when wordnumb=8 then nasty=nasty 'mound of dirt.' /* author's favorite! */
when wordnumb=9 then nasty=nasty 'pile of laundry.'
when wordnumb=10 then nasty=nasty 'landfill.'
when wordnumb=11 then nasty=nasty 'Elvis impersonator.'
when wordnumb=12 then nasty=nasty 'UFO spotter.'
when wordnumb=13 then nasty=nasty 'baby.'
when wordnumb=14 then nasty=nasty 'tree.'
when wordnumb=15 then nasty=nasty 'donkey-bottom-biter.' /* Thank U Python(Monty)! */
when wordnumb=16 then nasty=nasty 'son of a silly person.' /* Thank U Python(Monty)! */
when wordnumb=17 then nasty=nasty 'maggot.'
when wordnumb=18 then nasty=nasty 'grub.'
when wordnumb=19 then nasty=nasty 'git.'
end
return nasty
qwin:
/* did u win ? */
'extract /userstring'
yo='insert_attr_val_pair 1 192' /* winning color */
winvar=0
i=0
do until (i=3)|(winvar=1)
if ('OOO'=substr(userstring.1,1+i*3,3))|('XXX'=substr(userstring.1,1+i*3,3)) then
do /* check horizontal */
templine=(i*2)+substr(userstring.1,10,pos(' ',userstring.1)-10)
'browse off'
yo templine templine getc() getc()+4
'browse on'
winvar=1
end /* do */
if \winvar then
do /* check vertical */
ii=0
tempstr=''
do until (ii=3)
tempstr=tempstr||substr(userstring.1,1+i+ii*3,1)
ii=ii+1
end /* do */
if (tempstr='OOO')|(tempstr='XXX') then
do
ii=0
tempcol=(i*2)+substr(userstring.1,pos(' ',userstring.1)+1)
'browse off'
do until (ii=5)
templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
yo templine templine tempcol tempcol
ii=ii+1
end /* do */
'browse on'
winvar=1
end /* do */
end
i=i+1
end /* do */
if \winvar then
do /* check diag */
ii=0
tempstr=''
do until (ii=3)
tempstr=tempstr||substr(userstring.1,1+ii+ii*3,1)
ii=ii+1
end /* do */
if (tempstr='OOO')|(tempstr='XXX') then
do
ii=0
'browse off'
do until (ii=5)
tempcol=substr(userstring.1,pos(' ',userstring.1)+1)+ii
templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
yo templine templine tempcol tempcol
ii=ii+1
end /* do */
'browse on'
winvar=1
end /* do */
end
if \winvar then
do /* check diag */
ii=0
tempstr=''
do until (ii=3)
tempstr=tempstr||substr(userstring.1,1+(2-ii)+ii*3,1)
ii=ii+1
end /* do */
if (tempstr='OOO')|(tempstr='XXX') then
do
ii=0
'browse off'
do until (ii=5)
tempcol=substr(userstring.1,pos(' ',userstring.1)+1)+(4-ii)
templine=substr(userstring.1,10,pos(' ',userstring.1)-10)+ii
yo templine templine tempcol tempcol
ii=ii+1
end /* do */
'browse on'
winvar=1
end /* do */
end
if (pos('.',userstring.1)=0)&(\winvar) then
do /* tie game */
call saytext 'DRAW!'
call endgame
end /* do */
return winvar
winner:
winchar=arg(1)
call saytext winchar||' is the winner!' /* U win! */
call endgame
exit
endgame:
/* Clean up */
'browse off'
'activateaccel defaccel'
'extract /userstring'
call etksetfilefield 'modify',0
parse userstring.1 board 10 boardline boardcol
/* call etksetfilefield 'line',(boardline+4)
do 5
call etkdeletetext
end /* do */ */
call etksetfilefield 'line',(boardline)
'register_mouse 1 1 SECONDCLK 0 MH_double' /* MB1 */
'register_mouse 1 2 SECONDCLK 0 markword' /* MB2 */
exit