Sunday, 16 January 2011

comp1

//AQA
{Skeleton program code for the AQA Comp1 Summer 2010 examination
this code should be used in conjunction with the Preliminary
Material written by the AQA COMP1 Programmer Team developed in the
Free Pascal IDE for Win32 v1.0.10 programming environment}

{Centres using Delphi should add the compiler directive that sets
the application type to Console (other centres can ignore this
comment).  Centres can also add the SysUtils library}

{Permission to make these changes to the Skeleton Program does not
need to be obtained from AQA - just remove the \ symbol from the
next line of code and remove the braces around "Uses SysUtils"}

//RG.SkuToV
//BB.Bin Power
//     Chnges to original code are documented as comments past the 80
//   character line. Some additional comments have been added for clarity
//   and original post of this version can be obtained from:
//
//                  http://comp1-2010.blogspot.com
//
//   List of changes V1.0:
//       * Line 114  // Who's go added                      \\Added by BB 01/03/2010
//                   Added to show which players turn it is whilst in game
//       * Line 133 // Y corodinate validation added        \\Added by RG 01/03/2010
//               Added to confirm y coordinates given
//           are in acceptable range.   
//       * Line 135 // Occupied Space validation added      \\Added by RG 02/03/2010
//               Added to confirm a given space in empty before
//           allowing a move.
//       * Line 154 // Diagonal Conditions Added            \\Added by RG 01/03/2010
//               Added to include diagonal lines in the win conditions
//           for each game.
//       * Line 166 // Added ; for compiler error           \\Added by RG 01/03/2010
//               Added a ; to fix syntax error in code
//       * Line 179 // Added : for compiler error           \\Added by RG 01/03/2010
//          Added a : to fix syntax error in code
//       * Line 189 // Added Name Validator                 \\Added by BB 02/03/2010
//          Added code to ensure entered names are different
//
//      Various doccumentation, comments and formatting     \\Added by RG 02/03/2010
//      added for ease of reading.
//
//  This work is @COPYLEFT ALL WRONGS RESERVED
//       All users of this work have:
//         0. the freedom to use the work,
//         1. the freedom to study the work,
//         2. the freedom to copy and share the work with others,
//         3. the freedom to modify the work, and the freedom to distribute
//                  modified and therefore derivative works.
//
//  Any subsequent release must contain all notices
//  prior to this point and must be released under the same user license (Copyleft)

{$APPTYPE CONSOLE}
uses
  SysUtils;

Type
  TBoard = Array[1..3, 1..3] Of Char;
Var
  Board : TBoard;
  PlayerOneName : String;
  PlayerTwoName : String;
  PlayerOneScore : Real;
  PlayerTwoScore : Real;
  XCoord : Integer;
  YCoord : Integer;
  ValidMove : Boolean;
  NoOfMoves : Integer;
  GameHasBeenWon : Boolean;
  GameHasBeenDrawn : Boolean;
  CurrentSymbol : Char;
  StartSymbol : Char;
  PlayerOneSymbol : Char;
  PlayerTwoSymbol : Char;
  Answer : Char;

Procedure DisplayBoard(Board : TBoard);
  Var
    Row : Integer;
    Column : Integer;
  Begin
    Writeln('  | 1 2 3 ');
    Writeln('--+-------');
    For Row := 1 To 3
      Do
        Begin
          Write(Row, ' | ');
          For Column := 1 To 3
            Do Write(Board[Column, Row], ' ');
          Writeln;
        End;
    Writeln;
  End;

Procedure ClearBoard(Var Board : TBoard);
  Var
    Row : Integer;
    Column : Integer;
  Begin
    For Row := 1 To 3
      Do
        For Column := 1 To 3
          Do Board[Column, Row] := ' ';
  End;

Procedure GetMoveCoordinates(Var XCoordinate, YCoordinate : Integer);
var CurrentPlayer : String;
  Begin
    if (PlayerOneSymbol = CurrentSymbol)                                        // Who's go added
     then CurrentPlayer := PlayerOneName
     else CurrentPlayer := PlayerTwoName;
    Write(CurrentPlayer, ' Enter x coordinate: ');
    Readln(XCoordinate);
    Write(CurrentPlayer, ' Enter y coordinate: ');                              // Who's go added /end
    Readln(YCoordinate);
    Writeln;
  End;

Function CheckValidMove(XCoordinate, YCoordinate : Integer;
                                Board : TBoard) : Boolean;
  Var
    ValidMove : Boolean;
  Begin
    ValidMove := True;
    {Check x coordinate is valid}
    If (XCoordinate < 1) Or (XCoordinate > 3)
      Then ValidMove := False;
    If (YCoordinate < 1) Or (YCoordinate > 3)                                   // Y corodinate validation added
      Then ValidMove := False;
    If Board[XCoordinate, YCoordinate] <> ' '                                   // Occupied Space validation added
      Then ValidMove := False;
    CheckValidMove := ValidMove;
  End;

