home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-387-Vol-3of3.iso
/
t
/
tplan6.zip
/
FISTIES.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-04-07
|
17KB
|
601 lines
{Copyright 1989 Athens Software & Computer Information, Inc.}
program Fisties;
uses Crt,
Dos,
{use LAN50, LAN55, or LAN60 for corresponding TP version }
{$ifdef VER50} LAN50;
{$else}
{$ifdef VER55} LAN55;
{$else}
{$ifdef VER60} LAN60;
{$endif}
{$endif}
{$endif}
{"Fisties" is the British name for the Rock/Sissors/Paper game played
between two people. In the non-computer version, the two players face
each other, make a fist, and count "one, two, three". At the count of
three, each player shows either "Rock" (a fist), Sissors (extended middle
and index fingers), or Paper (open palm). The scoring works like this:
Rock breaks Sissors, Sissors cuts Paper, Paper covers Rock. Each win
scores one point; ties are not counted.
To start this game, compile the program and copy it to a directory on a
network drive. Both players should change to that drive and directory
before starting the program. On a slow remote station the cursor lags
behind the key presses (the program is checking many file locks between
each keypress), so be patient.
This LAN implementation uses file locks to keep track of the game. First,
a file is created (if it doesn't already exist) with nine records
(tokens). The flow of control of the program depends on whether a parti-
cular token-record is locked or unlocked. The first player to start
the game is assigned to be player 1 and the token-record "Player1Selected"
is locked. At this point the program waits for another player to start
the game. When player 2 starts the game, the token-records
"Player2Selected" and "GameInProgress" are locked. When a player selects
either rock, sissors, or paper, the appropriate token record is locked.
Next, for player 1, the token-record "Player1Lock" is locked. This record
is used to signal player 2 that player 1 has made his choice. For player
2, the token-record "Player2Lock" is locked to signal player 1 that a
choice has been made. The token records "Player1Tally" and "Player2Tally"
are locked when a choice has been made and unlocked when the player has
tallied the score. Once both players have made their choices, the score
is computed and the game continues until one player quits the game by
pressing Escape. If player 1 quits, player 2 becomes player 1 who then
waits for a new player 2 to start the game.
The logic to tally the score deserves some explanation. Let's say Player
1 is on a fast machine and Player 2 is on a slow machine. Player 1
selects "rock" and locks "Player1Tally" and "Player1Lock". Player 2 then
selects "sissors" and locks "Player2Tally" and "Player2Lock". The
Player-Lock record is used to signal that a player has selected rock,
sissors, or paper and the Player-Tally record is used to signal that a
player has computed the score. As soon as Player 1 sees that "Player2Lock"
is locked, he could compute the score, unlock his records and be back in
the main program loop before Player 2 (on the slow machine) could compute
the score. For this reason I had to add the Player-Tally record. Even
then a fast machine can outstrip a slow machine, so I interjected a one
second delay before each player unlocks his "player-lock" and
"player-tally" records. This delay was sufficient when playing a 16 Mhz
386 against a 4.77 MHz 8088 to allow the slow computer to figure out which
token the fast computer had locked.
The best way to implement a program like this is to use NetBIOS to send
messages back and forth about which tokens are selected, but I wanted a
program to test the file locking procedures in LAN5x.TPU.
Possible ERRORLEVEL return values are:
0 = normal return
1 = access to token file denied
2 = two people are already playing in this subdirectory
3 = program error--two players 1 or two players 2
4 = DOS Share is not loaded
5 = NetBIOS is not available
6 = LAN operating system not loaded
}
const numtokens = 9;
type Tokentype = string[15];
var f : file of Tokentype;
token : array [0..numtokens] of Tokentype;
player1, player2 : boolean;
ch : char; {my keypressed character}
current : byte; {5=Rock, 6=Sissors, 7=Paper }
{Keep score...}
player : array[1..2,1..4] of word;
ties : array[1..3] of word;
totalrounds : word;
MessageShown : boolean;
RoundOver : boolean;
xpos,ypos : byte; {cursor position}
GameInProgress,
Player1Selected,
Player2Selected,
Player1Lock,
Player2Lock,
Rock,
Sissors,
Paper,
Player1Tally,
Player2Tally : byte;
procedure CheckLANstatus;
begin
if not ShareInstalled then
begin
writeln('DOS Share is not installed. Fisties aborted.');
halt(4);
end;
if not NetBIOSavailable then
begin
writeln('The INT 2Ah NetBIOS interface is not available. ',
'Fisties aborted.');
halt(5);
end;
if not LANinstalled then
begin
writeln('The LAN operating system is not installed. ',
'Fisties aborted.');
halt(6);
end;
end; {of checkLANstatus }
procedure InitTokens;
begin
GameInProgress := 0;
Player1Selected:= 1;
Player2Selected:= 2;
Player1Lock := 3;
Player2Lock := 4;
Rock := 5;
Sissors := 6;
Paper := 7;
Player1Tally := 8;
Player2Tally := 9;
token[0]:= 'GameInProgress';
token[1]:= 'Player1Selected';
token[2]:= 'Player2Selected';
token[3]:= 'Player1Lock';
token[4]:= 'Player2Lock';
token[5]:= 'Rock';
token[6]:= 'Sissors';
token[7]:= 'Paper';
token[8]:= 'Player1Tally';
token[9]:= 'Player2Tally';
end; {InitTokens}
procedure InitTokenFile;
var IOsave : integer;
i : byte;
begin
filemode:= 66; {Share all/Deny none file open mode}
assign(f,'fisties.dat');
{$i-} reset(f); {$i+}
IOsave:= IOresult;
if IOsave<>0 then
if IOsave=2 then {File not Found}
begin
{create the file with the tokens}
rewrite(f);
for i:=1 to numtokens do write(f,token[i]);
close(f);
reset(f);
end
else
begin
writeln('File error = ',IOsave,'. Program aborted.');
halt(1);
end;
end; {InitTokenFile}
procedure PushXY;
begin
xpos:= wherex;
ypos:= wherey;
end;
procedure PopXY;
begin
gotoxy(xpos,ypos);
end;
procedure normaltext;
begin
textcolor(lightgray);
textbackground(black);
end;
procedure reversevideo;
begin
textcolor(black);
textbackground(lightgray);
end;
function getyn:char;
var ch : char;
begin
repeat
ch:= upcase(readkey);
if ch>#31 then write(ch,^h);
until ch in ['Y','N'];
getyn:= ch;
end;
function Iquit : boolean;
begin
Iquit:= false;
if ch=#27 then Iquit:= true;
end;
procedure InitScores;
var i,j : byte;
begin
for i:=1 to 2 do
for j:=1 to 4 do
player[i,j]:= 0;
for i:=1 to 3 do ties[i]:= 0;
totalrounds:= 0;
end;
procedure Status(player:byte; message:string);
begin
PushXY;
{goto row 21 for Player 1; row 22 for Player 2}
gotoxy(18,20+player);
write(message);
clreol;
PopXY;
end;
procedure UpdateScores;
{Show the score on the screen}
var i : byte;
begin
for i:=1 to 2 do
begin
gotoxy(1,7+2*i);
write('│ ');
case i of
1 : if player1 then write('Me ') else write('You');
2 : if player2 then write('Me ') else write('You');
end;
write(' │ ',player[i,1]:3,' ',
' │ ',player[i,2]:3,' ',
' │ ',player[i,3]:3,' ',
' │ ',player[i,4]:3,' │');
end;
gotoxy(1,17);
write('│ ',ties[1]:3,' │ ',ties[2]:3,' │ ',ties[3]:3,' │');
gotoxy(1,19);
write('Total Rounds Played: ',totalrounds:2);
end; {of Update Scores}
procedure WriteTemplate;
{Set up the initial screen}
begin
PushXY;
normaltext;
clrscr;
write('Highlight your choice, then press Enter: ');
reversevideo;
write('Rock');
normaltext;
writeln(' Sissors Paper');
writeln;
writeln('Selection for this round (Esc=Quit):');
writeln;
writeln('Score:');
writeln('┌────────┬──────────────┬───────────────┬────────────┬───────┐');
writeln('│ Player │ Rock-Sissors │ Sissors-Paper │ Paper-Rock │ Total │');
writeln('├────────┼──────────────┼───────────────┼────────────┼───────┤');
write('│ ');
if player1 then write('Me ') else write('You');
writeln(' │ 0 │ 0 │ 0 │ 0 │');
writeln('├────────┼──────────────┼───────────────┼────────────┼───────┤');
write('│ ');
if player2 then write('Me ') else write('You');
writeln(' │ 0 │ 0 │ 0 │ 0 │');
writeln('└────────┴──────────────┴───────────────┴────────────┴───────┘');
writeln('Ties:');
writeln('┌──────┬─────────┬───────┐');
writeln('│ Rock │ Sissors │ Paper │');
writeln('├──────┼─────────┼───────┤');
writeln('│ 0 │ 0 │ 0 │');
writeln('└──────┴─────────┴───────┘');
writeln('Total Rounds Played: ',totalrounds:2);
writeln;
write('Player 1 ');
if Player1 then write(' (Me): ') else write(' (You): ');
writeln;
write('Player 2 ');
if Player2 then write(' (Me): ') else write(' (You): ');
writeln;
writeln;
write('RPS-LAN Copr. 1989 Athens Software, Inc. All Rights Reserved. (404) 549-6912');
UpdateScores;
PopXY;
end; {of WriteTemplate }
procedure writechoice;
begin
PushXY;
if current=Rock then
begin
gotoxy(43,1);
write('Rock');
end
else
if current=Sissors then
begin
gotoxy(52,1);
write('Sissors');
end
else
if current=Paper then
begin
gotoxy(64,1);
write('Paper');
end;
PopXY;
end; {of WriteChoice}
function StillPlaying : boolean;
{this function really ties up a slow machine}
var temp : boolean;
begin
temp:= false;
if player1 then temp:= IsLocked(f,GameInProgress);
if player2 then
if IsLocked(f,Player1Selected) then temp:= true
else
begin
UnLock(f,GameInProgress);
UnLock(f,Player2Selected);
player2:= false;
player1:= true;
temp:= false;
end;
StillPlaying:= temp;
end; {of Function StillPlaying}
procedure InitPlayer;
{Find out whether we are player 1 or player 2;
if we are player 2 and player 1 quits, we become player 1.}
begin
if IsLocked(f,GameInProgress) then
begin
clrscr;
writeln('Play List is Full--Game in use.');
halt(2);
end;
Player1:= false;
Player2:= false;
if not IsLocked(f,Player1Selected) then
begin
Player1:= true;
Lock(f,Player1Selected);
if StillPlaying then UnLock(f,GameInProgress);
end
else
if not IsLocked(f,Player2Selected) then
begin
Player2:= true;
Lock(f,Player2Selected);
Lock(f,GameInProgress);
end
else
begin
writeln('Both players locked -- program error.');
halt(3);
end;
InitScores;
end; { end of InitPlayer }
procedure See_Who_Won;
var HisCurrent,score : word;
test : boolean;
i : byte;
begin
write(token[current]);
clreol;
gotoxy(38,3);
Status(1+ord(player2),token[current]+' selected.');
if not IsLocked(f,current) then
Lock(f,current); {Lock Token}
Lock(f, Player1Tally + ord(player2)); {Lock Tally}
Lock(f, Player1Lock + ord(player2)); {Lock Select}
ch:= #1;
{ wait for other player}
while
{See if other guy has picked a token yet}
not (IsLocked(f,Player1Lock+ord(player1)))
and StillPlaying {see if other guy is still playing }
and (not Iquit) do {see if I want to quit }
if keypressed then
ch:= readkey;
if not Iquit then {I didn't quit yet...}
begin
HisCurrent:= current;
for i:=Rock to Paper do
if IsLocked(f,i) then
HisCurrent:= i;
Status(1+ord(player1),token[HisCurrent]+' selected.');
{1=rock-sissors 2=sissors-paper 3=paper-rock 4= total}
if player1 then
score:= 10 * (current-4) + (HisCurrent-4)
else
score:= 10 * (HisCurrent-4) + (current-4);
case score of
11 : inc(ties[1]);
12 : inc(player[1,1]);
13 : inc(player[2,3]);
21 : inc(player[2,1]);
22 : inc(ties[2]);
23 : inc(player[1,2]);
31 : inc(player[1,3]);
32 : inc(player[2,2]);
33 : inc(ties[3]);
end; { of case score}
if HisCurrent<>current then
if score in [12,23,31] then inc(player[1,4])
else inc(player[2,4]);
end; { of if Esc Pressed}
inc(totalrounds);
{if a slow machine is playing a fast machine, the fast machine can
unlock the tally, select, and token records before the slow machine
can test what token the fast machine had locked.}
delay(1000);
status(1+ord(player2),'Waiting for other player to tally score...');
UnLock(f, Player1Tally+ord(player2));
{wait for other player to unlock his tally}
while IsLocked(f,Player1Tally+ord(player1)) do ;
UnLock(f,Player1Lock + ord(player2));
{wait for other player to unlock his select record}
while IsLocked(f,Player1Lock + ord(player1)) do;
UnLock(f, current);
end; {See_Who_Won}
procedure WaitForPlayer2;
begin
ch:= #1; {initialize the keypressed buffer}
if Player1 then {Wait for Player 2 to Log On}
begin
Status(2,'Not Logged on.');
Status(1,'Waiting for the other player to log on. Press Esc to abort.');
repeat
if keypressed then
begin
ch:= readkey;
if keypressed then ch:= readkey;
end;
until StillPlaying or Iquit;
end;
end; {Wait for Player 2}
procedure GameKeyPressed;
{figure out what keys were pressed}
begin
if ch=#0 then
begin
ch:= readkey;
case ch of
#75 : {left arrow}
begin
normaltext;
writechoice;
if current=Rock then current:=Paper else dec(current);
reversevideo;
writechoice;
normaltext;
end;
#77 : {right arrow}
begin
normaltext;
writechoice;
if current=Paper then current:=Rock else inc(current);
reversevideo;
writechoice;
normaltext;
end;
end; { of case ch= #0}
end
else { single character pressed }
case ch of
#13 : begin {carriage return}
See_Who_Won;
WriteTemplate;
RoundOver:= true;
end;
#27 : begin {Escape}
gotoxy(1,3);
write('Are you sure you want to quit (y/n)? ');
clreol;
ch:=#1;
if getyn='Y' then ch:= #27;
gotoxy(1,3);
clreol;
write('Selection for this round (Esc=Quit): ');
end;
end; { of case ch of }
end; {Game Key Pressed}
procedure PlayThisRound;
{play the game until somebody quits.
This loop is what slows down a slow machine so much,
the "StillPlaying" function is the main culprit.}
begin
repeat
ch:=#1;
if keypressed then
begin
ch:= readkey;
GameKeyPressed;
end;
if not MessageShown then
if IsLocked(f,Player1Lock+ord(player1)) then
begin
Status(1+ord(player1),'Have selected a token...');
MessageShown:= true;
end;
until RoundOver or (not StillPlaying) or Iquit;
end; {of Play this Round }
procedure PlayTheGame;
begin
repeat {play the game}
MessageShown:= false;
RoundOver:= false;
current:= Rock; { start with rock }
gotoxy(1,3);
write('Selection for this round (Esc=Quit): ');
clreol;
Status(1,'Ready for input...');
Status(2,'Ready for input...');
PlayThisRound;
until Iquit or not StillPlaying;
end; {of Play the Game}
procedure FinishUp;
begin
UnLock(f,Player1Selected+ord(player2));
if player2 then UnLock(f, GameInProgress);
close(f); {opened in InitTokenFile}
clrscr;
end; {of FinishUp}
(***************** MAIN PROGRAM ********************************)
begin
InitTokens;
InitTokenFile;
CheckLANstatus;
repeat {play the game until I quit playing}
ch:= #1; {initialize the keypressed character}
InitPlayer;
WriteTemplate;
WaitForPlayer2;
if not Iquit then PlayTheGame;
until Iquit; { play until I press Esc }
FinishUp;
end. {of Fisties}