Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/TP_ADV.ZIP/LIST1203.PAS

Pascal/Delphi Source File | 1989-11-17 | 8.8 KB | 295 lines

Program TicTac;

Uses
  CRT;

Const
  PLAY = 1;        { Semaphore values }
  MOVE = 2;
  GOAHEAD = 3;
  WAITING = 4;
  GAMEOVER = 5;

Type
  PlayerRec   = Record
                  Status : Byte;  { semaphore status field }
                  Pos    : Byte;  { player's move field    }
                End;
  PlayerArray = Array [1..2] of PlayerRec;
  PlayerFile  = File of PlayerArray;

Var
  loop : Byte;
  first : boolean;     { TRUE = first program to start the game }
  FileName : String;   { Name of the data file }
  pa : PlayerArray;
  pf : PlayerFile;
  slot,                { Holds the position of player in the playerarray }
  other : Byte;        { Holds the opponent position in the playerarray }
  pPos : Byte;
  board : Array [1..9] of Byte;       { Play field }
  solution : Byte;                    { Who won the game? }

Procedure Terminate; Forward;

Function PlayFileExists : Boolean;
{ This function will check to see if the play file that is specified }
{ in the global FileName variable exists in the current directory.   }
{ TRUE = File exists    }
{ FALSE = No file found }
Var
  ioErr : Word;
Begin
  Assign ( pf, FileName );
  {$I-}
  Reset ( pf );
  {$I+}
  ioErr := IOResult;
  If ( ioErr = 2 ) Then   { This is the first program to run }
  Begin
    PlayFileExists := FALSE;
    slot := 1;
    other := 2;
  End
  Else
  Begin                   { Somebody else already set the game up }
    If ( ioErr = 0 ) Then
      Close ( pf );
    slot := 2;
    other := 1;
  End;
End;

Procedure GameInProgress;
{ Not too elegant, but you may taylor this to your own needs }
Begin
  WriteLn ( 'Game already in progress.' );
  Halt;
End;

Function CheckSolution : Byte;
{ This function will return a TRUE is there is a Win Solution to }
{ the game. With a TicTacToe set up as follows:                  }
{    1   2   3                                                   }
{    4   5   6                                                   }
{    7   8   9                                                   }
{ The combinations checked will be:                              }
{         1.)  1 2 3                                             }
{         2.)  1 4 7                                             }
{         3.)  1 5 9                                             }
{         4.)  7 8 9                                             }
{         5.)  7 5 3                                             }
{         6.)  2 5 8                                             }
{         7.)  3 6 9                                             }
{         8.)  4 5 6                                             }
Var
  Check : Array [1..2] of Boolean;