Function CheckXOrOHasWon (Board : TBoard) : Boolean;
  Var
    Row : Integer;
    Column : Integer;
    XOrOHasWon : Boolean;
  Begin
    XOrOHasWon := False;
    If (Board[1, 1] = Board[2, 2])                                              // Diagonal Conditions Added
        And (Board[2, 2] = Board[3, 3])
            And (Board[2, 2] <> ' ')
        Then XOrOHasWon := True;
    If (Board[1, 3] = Board[2, 2])
        And (Board[2, 2] = Board[3, 1])
            And (Board[2, 2] <> ' ')
        Then XOrOHasWon := True;                                                // Diagonal Conditions Added /end
    For Column := 1 To 3
      Do
        If (Board[Column, 1] = Board[Column, 2])
            And (Board[Column, 2] = Board [Column, 3])
              And (Board[Column, 2] <> ' ')
          Then XOrOHasWon := True;
    For Row := 1 To 3
      Do
        If (Board[1, Row] = Board[2, Row])
            And (Board[2, Row] = Board [3, Row])
              And (Board[2, Row] <> ' ')
          Then XOrOHasWon := True;                                              // Added ; for compiler error
    CheckXOrOHasWon := XOrOHasWon;
  End;

Function GetWhoStarts : Char;
  Var
    RandomNo : Integer;
    WhoStarts : Char;
  Begin
    RandomNo := Random(100);
    If (RandomNo Mod 2) = 0
      Then WhoStarts := 'X'
      Else WhoStarts := 'O';
    GetWhoStarts := WhoStarts;                                                  // Added : for compiler error
  End;

///////////////////////{ Main program block starts here }\\\\\\\\\\\\\\\\\\\\\\\
Begin
  Randomize;
  Write('What is the name of player one? ');
  Readln(PlayerOneName);
  Write('What is the name of player two? ');
  Readln(PlayerTwoName);
  while (PlayerOneName = PlayerOneName)                                         // Added Name Validator
    do
      begin
        Writeln ('Player names can''t be the same');
        Write('What is the name of player two? ');
        Readln(PlayerTwoName);
    end;                                                                        // Added Name Validator /end
  Writeln;
  PlayerOneScore := 0;
  PlayerTwoScore := 0;
  Repeat {Choose player one's symbol}
    Write(PlayerOneName, ' what symbol do you wish to use, X or O? ');
    Readln(PlayerOneSymbol);
    Writeln;
    // validate entry
    If Not (PlayerOneSymbol In ['X', 'O'])
      Then
        Begin
          Writeln('Symbol to play must be uppercase X or O');
          Writeln;
        End; {begin}
  Until PlayerOneSymbol In ['X', 'O']; {repeat, player 1 choose}
  //set player 2 symbol
  If PlayerOneSymbol = 'X'
    Then PlayerTwoSymbol := 'O'
    Else PlayerTwoSymbol := 'X';
  StartSymbol := GetWhoStarts;
  Repeat {Play a game}
  // initialise variables
    NoOfMoves := 0;
    GameHasBeenDrawn := False;
    GameHasBeenWon := False;
    ClearBoard(Board);
    Writeln;
    DisplayBoard(Board);
    //choose starting player
    If StartSymbol = PlayerOneSymbol
      Then Writeln(PlayerOneName, ' starts playing ', StartSymbol)
      Else Writeln(PlayerTwoName, ' starts playing ', StartSymbol);
    Writeln;
    CurrentSymbol := StartSymbol;
    Repeat {Play until a player wins or the game is drawn}
      Repeat {Get a valid move}
        GetMoveCoordinates(XCoord, YCoord);
        ValidMove := CheckValidMove(XCoord, YCoord, Board);
        If Not ValidMove
          Then Writeln('Coordinates invalid, please try again');
      Until ValidMove;
      Board[XCoord, YCoord] := CurrentSymbol;
      DisplayBoard(Board);
      GameHasBeenWon := CheckXOrOHasWon(Board);
      NoOfMoves := NoOfMoves + 1;
      If Not GameHasBeenWon
        Then
          If NoOfMoves = 9 {Check if maximum number of allowed moves has been reached}
            Then GameHasBeenDrawn := True
            Else
              If CurrentSymbol = 'X'
                Then CurrentSymbol := 'O'
                Else CurrentSymbol := 'X';
    Until GameHasBeenWon Or GameHasBeenDrawn;

    //////// End of Game code \\\\\\\\

    If GameHasBeenWon {Update scores and display result}
      Then
        If PlayerOneSymbol = CurrentSymbol
          Then
            Begin
              Writeln(PlayerOneName, ' congratulations you win!');
              PlayerOneScore := PlayerOneScore + 1;
            End
          Else
            Begin
              Writeln(PlayerTwoName, ' congratulations you win!');
              PlayerTwoScore := PlayerTwoScore + 1;
            End
      Else Writeln('A draw this time!');
    Writeln;
    Writeln(PlayerOneName, ', your score is: ', PlayerOneScore:3:1);
    Writeln(PlayerTwoName, ', your score is: ', PlayerTwoScore:3:1);
    Writeln;
    If StartSymbol = PlayerOneSymbol
      Then StartSymbol := PlayerTwoSymbol
      Else StartSymbol := PlayerOneSymbol;
    Write('Another game Y/N? ');
    Readln(Answer);
  Until (Answer In ['N', 'n']);
End.

No comments:

Post a Comment