fix

1.
{Skeleton Program code for the AQA COMP1 Summer 2011 examination
2.
this code should be used in conjunction with the Preliminary Material
3.
written by the AQA COMP1 Programmer Team developed in the
4.
Free Pascal IDE for Win32 v1.0.10 programming environment}
5.

6.
{$APPTYPE CONSOLE}
7.

8.
uses
9.
SysUtils;
10.

11.
const
12.
MAXSIZE = 4;
13.

14.
type
15.
TTopScore = record
16.
Name : string; //Records the name of the player that got the high score
17.
Score : integer; //Records the score the player got
18.
end;
19.

20.
TTopScores = array[1..MaxSize] of TTopScore;
21.

22.
var
23.
TopScores : TTopScores; //?????????????????????????
24.
PlayerOneName : string; //Records Player One's name
25.
PlayerTwoName : string; //Records Player Two's name
26.
OptionSelected : integer; //Records the option selected in the menu
27.

28.
procedure ResetTopScores(var TopScores : TTopScores); //Resets the array
29.
//TopScores
30.
var
31.
Count : integer; //Stores loop number
32.
begin
33.
for Count := 1 to MaxSize do
34.
begin
35.
TopScores[Count].Name := '-'; //Resets the name of the player
36.
TopScores[Count].Score := 0; //Resets the score of the player
37.
end;
38.
end;
39.

40.
function GetValidPlayerName : string; //Checks the player name is valid
41.
var
42.
PlayerName : string; //Stores the player name
43.
begin
44.
repeat
45.
Readln(PlayerName); //Stores the inputted data as variable 'PlayerName'
46.

47.
PlayerName := Trim(PlayerName); //Trims playername of spaces
48.

49.
if (PlayerName = '') or (Length(Playername) > 20) then
50.
Write('That was not a valid name. Please try again: ');
51.
until (PlayerName <> '') and (Length(PlayerName) <= 20); 52. //Reteats an error message if the player's name is blank or over 20 53. //characters long 54. 55. GetValidPlayerName := PlayerName; //Once name is valid, stores Playername into 56. //GetValidPlayerName 57. end; 58. 59. procedure DisplayMenu; //Displays the multiple choice menu 60. begin 61. Writeln; 62. Writeln('Dice Cricket'); 63. Writeln; 64. Writeln('1. Play game version with virtual dice'); 65. Writeln('2. Play game version with real dice'); 66. Writeln('3. Load top scores'); 67. Writeln('4. Display top scores'); 68. Writeln('5. Sort top scores'); 69. Writeln('6. Save top Scores'); 70. Writeln('7. Reset Top Scores'); 71. Writeln('8. Unknown Option'); 72. Writeln('9. Quit'); 73. Writeln; 74. end; 75. 76. function GetMenuChoice : integer; //Checks the entered menu option and stores it 77. var 78. OptionChosen : integer; //Stores the option chosen in the menu 79. begin 80. Write('Please enter your choice: '); //Displays a message to enter choice 81. 82. try 83. Readln(OptionChosen); //Reads input and stores as variable OptionChosen 84. except 85. Optionchosen := 0; //If invalid data is inputted set 'Optionchosen' to 0 86. end; 87. 88. if (OptionChosen < 1) or ((OptionChosen > 7) and (OptionChosen <> 9)) then
89.
begin
90.
Writeln;
91.
Writeln('That was not one of the allowed options. Please try again: ');
92.
end; //Displays an error message if the option entered is less than one,
93.
//more than 7 and not equal to 9.
94.

95.
GetMenuChoice := OptionChosen; //Copies content of 'GetMenuChouse' to
96.
//'OptionChosen'
97.
end;
98.

99.
function RollBowlDie(VirtualDiceGame : Boolean) : integer;
100.
//Rolls dice and displays the result
101.
var
102.
BowlDieResult : integer; //Result after the dice was rolled
103.
begin
104.
if VirtualDiceGame then
105.
BowlDieResult := Random(6) + 1 //Gets random dice result and stroes as
106.
//variable 'BowlDieResult'
107.
else
108.
begin
109.
repeat
110.
Writeln('Please roll the bowling die and then enter your result.');
111.
Writeln;
112.
Writeln('Enter 1 if the result is a 1');
113.
Writeln('Enter 2 if the result is a 2');
114.
Writeln('Enter 3 if the result is a 4');
115.
Writeln('Enter 4 if the result is a 6');
116.
Writeln('Enter 5 if the result is a 0');
117.
Writeln('Enter 6 if the result is OUT');
118.
Writeln;
119.
Write('Result: ');
120.
//Options to enter what result you got
121.
try
122.
ReadLn(BowlDieResult); //Stores enteres result as 'BowlDieResult'
123.
except
124.
WriteLn;
125.
WriteLn('You must not enter a letter as a roll result!');
126.
BowlDieResult := 0; //Sets result to 0 if incorrect data is entered
127.
end;
128.

