Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TPLAN6.ZIP/FISTIES.PAS

Pascal/Delphi Source File | 1992-04-07 | 16.8 KB | 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. [phone]');
    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}