Begin
  For loop := 1 to 2 do
  Begin
    Check [loop] := FALSE;
    If ( board [1] = loop ) AND
       ( ( ( board [2] = loop ) AND ( board [3] = loop ) ) OR
         ( ( board [4] = loop ) AND ( board [7] = loop ) ) OR
         ( ( board [5] = loop ) AND ( board [9] = loop ) ) ) Then
      Check [loop] := TRUE
    Else
    If ( board [7] = loop ) AND
       ( ( ( board [8] = loop ) AND ( board [9] = loop ) ) OR
         ( ( board [5] = loop ) AND ( board [3] = loop ) ) ) Then
      Check [loop] := TRUE
    Else
    If ( (board [2] = loop) AND (board [5] = loop) AND (board [8] = loop) ) OR
       ( (board [3] = loop) AND (board [6] = loop) AND (board [9] = loop) ) OR
       ( (board [4] = loop) AND (board [5] = loop) AND (board [6] = loop) ) Then
      Check [loop] := TRUE;
  End;
  If ( Check [1] ) Then
    CheckSolution := 1
  Else
  If ( Check [2] ) Then
    CheckSolution := 2
  Else
  Begin
    Check [1] := TRUE;
    For loop := 1 to 9 Do
      Check [1] := Check [1] AND ( board [loop] in [1..2] );
    If ( Check [1] ) Then
      CheckSolution := 3  { Cat's game, no winner }
    Else
      CheckSolution := 0;
  End;
End;

Procedure Signal ( sig : Byte );
{ This procedure will set the appropriate status flag in the file }
{ specified by FileName to the value in SIG. SPECIAL CASE: If the }
{ flag SIG = PLAY, this procedure will determine if a game is     }
{ already in progress and will terminate the program is so.       }
Begin
  Assign ( pf, FileName );
  {$I-}
  Repeat                     { Repeat until the file is not    }
    Reset ( pf );            { locked. File is locked when     }
  Until ( IOResult = 0 );    { the other program is accessing. }
  {$I+}
  Read ( pf, pa );           { Read the player information }

  Case ( sig ) Of
       Move: Begin
               pa [ slot ].Pos := pPos;
               pa [ slot ].Status := MOVE;
               pa [ other ].Status := GOAHEAD;
             End;
       Play: Begin
               If ( pa [ slot ].Status <> WAITING ) Then
                 GameInProgress;
               pa [ slot ].Status := PLAY;
             End;
       GameOver : pa [ slot ].Status := GAMEOVER;
  End;
  Seek ( pf, 0 );                { Move to the start of the file }
  Write ( pf, pa );              { Write the new information out }
  Close ( pf );                  { Close the file }
End;

Procedure WaitFor ( position, sig : Byte );
{ This procedure will wait for the appropriate status flag in the }
{ file specified by FileName to be set to the value in SIG.       }
Begin
  Assign ( pf, FileName );
  Repeat
    {$I-}
    Repeat
      Reset ( pf );            { Repeat until the file is not locked }
    Until ( IOResult = 0 );
    {$I+}
    Read ( pf, pa );           { Read the player information in }
    Close ( pf );              { Close the file }
    Delay ( 500 );     { Delay to give the other program a chance  }
                       { to change the status.                     }
  Until ( pa [ position ].Status = sig );
  If ( pa [ other ].Status in [Move,GameOver] ) Then
    board [ pa [ other ].Pos ] := other;
End;

Procedure Terminate;
{ This procedure will be called when the current program has }
{ determined that the game is over. It will either set the   }
{ EOG ( End of Game ) signal and end, or will wait for the   }
{ other program to signal end of game, then erase the file   }
{ and end.                                                   }
Begin
  If ( solution = 3 ) Then
    WriteLn ( 'Sorry, no winner in this game.' )
  Else
  If ( solution = slot ) Then
    WriteLn ( 'Congradulations! You won the game!' )
  Else
    WriteLn ( 'I am sorry, you lost the game.' );
  Signal ( GameOver );
  If ( slot = 1 ) Then
  Begin
    WaitFor ( other, GameOver );
    Assign ( pf, FileName );
    {$I-}
    Erase ( pf );
    {$I+}
  End;
End;

Procedure CreatePlayFile;
{ This procedure will create a new Play File, the name of this }
{ file is specified by the variable FileName.                  }
Begin
  Assign ( pf, FileName );
  Rewrite ( pf );
  pa [ slot ].Status := Play;
  pa [ other ].Status := Waiting;
  Write ( pf, pa );
  Close ( pf );
End;

Function XXorOO ( b : Byte ) : String;
Begin
  If ( board [ b ] = 1 ) Then
    XXorOO := 'XX'
  Else
  If ( board [ b ] = 2 ) Then
    XXorOO := 'OO'
  Else
    XXorOO := '  ';
End;

Procedure ShowBoard;
Var
  oldWindMin,
  oldWindMax : Word;
Begin
  oldWindMin := WindMin;
  oldWindMax := WindMax;
  Window ( 1,1,20,8 );
  ClrScr;
  WriteLn ( XXorOO ( 7 ):4, ' |', XXorOO ( 8 ):4, ' |', XXorOO ( 9 ):3 );
  WriteLn ( ' ----+-----+----' );
  WriteLn ( XXorOO ( 4 ):4, ' |', XXorOO ( 5 ):4, ' |', XXorOO ( 6 ):3 );
  WriteLn ( ' ----+-----+----' );
  WriteLn ( XXorOO ( 1 ):4, ' |', XXorOO ( 2 ):4, ' |', XXorOO ( 3 ):3 );
  WindMin := oldWindMin;
  WindMax := oldWindMax;
End;

Procedure GetMove;
{ This procedure will get the move of the player and make sure }
{ that it is a valid move.                                     }
Var
  x, y : Byte;
Begin
  ShowBoard;
  Repeat
    Window ( 1, 20, 80, 25 );
    ClrScr;
    Write ( 'What is your move? ' );
    ReadLn ( pPos );
  Until ( pPos in [1..9] ) AND ( board [ pPos ] = 0 );
  board [ pPos ] := Slot;
  ShowBoard;
End;

Begin
  ClrScr;
  CheckBreak := FALSE;            { Initialize the variables }
  For loop := 1 to 9 Do                      { " }
    board [ loop ] := 0;                     { " }
  FileName := 'F:\tictac.dat';               { " }

  If PlayFileExists Then
  Begin
    Signal ( Play ); { signal will abort if another game is in progress }
    First := FALSE;
    ShowBoard;       { display the empty playing field }
  End
  Else
  Begin
    CreatePlayFile;
    First := TRUE;
    WriteLn ( 'Waiting for other player to join game.' );
    WaitFor ( other, Play );
    ClrScr;
    GetMove;
    Signal ( Move );
  End;
  Repeat
    WaitFor ( slot, GoAhead );
    solution := CheckSolution;
    if ( Solution = 0 ) Then
    Begin
      GetMove;
      Signal ( Move );
    End;
    solution := CheckSolution;
  Until ( solution in [1..3] );
  ShowBoard;
  Terminate;
End.