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 >
Pascal/Delphi Source File  |  1992-04-07  |  17KB  |  601 lines

  1. {Copyright 1989 Athens Software & Computer Information, Inc.}
  2.  
  3. program Fisties;
  4.  
  5. uses Crt,
  6.      Dos,
  7.      {use LAN50, LAN55, or LAN60 for corresponding TP version }
  8.      {$ifdef VER50} LAN50;
  9.      {$else}
  10.      {$ifdef VER55} LAN55;
  11.      {$else}
  12.      {$ifdef VER60} LAN60;
  13.      {$endif}
  14.      {$endif}
  15.      {$endif}
  16.  
  17.  
  18. {"Fisties" is the British name for the Rock/Sissors/Paper game played
  19.   between two people.  In the non-computer version, the two players face
  20.   each other, make a fist, and count "one, two, three".  At the count of
  21.   three, each player shows either "Rock" (a fist), Sissors (extended middle
  22.   and index fingers), or Paper (open palm).  The scoring works like this:
  23.   Rock breaks Sissors, Sissors cuts Paper, Paper covers Rock.  Each win
  24.   scores one point; ties are not counted.
  25.  
  26.   To start this game, compile the program and copy it to a directory on a
  27.   network drive.  Both players should change to that drive and directory
  28.   before starting the program.  On a slow remote station the cursor lags
  29.   behind the key presses (the program is checking many file locks between
  30.   each keypress), so be patient.
  31.  
  32.   This LAN implementation uses file locks to keep track of the game. First,
  33.   a file is created (if it doesn't already exist) with nine records
  34.   (tokens).  The flow of control of the program depends on whether a parti-
  35.   cular token-record is locked or unlocked.  The first player to start
  36.   the game is assigned to be player 1 and the token-record "Player1Selected"
  37.   is locked.  At this point the program waits for another player to start
  38.   the game.  When player 2 starts the game, the token-records
  39.   "Player2Selected" and "GameInProgress" are locked.  When a player selects
  40.   either rock, sissors, or paper, the appropriate token record is locked.
  41.   Next, for player 1, the token-record "Player1Lock" is locked.  This record
  42.   is used to signal player 2 that player 1 has made his choice.  For player
  43.   2, the token-record "Player2Lock" is locked to signal player 1 that a
  44.   choice has been made.  The token records "Player1Tally" and "Player2Tally"
  45.   are locked when a choice has been made and unlocked when the player has
  46.   tallied the score.  Once both players have made their choices, the score
  47.   is computed and the game continues until one player quits the game by
  48.   pressing Escape.  If player 1 quits, player 2 becomes player 1 who then
  49.   waits for a new player 2 to start the game.
  50.  
  51.   The logic to tally the score deserves some explanation.  Let's say Player
  52.   1 is on a fast machine and Player 2 is on a slow machine.  Player 1
  53.   selects "rock" and locks "Player1Tally" and "Player1Lock".  Player 2 then
  54.   selects "sissors" and locks "Player2Tally" and "Player2Lock".  The
  55.   Player-Lock record is used to signal that a player has selected rock,
  56.   sissors, or paper and the Player-Tally record is used to signal that a
  57.   player has computed the score.  As soon as Player 1 sees that "Player2Lock"
  58.   is locked, he could compute the score, unlock his records and be back in
  59.   the main program loop before Player 2 (on the slow machine) could compute
  60.   the score.  For this reason I had to add the Player-Tally record.  Even
  61.   then a fast machine can outstrip a slow machine, so I interjected a one
  62.   second delay before each player unlocks his "player-lock" and
  63.   "player-tally" records.  This delay was sufficient when playing a 16 Mhz
  64.   386 against a 4.77 MHz 8088 to allow the slow computer to figure out which
  65.   token the fast computer had locked.
  66.  
  67.   The best way to implement a program like this is to use NetBIOS to send
  68.   messages back and forth about which tokens are selected, but I wanted a
  69.   program to test the file locking procedures in LAN5x.TPU.
  70.  
  71.   Possible ERRORLEVEL return values are:
  72.     0 = normal return
  73.     1 = access to token file denied
  74.     2 = two people are already playing in this subdirectory
  75.     3 = program error--two players 1 or two players 2
  76.     4 = DOS Share is not loaded
  77.     5 = NetBIOS is not available
  78.     6 = LAN operating system not loaded
  79.  
  80. }
  81.  
  82. const numtokens = 9;
  83.  
  84. type Tokentype = string[15];
  85.  
  86. var f : file of Tokentype;
  87.  
  88.     token : array [0..numtokens] of Tokentype;
  89.  
  90.     player1, player2 : boolean;
  91.  
  92.     ch : char; {my keypressed character}
  93.  
  94.     current : byte; {5=Rock, 6=Sissors, 7=Paper }
  95.  
  96.     {Keep score...}
  97.     player : array[1..2,1..4] of word;
  98.     ties : array[1..3] of word;
  99.     totalrounds : word;
  100.  
  101.     MessageShown : boolean;
  102.  
  103.     RoundOver : boolean;
  104.  
  105.     xpos,ypos : byte; {cursor position}
  106.  
  107.     GameInProgress,
  108.     Player1Selected,
  109.     Player2Selected,
  110.     Player1Lock,
  111.     Player2Lock,
  112.     Rock,
  113.     Sissors,
  114.     Paper,
  115.     Player1Tally,
  116.     Player2Tally : byte;
  117.  
  118. procedure CheckLANstatus;
  119. begin
  120.   if not ShareInstalled then
  121.     begin
  122.       writeln('DOS Share is not installed.  Fisties aborted.');
  123.       halt(4);
  124.     end;
  125.  
  126.   if not NetBIOSavailable then
  127.     begin
  128.       writeln('The INT 2Ah NetBIOS interface is not available.  ',
  129.               'Fisties aborted.');
  130.       halt(5);
  131.     end;
  132.  
  133.   if not LANinstalled then
  134.     begin
  135.       writeln('The LAN operating system is not installed.  ',
  136.               'Fisties aborted.');
  137.       halt(6);
  138.     end;
  139. end; {of checkLANstatus }
  140.  
  141. procedure InitTokens;
  142. begin
  143.   GameInProgress := 0;
  144.   Player1Selected:= 1;
  145.   Player2Selected:= 2;
  146.   Player1Lock    := 3;
  147.   Player2Lock    := 4;
  148.   Rock           := 5;
  149.   Sissors        := 6;
  150.   Paper          := 7;
  151.   Player1Tally   := 8;
  152.   Player2Tally   := 9;
  153.   token[0]:= 'GameInProgress';
  154.   token[1]:= 'Player1Selected';
  155.   token[2]:= 'Player2Selected';
  156.   token[3]:= 'Player1Lock';
  157.   token[4]:= 'Player2Lock';
  158.   token[5]:= 'Rock';
  159.   token[6]:= 'Sissors';
  160.   token[7]:= 'Paper';
  161.   token[8]:= 'Player1Tally';
  162.   token[9]:= 'Player2Tally';
  163. end; {InitTokens}
  164.  
  165. procedure InitTokenFile;
  166. var IOsave : integer;
  167.     i : byte;
  168. begin
  169.   filemode:= 66; {Share all/Deny none file open mode}
  170.   assign(f,'fisties.dat');
  171.   {$i-} reset(f); {$i+}
  172.   IOsave:= IOresult;
  173.   if IOsave<>0 then
  174.     if IOsave=2 then {File not Found}
  175.       begin
  176.         {create the file with the tokens}
  177.         rewrite(f);
  178.         for i:=1 to numtokens do write(f,token[i]);
  179.         close(f);
  180.         reset(f);
  181.       end
  182.     else
  183.       begin
  184.         writeln('File error = ',IOsave,'.  Program aborted.');
  185.         halt(1);
  186.       end;
  187. end; {InitTokenFile}
  188.  
  189. procedure PushXY;
  190. begin
  191.   xpos:= wherex;
  192.   ypos:= wherey;
  193. end;
  194.  
  195. procedure PopXY;
  196. begin
  197.   gotoxy(xpos,ypos);
  198. end;
  199.  
  200. procedure normaltext;
  201. begin
  202.   textcolor(lightgray);
  203.   textbackground(black);
  204. end;
  205.  
  206. procedure reversevideo;
  207. begin
  208.   textcolor(black);
  209.   textbackground(lightgray);
  210. end;
  211.  
  212. function getyn:char;
  213. var ch : char;
  214. begin
  215.   repeat
  216.     ch:= upcase(readkey);
  217.     if ch>#31 then write(ch,^h);
  218.   until ch in ['Y','N'];
  219.   getyn:= ch;
  220. end;
  221.  
  222. function Iquit : boolean;
  223. begin
  224.   Iquit:= false;
  225.   if ch=#27 then Iquit:= true;
  226. end;
  227.  
  228. procedure InitScores;
  229. var i,j : byte;
  230. begin
  231.   for i:=1 to 2 do
  232.     for j:=1 to 4 do
  233.       player[i,j]:= 0;
  234.  
  235.   for i:=1 to 3 do ties[i]:= 0;
  236.  
  237.   totalrounds:= 0;
  238. end;
  239.  
  240.  
  241. procedure Status(player:byte; message:string);
  242. begin
  243.   PushXY;
  244.   {goto row 21 for Player 1; row 22 for Player 2}
  245.   gotoxy(18,20+player);
  246.   write(message);
  247.   clreol;
  248.   PopXY;
  249. end;
  250.  
  251. procedure UpdateScores;
  252. {Show the score on the screen}
  253. var i : byte;
  254. begin
  255.   for i:=1 to 2 do
  256.     begin
  257.       gotoxy(1,7+2*i);
  258.       write('│  ');
  259.       case i of
  260.         1 : if player1 then write('Me ') else write('You');
  261.         2 : if player2 then write('Me ') else write('You');
  262.       end;
  263.       write('   │    ',player[i,1]:3,'   ',
  264.             '    │     ',player[i,2]:3,'   ',
  265.             '    │    ',player[i,3]:3,' ',
  266.             '    │  ',player[i,4]:3,'  │');
  267.     end;
  268.  
  269.   gotoxy(1,17);
  270.   write('│ ',ties[1]:3,'  │  ',ties[2]:3,'    │  ',ties[3]:3,'  │');
  271.  
  272.   gotoxy(1,19);
  273.   write('Total Rounds Played: ',totalrounds:2);
  274. end; {of Update Scores}
  275.  
  276. procedure WriteTemplate;
  277. {Set up the initial screen}
  278. begin
  279.   PushXY;
  280.   normaltext;
  281.   clrscr;
  282.   write('Highlight your choice, then press Enter:  ');
  283.   reversevideo;
  284.   write('Rock');
  285.   normaltext;
  286.   writeln('     Sissors     Paper');
  287.   writeln;
  288.   writeln('Selection for this round (Esc=Quit):');
  289.   writeln;
  290.   writeln('Score:');
  291.   writeln('┌────────┬──────────────┬───────────────┬────────────┬───────┐');
  292.   writeln('│ Player │ Rock-Sissors │ Sissors-Paper │ Paper-Rock │ Total │');
  293.   writeln('├────────┼──────────────┼───────────────┼────────────┼───────┤');
  294.     write('│  ');
  295.   if player1 then write('Me ') else write('You');
  296.   writeln('   │      0       │       0       │      0     │    0  │');
  297.   writeln('├────────┼──────────────┼───────────────┼────────────┼───────┤');
  298.     write('│  ');
  299.   if player2 then write('Me ') else write('You');
  300.   writeln('   │      0       │       0       │      0     │    0  │');
  301.   writeln('└────────┴──────────────┴───────────────┴────────────┴───────┘');
  302.   writeln('Ties:');
  303.   writeln('┌──────┬─────────┬───────┐');
  304.   writeln('│ Rock │ Sissors │ Paper │');
  305.   writeln('├──────┼─────────┼───────┤');
  306.   writeln('│   0  │    0    │    0  │');
  307.   writeln('└──────┴─────────┴───────┘');
  308.   writeln('Total Rounds Played: ',totalrounds:2);
  309.   writeln;
  310.   write('Player 1 ');
  311.   if Player1 then write('  (Me): ') else write(' (You): ');
  312.   writeln;
  313.   write('Player 2 ');
  314.   if Player2 then write('  (Me): ') else write(' (You): ');
  315.   writeln;
  316.   writeln;
  317.     write('RPS-LAN   Copr. 1989 Athens Software, Inc.   All Rights Reserved. (404) 549-6912');
  318.     UpdateScores;
  319.   PopXY;
  320. end; {of WriteTemplate }
  321.  
  322. procedure writechoice;
  323. begin
  324.   PushXY;
  325.   if current=Rock then
  326.     begin
  327.       gotoxy(43,1);
  328.       write('Rock');
  329.     end
  330.   else
  331.   if current=Sissors then
  332.     begin
  333.       gotoxy(52,1);
  334.       write('Sissors');
  335.     end
  336.   else
  337.   if current=Paper then
  338.     begin
  339.       gotoxy(64,1);
  340.       write('Paper');
  341.     end;
  342.   PopXY;
  343. end; {of WriteChoice}
  344.  
  345. function StillPlaying : boolean;
  346. {this function really ties up a slow machine}
  347. var temp : boolean;
  348. begin
  349.   temp:= false;
  350.   if player1 then temp:= IsLocked(f,GameInProgress);
  351.   if player2 then
  352.     if IsLocked(f,Player1Selected) then temp:= true
  353.       else
  354.         begin
  355.           UnLock(f,GameInProgress);
  356.           UnLock(f,Player2Selected);
  357.           player2:= false;
  358.           player1:= true;
  359.           temp:= false;
  360.         end;
  361.   StillPlaying:= temp;
  362. end; {of Function StillPlaying}
  363.  
  364. procedure InitPlayer;
  365. {Find out whether we are player 1 or player 2;
  366.  if we are player 2 and player 1 quits, we become player 1.}
  367. begin
  368.   if IsLocked(f,GameInProgress) then
  369.     begin
  370.       clrscr;
  371.       writeln('Play List is Full--Game in use.');
  372.       halt(2);
  373.     end;
  374.  
  375.   Player1:= false;
  376.   Player2:= false;
  377.  
  378.   if not IsLocked(f,Player1Selected) then
  379.     begin
  380.       Player1:= true;
  381.       Lock(f,Player1Selected);
  382.       if StillPlaying then UnLock(f,GameInProgress);
  383.     end
  384.   else
  385.   if not IsLocked(f,Player2Selected) then
  386.     begin
  387.       Player2:= true;
  388.       Lock(f,Player2Selected);
  389.       Lock(f,GameInProgress);
  390.     end
  391.   else
  392.     begin
  393.       writeln('Both players locked -- program error.');
  394.       halt(3);
  395.     end;
  396.    InitScores;
  397. end; { end of InitPlayer }
  398.  
  399. procedure See_Who_Won;
  400. var HisCurrent,score : word;
  401.     test : boolean;
  402.     i : byte;
  403. begin
  404.   write(token[current]);
  405.   clreol;
  406.   gotoxy(38,3);
  407.   Status(1+ord(player2),token[current]+' selected.');
  408.  
  409.   if not IsLocked(f,current) then
  410.     Lock(f,current);                     {Lock Token}
  411.   Lock(f, Player1Tally + ord(player2));  {Lock Tally}
  412.   Lock(f, Player1Lock + ord(player2));   {Lock Select}
  413.  
  414.     ch:= #1;
  415.   { wait for other player}
  416.   while
  417.     {See if other guy has picked a token yet}
  418.     not (IsLocked(f,Player1Lock+ord(player1)))
  419.     and StillPlaying  {see if other guy is still playing }
  420.     and (not Iquit) do  {see if I want to quit }
  421.       if keypressed then
  422.         ch:= readkey;
  423.  
  424.   if not Iquit then {I didn't quit yet...}
  425.     begin
  426.       HisCurrent:= current;
  427.       for i:=Rock to Paper do
  428.         if IsLocked(f,i) then
  429.           HisCurrent:= i;
  430.  
  431.       Status(1+ord(player1),token[HisCurrent]+' selected.');
  432.  
  433.       {1=rock-sissors  2=sissors-paper  3=paper-rock  4= total}
  434.       if player1 then
  435.         score:= 10 * (current-4) + (HisCurrent-4)
  436.       else
  437.         score:= 10 * (HisCurrent-4) + (current-4);
  438.       case score of
  439.         11 : inc(ties[1]);
  440.         12 : inc(player[1,1]);
  441.         13 : inc(player[2,3]);
  442.         21 : inc(player[2,1]);
  443.         22 : inc(ties[2]);
  444.         23 : inc(player[1,2]);
  445.         31 : inc(player[1,3]);
  446.         32 : inc(player[2,2]);
  447.         33 : inc(ties[3]);
  448.       end; { of case score}
  449.       if HisCurrent<>current then
  450.         if score in [12,23,31] then inc(player[1,4])
  451.           else inc(player[2,4]);
  452.     end; { of if Esc Pressed}
  453.  
  454.   inc(totalrounds);
  455.  
  456.   {if a slow machine is playing a fast machine, the fast machine can
  457.    unlock the tally, select, and token records before the slow machine
  458.    can test what token the fast machine had locked.}
  459.   delay(1000);
  460.   status(1+ord(player2),'Waiting for other player to tally score...');
  461.   UnLock(f, Player1Tally+ord(player2));
  462.  
  463.   {wait for other player to unlock his tally}
  464.   while IsLocked(f,Player1Tally+ord(player1)) do ;
  465.  
  466.   UnLock(f,Player1Lock + ord(player2));
  467.  
  468.   {wait for other player to unlock his select record}
  469.   while IsLocked(f,Player1Lock + ord(player1)) do;
  470.  
  471.   UnLock(f, current);
  472. end; {See_Who_Won}
  473.  
  474. procedure WaitForPlayer2;
  475. begin
  476.   ch:= #1; {initialize the keypressed buffer}
  477.   if Player1 then {Wait for Player 2 to Log On}
  478.     begin
  479.       Status(2,'Not Logged on.');
  480.       Status(1,'Waiting for the other player to log on.  Press Esc to abort.');
  481.       repeat
  482.         if keypressed then
  483.           begin
  484.             ch:= readkey;
  485.             if keypressed then ch:= readkey;
  486.           end;
  487.       until StillPlaying or Iquit;
  488.     end;
  489. end; {Wait for Player 2}
  490.  
  491. procedure GameKeyPressed;
  492. {figure out what keys were pressed}
  493. begin
  494.   if ch=#0 then
  495.     begin
  496.       ch:= readkey;
  497.       case ch of
  498.         #75 : {left arrow}
  499.               begin
  500.                 normaltext;
  501.                 writechoice;
  502.                 if current=Rock then current:=Paper else dec(current);
  503.                 reversevideo;
  504.                 writechoice;
  505.                 normaltext;
  506.               end;
  507.  
  508.         #77 : {right arrow}
  509.               begin
  510.                 normaltext;
  511.                 writechoice;
  512.                 if current=Paper then current:=Rock else inc(current);
  513.                 reversevideo;
  514.                 writechoice;
  515.                 normaltext;
  516.               end;
  517.       end; { of case ch= #0}
  518.     end
  519.       else { single character pressed }
  520.         case ch of
  521.           #13 : begin {carriage return}
  522.                   See_Who_Won;
  523.                   WriteTemplate;
  524.                   RoundOver:= true;
  525.                 end;
  526.           #27 : begin {Escape}
  527.                   gotoxy(1,3);
  528.                   write('Are you sure you want to quit (y/n)? ');
  529.                   clreol;
  530.                   ch:=#1;
  531.                   if getyn='Y' then ch:= #27;
  532.                   gotoxy(1,3);
  533.                   clreol;
  534.                   write('Selection for this round (Esc=Quit): ');
  535.                 end;
  536.         end; { of case ch of }
  537. end; {Game Key Pressed}
  538.  
  539. procedure PlayThisRound;
  540. {play the game until somebody quits.
  541.  This loop is what slows down a slow machine so much,
  542.  the "StillPlaying" function is the main culprit.}
  543. begin
  544.   repeat
  545.     ch:=#1;
  546.     if keypressed then
  547.       begin
  548.         ch:= readkey;
  549.         GameKeyPressed;
  550.       end;
  551.  
  552.      if not MessageShown then
  553.        if IsLocked(f,Player1Lock+ord(player1)) then
  554.          begin
  555.            Status(1+ord(player1),'Have selected a token...');
  556.            MessageShown:= true;
  557.          end;
  558.   until RoundOver or (not StillPlaying) or Iquit;
  559. end; {of Play this Round }
  560.  
  561. procedure PlayTheGame;
  562. begin
  563.   repeat {play the game}
  564.     MessageShown:= false;
  565.     RoundOver:= false;
  566.     current:= Rock; { start with rock }
  567.  
  568.     gotoxy(1,3);
  569.     write('Selection for this round (Esc=Quit): ');
  570.     clreol;
  571.  
  572.     Status(1,'Ready for input...');
  573.     Status(2,'Ready for input...');
  574.  
  575.     PlayThisRound;
  576.  
  577.   until Iquit or not StillPlaying;
  578. end; {of Play the Game}
  579.  
  580. procedure FinishUp;
  581. begin
  582.   UnLock(f,Player1Selected+ord(player2));
  583.   if player2 then UnLock(f, GameInProgress);
  584.   close(f); {opened in InitTokenFile}
  585.   clrscr;
  586. end; {of FinishUp}
  587.  
  588. (*****************  MAIN PROGRAM  ********************************)
  589. begin
  590.   InitTokens;
  591.   InitTokenFile;
  592.   CheckLANstatus;
  593.   repeat {play the game until I quit playing}
  594.     ch:= #1; {initialize the keypressed character}
  595.     InitPlayer;
  596.     WriteTemplate;
  597.     WaitForPlayer2;
  598.     if not Iquit then PlayTheGame;
  599.   until Iquit; { play until I press Esc }
  600.   FinishUp;
  601. end. {of Fisties}