129.
until BowlDieResult in [1..6]; //Repeats until an option 1 to 6 is entered
130.
end;
131.

132.
RollBowlDie := BowlDieResult;
133.
//Stores contents of BowlDieResult into RollBowlDie
134.
end;
135.

136.
function CalculateRunsScored(BowlDieResult : integer) : integer;
137.
//Calculates the scores when different numbers are inputted
138.

139.
var
140.
RunsScored : integer; //Stores the score assigned to inputted number.
141.
begin
142.
case BowlDieResult of
143.
1 : RunsScored := 1;
144.
2 : RunsScored := 2;
145.
3 : RunsScored := 4; //Assigns scores to inputted options
146.
4 : RunsScored := 6;
147.
5, 6 : RunsScored := 0;
148.
end;
149.

150.
CalculateRunsScored := RunsScored;
151.
//Copies contents of RunsScored to CalculateRunsScored
152.
end;
153.

154.
procedure DisplayRunsScored(RunsScored : integer);
155.
//Displays the score the player got
156.
begin
157.
case RunsScored of
158.
1 : Writeln('You got one run!');
159.
2 : Writeln('You got two runs!');
160.
4 : Writeln('You got four runs!');
161.
6 : Writeln('You got six runs!');
162.
end;
163.
end;
164.

165.
procedure DisplayCurrentPlayerNewScore(CurrentPlayerScore : integer);
166.
//Displays the current players score
167.
begin
168.
Writeln('Your new score is: ', CurrentPlayerScore);
169.
end;
170.

171.
function RollAppealDie(VirtualDiceGame : Boolean) : integer;
172.
//Displays the appeal die menu and records score entered
173.
var
174.
AppealDieResult : integer; //Stores the appeal die score entered
175.
begin
176.
if VirtualDiceGame then
177.
AppealDieResult := Random(4) + 1
178.
else
179.
begin
180.
Repeat //Repeats menu till a valid number is given
181.
Writeln('Please roll the appeal die and then enter your result.');
182.
Writeln;
183.
Writeln('Enter 1 if the result is NOT OUT');
184.
Writeln('Enter 2 if the result is CAUGHT');
185.
Writeln('Enter 3 if the result is LBW');
186.
Writeln('Enter 4 if the result is BOWLED');
187.
Writeln;
188.
Write('Result: ');
189.

190.
try
191.
Readln(AppealDieResult);
192.
//Stores number entered as variable 'AppealDieResult'
193.
except //Displays an error messaage if an invalid option is inputted
194.
WriteLn('This is not one of the allowed options!');
195.
WriteLn;
196.
AppealDieResult := 0; //Sets variable AppealDieResult to 0
197.
end;
198.

199.
Until AppealDieResult in [1..4];
200.

201.
Writeln;
202.
end;
203.

204.
RollAppealDie := AppealDieResult;
205.
end;
206.

207.
procedure DisplayAppealDieResult(AppealDieResult : integer);
208.
//Displays appeal die score
209.
begin //Assigns a message to be displayed when each number is entered
210.
case AppealDieResult of
211.
1 : Writeln('Not out!');
212.
2 : Writeln('Caught!');
213.
3 : Writeln('LBW!');
214.
4 : Writeln('Bowled!');
215.
end;
216.
end;
217.

218.
procedure DisplayResult(PlayerOneName : string; PlayerOneScore : integer;
219.
PlayerTwoName : string; PlayerTwoScore : integer);
220.
//Displays players scores at end of the game
221.
begin
222.
Writeln; //Tells the player what thier score is
223.
Writeln(PlayerOneName, ' your score was: ', PlayerOneScore);
224.
Writeln(PlayerTwoName, ' your score was: ', PlayerTwoScore);
225.
Writeln;
226.

227.
//If P1's score is more than P2's score then displays this message
228.
if PlayerOneScore > PlayerTwoScore then
229.
Writeln(PlayerOneName, ' wins!');
230.

231.
//If P2's score is more than P1's score then displays this message
232.
if PlayerTwoScore > PlayerOneScore then
233.
Writeln(PlayerTwoName, ' wins!');
234.

235.
//If P2's score is equal to P1's score then displays this message
236.
if PlayerTwoScore = PlayerOneScore then
237.
Writeln(PlayerOneName, ' and ', PlayerTwoName, ' have drawn!');
238.

239.
Writeln;
240.
end;
241.

