Program DiceCricket;
{Skeleton Program code for the AQA COMP1 Summer 2011 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 may also add the SysUtils library if their
version of Pascal uses this}
{Permission to make these changes to the Skeleton Program does not
need to be obtained from AQA/AQA Programmer - just remove the \ symbol from
the next line of code and remove the braces around Uses SysUtils;}
{\$APPTYPE CONSOLE}
{Uses
SysUtils;}
Const MaxSize = 4;
Type TTopScore = Record
Name : String;
Score : Integer;
End;
TTopScores = Array[1..MaxSize] Of TTopScore;
Var
TopScores : TTopScores;
PlayerOneName : String;
PlayerTwoName : String;
OptionSelected : Integer;
Procedure ResetTopScores(Var TopScores : TTopScores);
Var
Count : Integer;
Begin
For Count := 1 To MaxSize
Do
Begin
TopScores[Count].Name := '-';
TopScores[Count].Score := 0;
End;
End;
Function GetValidPlayerName : String;
Var
PlayerName : String;
Begin
Repeat
Readln(PlayerName);
If PlayerName = ''
Then Write('That was not a valid name. Please try again: ');
Until PlayerName <> '';
GetValidPlayerName := PlayerName;
End;
Procedure DisplayMenu;
Begin
Writeln;
Writeln('Dice Cricket');
Writeln;
Writeln('1. Play game version with virtual dice');
Writeln('2. Play game version with real dice');
Writeln('3. Load top scores');
Writeln('4. Display top scores');
Writeln('9. Quit');
Writeln;
End;
Function GetMenuChoice : Integer;
Var
OptionChosen : Integer;
Begin
Write('Please enter your choice: ');
Readln(OptionChosen);
If (OptionChosen < 1) Or ((OptionChosen > 4) And (OptionChosen <> 9))
Then
Begin
Writeln;
Writeln('That was not one of the allowed options. Please try again: ');
End;
GetMenuChoice := OptionChosen;
End;
Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
Var
BowlDieResult : Integer;
Begin
If VirtualDiceGame
Then BowlDieResult := Random(6) + 1
Else
Begin
Writeln('Please roll the bowling die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is a 1');
Writeln('Enter 2 if the result is a 2');
Writeln('Enter 3 if the result is a 4');
Writeln('Enter 4 if the result is a 6');
Writeln('Enter 5 if the result is a 0');
Writeln('Enter 6 if the result is OUT');
Writeln;
Write('Result: ');
Readln(BowlDieResult);
Writeln;
End;
RollBowlDie := BowlDieResult;
End;
Function CalculateRunsScored(BowlDieResult : Integer) : Integer;
Var
RunsScored : Integer;
Begin
Case BowlDieResult Of
1 : RunsScored := 1;
2 : RunsScored := 2;
3 : RunsScored := 4;
4 : RunsScored := 6;
5, 6 : RunsScored := 0;
End;
CalculateRunsScored := RunsScored;
End;
Procedure DisplayRunsScored(RunsScored : Integer);
Begin
Case RunsScored Of
1 : Writeln('You got one run!');
2 : Writeln('You got two runs!');
4 : Writeln('You got four runs!');
6 : Writeln('You got six runs!');
End;
End;
Procedure DisplayCurrentPlayerNewScore(CurrentPlayerScore : Integer);
Begin
Writeln('Your new score is: ', CurrentPlayerScore);
End;
Function RollAppealDie(VirtualDiceGame : Boolean) : Integer;
Var
AppealDieResult : Integer;
Begin
If VirtualDiceGame
Then AppealDieResult := Random(4) + 1
Else
Begin
Writeln('Please roll the appeal die and then enter your result.');
Writeln;
Writeln('Enter 1 if the result is NOT OUT');
Writeln('Enter 2 if the result is CAUGHT');
Writeln('Enter 3 if the result is LBW');
Writeln('Enter 4 if the result is BOWLED');
Writeln;
Write('Result: ');
Readln(AppealDieResult);
Writeln;
End;
RollAppealDie := AppealDieResult;
End;
Procedure DisplayAppealDieResult(AppealDieResult : Integer);
Begin
Case AppealDieResult Of
1 : Writeln('Not out!');
2 : Writeln('Caught!');
3 : Writeln('LBW!');
4 : Writeln('Bowled!');
End;
End;
Procedure DisplayResult(PlayerOneName : String; PlayerOneScore : Integer;
PlayerTwoName : String; PlayerTwoScore : Integer);
Begin
Writeln;
Writeln(PlayerOneName, ' your score was: ', PlayerOneScore);
Writeln(PlayerTwoName, ' your score was: ', PlayerTwoScore);
Writeln;
If PlayerOneScore > PlayerTwoScore
Then Writeln(PlayerOneName, ' wins!');
If PlayerTwoScore > PlayerOneScore
Then Writeln(PlayerTwoName, ' wins!');
Writeln;
End;
Procedure UpdateTopScores(Var TopScores : TTopScores; PlayerName : String;
PlayerScore : Integer);
Var
LowestCurrentTopScore : Integer;
PositionOfLowestCurrentTopScore : Integer;
Count : Integer;
Begin
LowestCurrentTopScore := TopScores[1].Score;
PositionOfLowestCurrentTopScore := 1;
{Find the lowest of the current top scores}
For Count := 2 To MaxSize
Do
If TopScores[Count].Score < LowestCurrentTopScore
Then
Begin
LowestCurrentTopScore := TopScores[Count].Score;
PositionOfLowestCurrentTopScore := Count;
End;
If PlayerScore > LowestCurrentTopScore
Then
Begin
TopScores[PositionOfLowestCurrentTopScore].Score := PlayerScore;
TopScores[PositionOfLowestCurrentTopScore].Name := PlayerName;
Writeln('Well done ', PlayerName, ' you have one of the top scores!');
End;
End;
Procedure DisplayTopScores(TopScores : TTopScores);
Var
Count : Integer;
Begin
Writeln('The current top scores are: ');
Writeln;
For Count := 1 To MaxSize
Do Writeln(TopScores[Count].Name, ' ', TopScores[Count].Score);
Writeln;
Writeln('Press the Enter key to return to the main menu');
Readln;
End;
Procedure LoadTopScores(Var TopScores : TTopScores);
{Centres using older versions of Pascal might need to delete the line that
uses StrToInt and use the two alternative lines in braces. Permission to
make these changes does not need to be obtained from AQA/AQA Programmer.}
Var
Count : Integer;
Count2 : Integer;
{Err : Integer;}
LineFromFile : String;
ValuesOnLine : Array[1..2] Of String;
CurrentFile : Text;
Begin
Assign(CurrentFile, 'HiScores.txt');
Reset(CurrentFile);
For Count := 1 To MaxSize
Do
Begin
ValuesOnLine[1] := '';
ValuesOnLine[2] := '';
Readln(CurrentFile, LineFromFile);
Count2 := 1;
Repeat
ValuesOnLine[1] := ValuesOnLine[1] + LineFromFile[Count2];
Count2 := Count2 + 1;
Until LineFromFile[Count2] = ',';
Count2 := Count2 + 1;
Repeat
ValuesOnLine[2] := ValuesOnLine[2] + LineFromFile[Count2];
Count2 := Count2 + 1;
Until Count2 > Length(LineFromFile);
TopScores[Count].Name := ValuesOnLine[1];
TopScores[Count].Score := StrToInt(ValuesOnLine[2]);
{Val(ValuesOnLine[2],TopScores[Count].Score, Err);}
End;
Close(CurrentFile);
End;
Procedure PlayDiceGame(PlayerOneName, PlayerTwoName : String;
VirtualDiceGame : Boolean; Var TopScores : TTopScores);
Var
PlayerOut : Boolean;
CurrentPlayerScore : Integer;
AppealDieResult : Integer;
PlayerNo : Integer;
PlayerOneScore : Integer;
PlayerTwoScore : Integer;
BowlDieResult : Integer;
RunsScored : Integer;
Begin
For PlayerNo := 1 To 2
Do
Begin
CurrentPlayerScore := 0;
PlayerOut := False;
If PlayerNo = 1
Then Writeln(PlayerOneName, ' is batting')
Else Writeln(PlayerTwoName, ' is batting');
Writeln;
Writeln('Press the Enter key to continue');
Readln;
Repeat
BowlDieResult := RollBowlDie(VirtualDiceGame);
If BowlDieResult In [1..4]
Then
Begin
RunsScored := CalculateRunsScored(BowlDieResult);
DisplayRunsScored(RunsScored);
CurrentPlayerScore := CurrentPlayerScore + RunsScored;
Writeln('Your new score is: ', CurrentPlayerScore);
End;
If BowlDieResult = 5
Then Writeln('No runs scored this time. Your score is still: ',
CurrentPlayerScore);
If BowlDieResult = 6
Then
Begin
Writeln('This could be out... press the Enter key to find out.');
Readln;
AppealDieResult := RollAppealDie(VirtualDiceGame);
DisplayAppealDieResult(AppealDieResult);
If AppealDieResult >= 2
Then PlayerOut := True
Else PlayerOut := False;
End;
Writeln;
Writeln('Press the Enter key to continue');
Readln;
Until PlayerOut;
Writeln('You are out. Your final score was: ', CurrentPlayerScore);
Writeln;
Writeln('Press the Enter key to continue');
Readln;
If PlayerNo = 1
Then PlayerOneScore := CurrentPlayerScore
Else PlayerTwoScore := CurrentPlayerScore;
End;
DisplayResult(PlayerOneName, PlayerOneScore, PlayerTwoName, PlayerTwoScore);
If (PlayerOneScore >= PlayerTwoScore)
Then
Begin
UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
End
Else
Begin
UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
End;
Writeln;
Writeln('Press the Enter key to continue');
Readln;
End;
Begin
Randomize;
ResetTopScores(TopScores);
Write('What is player one''s name? ');
PlayerOneName := GetValidPlayerName;
Write('What is player two''s name? ');
PlayerTwoName := GetValidPlayerName;
Repeat
Repeat
DisplayMenu;
OptionSelected := GetMenuChoice;
Until OptionSelected In [1..4, 9];
Writeln;
If OptionSelected In [1..4]
Then
Case OptionSelected Of
1 : PlayDiceGame(PlayerOneName, PlayerTwoName, True, TopScores);
2 : PlayDiceGame(PlayerOneName, PlayerTwoName, False, TopScores);
3 : LoadTopScores(TopScores);
4 : DisplayTopScores(TopScores);
End;
Until OptionSelected = 9;
End.
No comments:
Post a Comment