242.
procedure UpdateTopScores(var TopScores : TTopScores; PlayerName : string;
243.
PlayerScore : integer);
244.
//Calculates if the score should go on top score list
245.
var
246.
LowestCurrentTopScore : integer;
247.
//Stores the lowest current top score in saved text file
248.
PositionOfLowestCurrentTopScore : integer;
249.
//Stores the position of the lowest current top score by looking in the text
250.
//file
251.
Count : integer; //Stores loop number
252.
begin
253.
LowestCurrentTopScore := TopScores[1].Score;
254.
PositionOfLowestCurrentTopScore := 1;
255.

256.
{Find the lowest of the current top scores}
257.
for Count := 2 to MaxSize do
258.
if TopScores[Count].Score < LowestCurrentTopScore then 259. begin 260. LowestCurrentTopScore := TopScores[Count].Score; 261. 262. //Sets the score position as the loop number 263. PositionOfLowestCurrentTopScore := Count; 264. 265. end; 266. 267. //If the player score is more than the current lowest score then saves it 268. //and displays a message congratulating the player. 269. if PlayerScore > LowestCurrentTopScore then
270.
begin
271.
TopScores[PositionOfLowestCurrentTopScore].Score := PlayerScore;
272.
TopScores[PositionOfLowestCurrentTopScore].Name := PlayerName;
273.
Writeln('Well done ', PlayerName, ' you have one of the top scores!');
274.
end;
275.
end;
276.

277.
procedure SaveTopScores (TopScores : TTopScores);
278.
var
279.
Count : Integer; //Stores loop number
280.
CurrentFile : Text;
281.
//Stores the content of the current file containing high scores
282.

283.
begin
284.
Assign(CurrentFile, 'HiScores.txt'); //Selects the file to save the score
285.
Rewrite(CurrentFile);
286.

287.
//Writes the player position, name and score into the file for each loop cycle
288.
for Count := 1 to MAXSIZE do
289.
begin
290.
Write(CurrentFile, Topscores[Count].Name);
291.
Write(Currentfile, ',');
292.
WriteLn(CurrentFile, TopScores[Count].Score);
293.
end;
294.

295.
Close(CurrentFile); //Closes the text file
296.
end;
297.

298.
procedure SortTopScores (var Topscores : TTopScores);
299.
//Sorts the top scores from highest to lowest
300.
var
301.
Count : Integer; //Stores the loop number
302.
Tempscore : TTopScore; //Stores the score temporarily using array TTopScore
303.
Swapped : Boolean; //Stores weather the scors have been swapped or not.
304.
begin
305.
repeat //Sorts the score using a bubble sort. Repeats till they are in order
306.
Swapped := False;
307.
for count := 1 to (MAXSIZE -1) do
308.
if Topscores[Count].Score < Topscores[Count +1].Score then 309. begin 310. Tempscore := Topscores[Count]; 311. TopScores[Count] := Topscores[Count +1]; 312. TopScores[Count +1] := Tempscore; 313. 314. Swapped := True; 315. end; 316. until Swapped = False; 317. end; 318. 319. procedure DisplayTopScores(TopScores : TTopScores); 320. //Displays the top scores achieved in the game 321. var 322. Count : integer; //Stores number in loop sequience 323. begin 324. Writeln('The current top scores are: '); //Displays the current top scores 325. Writeln; 326. 327. //Writes the score position, name and score achieved 328. for Count := 1 to MaxSize do 329. Writeln(TopScores[Count].Name, ' ', TopScores[Count].Score); 330. 331. Writeln; 332. Writeln('Press the Enter key to return to the main menu'); 333. Readln; 334. end; 335. 336. procedure LoadTopScores(var TopScores : TTopScores); //Dont attempt 337. 338. var 339. Count : integer; 340. Count2 : integer; 341. LineFromFile : string; //Stores line of text file 342. ValuesOnLine : array[1..2] of string; //Array of high score name + position 343. CurrentFile : text; //Stores the name of the top scores file 344. begin 345. Assign(CurrentFile, 'HiScores.txt'); 346. Reset(CurrentFile); 347. 348. for Count := 1 to MaxSize do 349. begin 350. ValuesOnLine[1] := ''; 351. ValuesOnLine[2] := ''; 352. Readln(CurrentFile, LineFromFile); 353. Count2 := 1; 354. 355. repeat 356. ValuesOnLine[1] := ValuesOnLine[1] + LineFromFile[Count2]; 357. Count2 := Count2 + 1; 358. until LineFromFile[Count2] = ','; 359. 360. Count2 := Count2 + 1; 361. 362. repeat 363. ValuesOnLine[2] := ValuesOnLine[2] + LineFromFile[Count2]; 364. Count2 := Count2 + 1; 365. until Count2 > Length(LineFromFile);
366.

367.
TopScores[Count].Name := ValuesOnLine[1];
368.
TopScores[Count].Score := StrToInt(ValuesOnLine[2]);
369.
end;
370.

371.
Close(CurrentFile);
372.
end;
373.

374.
procedure PlayDiceGame(PlayerOneName, PlayerTwoName : string; //Dont attempt
375.
VirtualDiceGame : Boolean; var TopScores : TTopScores);
376.

377.
var
378.
PlayerOut : Boolean; //Stores whether the player is out or not
379.
CurrentPlayerScore : integer; //Stores the current players score
380.
AppealDieResult : integer; //Stores the result of appeal die roll
381.
PlayerNo : integer; //Used to control selected player
382.
PlayerOneScore : integer; //Stores player one's score
383.
PlayerTwoScore : integer; //Stores player two's score
384.
BowlDieResult : integer; //Stores result of the bowl die
385.
RunsScored : integer; //Stores the score of runs during the game
386.
begin
387.
for PlayerNo := 1 to 2 do
388.
begin
389.
CurrentPlayerScore := 0;
390.
PlayerOut := False;
391.

392.
if PlayerNo = 1 then
393.
Writeln(PlayerOneName, ' is batting')
394.
else
395.
Writeln(PlayerTwoName, ' is batting');
396.

397.
Writeln;
398.
Writeln('Press the Enter key to continue');
399.
Readln;
400.

401.
repeat
402.
BowlDieResult := RollBowlDie(VirtualDiceGame);
403.

404.
if BowlDieResult in [1..4] then
405.
begin
406.
RunsScored := CalculateRunsScored(BowlDieResult);
407.
DisplayRunsScored(RunsScored);
408.
CurrentPlayerScore := CurrentPlayerScore + RunsScored;
409.
Writeln('Your new score is: ', CurrentPlayerScore);
410.
end;
411.

412.
if BowlDieResult = 5 then
413.
Writeln('No runs scored this time. Your score is still: ',
414.
CurrentPlayerScore);
415.

416.
if BowlDieResult = 6 then
417.
begin
418.
Writeln('This could be out... press the Enter key to find out.');
419.
Readln;
420.
AppealDieResult := RollAppealDie(VirtualDiceGame);
421.
DisplayAppealDieResult(AppealDieResult);
422.

423.
if AppealDieResult >= 2 then
424.
PlayerOut := True
425.
else
426.
PlayerOut := False;
427.
end;
428.

429.
Writeln;
430.
Writeln('Press the Enter key to continue');
431.
Readln;
432.
until PlayerOut;
433.

434.
Writeln('You are out. Your final score was: ', CurrentPlayerScore);
435.
Writeln;
436.
Writeln('Press the Enter key to continue');
437.
Readln;
438.

439.
if PlayerNo = 1 then
440.
PlayerOneScore := CurrentPlayerScore
441.
else
442.
PlayerTwoScore := CurrentPlayerScore;
443.
end;
444.

445.
DisplayResult(PlayerOneName, PlayerOneScore, PlayerTwoName, PlayerTwoScore);
446.

447.
if (PlayerOneScore >= PlayerTwoScore) then
448.
begin
449.
UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
450.
UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
451.
end else
452.
begin
453.
UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
454.
UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
455.
end;
456.

457.
Writeln;
458.
Writeln('Press the Enter key to continue');
459.
Readln;
460.
end;
461.

462.
begin
463.
Randomize;
464.
ResetTopScores(TopScores);
465.

466.
repeat
467.
Write('What is player one''s name? '); //Asks player one for thier name
468.
PlayerOneName := GetValidPlayerName; //Checks the name is valid
469.
Write('What is player two''s name? '); //Asks player two for thier name
470.
PlayerTwoName := GetValidPlayerName; //Checks the name is valid
471.

472.
if PlayerOneName = PlayerTwoName then //Checks the names are not the same
473.
WriteLn('Player One and Player Two cannot share names!');
474.
until PlayerOneName <> PlayerTwoName;
475.

476.
repeat //Displays menu and repeats until an option between 1 and 9 is entered
477.
repeat
478.
DisplayMenu;
479.
OptionSelected := GetMenuChoice;
480.
until OptionSelected in [1..9];
481.
Writeln;
482.

483.
//Assigns a procedure or function to each number inputted
484.
if OptionSelected in [1..7] then
485.
case OptionSelected of
486.
1 : PlayDiceGame(PlayerOneName, PlayerTwoName, True, TopScores);
487.
2 : PlayDiceGame(PlayerOneName, PlayerTwoName, False, TopScores);
488.
3 : LoadTopScores(TopScores);
489.
4 : DisplayTopScores(TopScores);
490.
5 : SortTopScores (TopScores);
491.
6 : SaveTopScores (TopScores);
492.
7 : ResetTopScores (TopScores)
493.
end;
494.
until OptionSelected = 9;
495.
end.