SHARE
TWEET

Untitled

a guest Aug 12th, 2017 50 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Program DiceCricket;
  2.  
  3.  
  4. {Skeleton Program code for the AQA COMP1 Summer 2011 examination
  5. this code should be used in conjunction with the Preliminary Material
  6. written by the AQA COMP1 Programmer Team developed in the
  7. Free Pascal IDE for Win32 v1.0.10 programming environment}
  8.  
  9. {Centres using Delphi should add the compiler directive that sets
  10. the application type to Console (other centres can ignore this
  11. comment).  Centres may also add the SysUtils library if their
  12. version of Pascal uses this}
  13.  
  14. {Permission to make these changes to the Skeleton Program does not
  15. need to be obtained from AQA/AQA Programmer - just remove the \ symbol from
  16. the next line of code  and remove the braces around Uses SysUtils;}
  17.  
  18. {\$APPTYPE CONSOLE}
  19.  
  20. Uses WinCrt;
  21.  
  22. Const MaxSize = 4;
  23.  
  24. Type TTopScore = Record
  25.                    Name : String;
  26.                    Score : Integer;
  27.                  End;
  28.  
  29.      TTopScores = Array[1..MaxSize] Of TTopScore;
  30.  
  31. Var
  32.   TopScores : TTopScores;
  33.   PlayerOneName : String;
  34.   PlayerTwoName : String;
  35.   OptionSelected : Integer;
  36.  
  37. Procedure ResetTopScores(Var TopScores : TTopScores);
  38.   Var
  39.     Count : Integer;
  40.   Begin
  41.     For Count := 1 To MaxSize
  42.       Do
  43.         Begin
  44.           TopScores[Count].Name := '-';
  45.           TopScores[Count].Score := 0;
  46.         End;
  47.   End;
  48.  
  49. Function GetValidPlayerName : String;
  50.   Var
  51.     PlayerName : String;
  52.   Begin
  53.     Repeat
  54.       Readln(PlayerName);
  55.       If PlayerName = ''
  56.         Then Write('That was not a valid name.  Please try again: ');
  57.     Until PlayerName <> '';
  58.     GetValidPlayerName := PlayerName;
  59.   End;
  60.  
  61. Procedure DisplayMenu;
  62.   Begin
  63.     Writeln;
  64.     Writeln('Dice Cricket');
  65.     Writeln;
  66.     Writeln('1.  Play game version with virtual dice');
  67.     Writeln('2.  Play game version with real dice');
  68.     Writeln('3.  Load top scores');
  69.     Writeln('4.  Display top scores');
  70.     Writeln('5.  Reset high scores');
  71.     Writeln('9.  Quit');
  72.     Writeln;
  73.   End;
  74.  
  75. Function GetMenuChoice : Integer;
  76.   Var
  77.     OptionChosen : Integer;
  78.   Begin
  79.     Write('Please enter your choice: ');
  80.     Readln(OptionChosen);
  81.     If (OptionChosen < 1) Or ((OptionChosen > 5) And (OptionChosen <> 9))
  82.       Then
  83.         Begin
  84.           Writeln;
  85.           Writeln('That was not one of the allowed options.  Please try again: ');
  86.         End;
  87.     GetMenuChoice := OptionChosen;
  88.   End;
  89.  
  90. Function RollBowlDie(VirtualDiceGame : Boolean) : Integer;
  91.   Var
  92.     BowlDieResult : Integer;
  93.   Begin
  94.     If VirtualDiceGame
  95.       Then BowlDieResult := Random(6) + 1
  96.       Else
  97.         Begin
  98.           Writeln('Please roll the bowling die and then enter your result.');
  99.           Writeln;
  100.           Writeln('Enter 1 if the result is a 1');
  101.           Writeln('Enter 2 if the result is a 2');
  102.           Writeln('Enter 3 if the result is a 4');
  103.           Writeln('Enter 4 if the result is a 6');
  104.           Writeln('Enter 5 if the result is a 0');
  105.           Writeln('Enter 6 if the result is OUT');
  106.           Writeln;
  107.           Write('Result: ');
  108.           Readln(BowlDieResult);
  109.           Writeln;
  110.         End;
  111.     RollBowlDie := BowlDieResult;
  112.   End;
  113.  
  114. Function CalculateRunsScored(BowlDieResult : Integer) : Integer;
  115.   Var
  116.     RunsScored : Integer;
  117.   Begin
  118.     Case BowlDieResult Of
  119.       1 : RunsScored := 1;
  120.       2 : RunsScored := 2;
  121.       3 : RunsScored := 4;
  122.       4 : RunsScored := 6;
  123.       5, 6 : RunsScored := 0;
  124.     End;
  125.     CalculateRunsScored := RunsScored;
  126.   End;
  127.  
  128. Procedure DisplayRunsScored(RunsScored : Integer);
  129.   Begin
  130.     Case RunsScored Of
  131.       1 : Writeln('You got one run!');
  132.       2 : Writeln('You got two runs!');
  133.       4 : Writeln('You got four runs!');
  134.       6 : Writeln('You got six runs!');
  135.     End;
  136.   End;
  137.  
  138. Procedure DisplayCurrentPlayerNewScore(CurrentPlayerScore : Integer);
  139.   Begin
  140.     Writeln('Your new score is: ', CurrentPlayerScore);
  141.   End;
  142.  
  143. Function RollAppealDie(VirtualDiceGame : Boolean) : Integer;
  144.   Var
  145.     AppealDieResult : Integer;
  146.   Begin
  147.     If VirtualDiceGame
  148.       Then AppealDieResult := Random(4) + 1
  149.       Else
  150.         Begin
  151.           Writeln('Please roll the appeal die and then enter your result.');
  152.           Writeln;
  153.           Writeln('Enter 1 if the result is NOT OUT');
  154.           Writeln('Enter 2 if the result is CAUGHT');
  155.           Writeln('Enter 3 if the result is LBW');
  156.           Writeln('Enter 4 if the result is BOWLED');
  157.           Writeln;
  158.           Write('Result: ');
  159.           Readln(AppealDieResult);
  160.           Writeln;
  161.         End;
  162.     RollAppealDie := AppealDieResult;
  163.   End;
  164.  
  165. Procedure DisplayAppealDieResult(AppealDieResult : Integer);
  166.   Begin
  167.     Case AppealDieResult Of
  168.       1 : Writeln('Not out!');
  169.       2 : Writeln('Caught!');
  170.       3 : Writeln('LBW!');
  171.       4 : Writeln('Bowled!');
  172.     End;
  173.   End;
  174.  
  175. Procedure DisplayResult(PlayerOneName : String; PlayerOneScore : Integer;
  176.                         PlayerTwoName : String; PlayerTwoScore : Integer);
  177.   Begin
  178.     Writeln;
  179.     Writeln(PlayerOneName, ' your score was: ', PlayerOneScore);
  180.     Writeln(PlayerTwoName, ' your score was: ', PlayerTwoScore);
  181.     Writeln;
  182.     If PlayerOneScore > PlayerTwoScore
  183.       Then Writeln(PlayerOneName, ' wins!');
  184.     If PlayerTwoScore > PlayerOneScore
  185.       Then Writeln(PlayerTwoName, ' wins!');
  186.     Writeln;
  187.   End;
  188.  
  189. Procedure UpdateTopScores(Var TopScores : TTopScores; PlayerName : String;
  190.                               PlayerScore : Integer);
  191.   Var
  192.     LowestCurrentTopScore : Integer;
  193.     PositionOfLowestCurrentTopScore : Integer;
  194.     Count : Integer;
  195.   Begin
  196.     LowestCurrentTopScore := TopScores[1].Score;
  197.     PositionOfLowestCurrentTopScore := 1;
  198.     {Find the lowest of the current top scores}
  199.     For Count := 2 To MaxSize
  200.       Do
  201.         If TopScores[Count].Score < LowestCurrentTopScore
  202.           Then
  203.             Begin
  204.               LowestCurrentTopScore := TopScores[Count].Score;
  205.               PositionOfLowestCurrentTopScore := Count;
  206.             End;
  207.     If PlayerScore > LowestCurrentTopScore
  208.       Then
  209.         Begin
  210.           TopScores[PositionOfLowestCurrentTopScore].Score := PlayerScore;
  211.           TopScores[PositionOfLowestCurrentTopScore].Name := PlayerName;
  212.           Writeln('Well done ', PlayerName, ' you have one of the top scores!');
  213.         End;
  214.   End;
  215.  
  216. Procedure DisplayTopScores(TopScores : TTopScores);
  217.   Var
  218.     Count : Integer;
  219.   Begin
  220.     Writeln('The current top scores are: ');
  221.     Writeln;
  222.     For Count := 1 To MaxSize
  223.       Do Writeln(TopScores[Count].Name, ' ', TopScores[Count].Score);
  224.     Writeln;
  225.     Writeln('Press the Enter key to return to the main menu');
  226.     Readln;
  227.   End;
  228.  
  229. Procedure LoadTopScores(Var TopScores : TTopScores);
  230.   {Centres using older versions of Pascal might need to delete the line that
  231.    uses StrToInt and use the two alternative lines in braces.  Permission to
  232.    make these changes does not need to be obtained from AQA/AQA Programmer.}
  233.   Var
  234.     Count : Integer;
  235.     Count2 : Integer;
  236.     Err : Integer;
  237.     LineFromFile : String;
  238.     ValuesOnLine : Array[1..2] Of String;
  239.     CurrentFile : Text;
  240.   Begin
  241.     Assign(CurrentFile, 'C:\HiScores.txt');
  242.     Reset(CurrentFile);
  243.     For Count := 1 To MaxSize
  244.       Do
  245.         Begin
  246.           ValuesOnLine[1] := '';
  247.           ValuesOnLine[2] := '';
  248.           Readln(CurrentFile, LineFromFile);
  249.           Count2 := 1;
  250.           Repeat
  251.             ValuesOnLine[1] := ValuesOnLine[1] + LineFromFile[Count2];
  252.             Count2 := Count2 + 1;
  253.           Until LineFromFile[Count2] = ',';
  254.           Count2 := Count2 + 1;
  255.           Repeat
  256.             ValuesOnLine[2] := ValuesOnLine[2] + LineFromFile[Count2];
  257.             Count2 := Count2 + 1;
  258.           Until Count2 > Length(LineFromFile);
  259.           TopScores[Count].Name := ValuesOnLine[1];
  260.           Val(ValuesOnLine[2],TopScores[Count].Score, Err);
  261.         End;
  262.     Close(CurrentFile);
  263.   End;
  264.  
  265. Procedure PlayDiceGame(PlayerOneName, PlayerTwoName : String;
  266.                        VirtualDiceGame : Boolean; Var TopScores : TTopScores);
  267.   Var
  268.     PlayerOut : Boolean;
  269.     CurrentPlayerScore : Integer;
  270.     AppealDieResult : Integer;
  271.     PlayerNo : Integer;
  272.     PlayerOneScore : Integer;
  273.     PlayerTwoScore : Integer;
  274.     BowlDieResult : Integer;
  275.     RunsScored : Integer;
  276.   Begin
  277.     For PlayerNo := 1 To 2
  278.       Do
  279.         Begin
  280.           CurrentPlayerScore := 0;
  281.           PlayerOut := False;
  282.           If PlayerNo = 1
  283.             Then Writeln(PlayerOneName, ' is batting')
  284.             Else Writeln(PlayerTwoName, ' is batting');
  285.           Writeln;
  286.           Writeln('Press the Enter key to continue');
  287.           Readln;
  288.           Repeat
  289.             BowlDieResult := RollBowlDie(VirtualDiceGame);
  290.             If BowlDieResult In [1..4]
  291.               Then
  292.                 Begin
  293.                   RunsScored := CalculateRunsScored(BowlDieResult);
  294.                   DisplayRunsScored(RunsScored);
  295.                   CurrentPlayerScore := CurrentPlayerScore + RunsScored;
  296.                   Writeln('Your new score is: ', CurrentPlayerScore);
  297.                 End;
  298.             If BowlDieResult = 5
  299.               Then Writeln('No runs scored this time.  Your score is still: ',
  300.                           CurrentPlayerScore);
  301.             If BowlDieResult = 6
  302.               Then
  303.                 Begin
  304.                   Writeln('This could be out... press the Enter key to find out.');
  305.                   Readln;
  306.                   AppealDieResult := RollAppealDie(VirtualDiceGame);
  307.                   DisplayAppealDieResult(AppealDieResult);
  308.                   If AppealDieResult >= 2
  309.                     Then PlayerOut := True
  310.                     Else PlayerOut := False;
  311.                 End;
  312.             Writeln;
  313.             Writeln('Press the Enter key to continue');
  314.             Readln;
  315.           Until PlayerOut;
  316.           Writeln('You are out.  Your final score was: ', CurrentPlayerScore);
  317.           Writeln;
  318.           Writeln('Press the Enter key to continue');
  319.           Readln;
  320.           If PlayerNo = 1
  321.             Then PlayerOneScore := CurrentPlayerScore
  322.             Else PlayerTwoScore := CurrentPlayerScore;
  323.         End;
  324.     DisplayResult(PlayerOneName, PlayerOneScore, PlayerTwoName, PlayerTwoScore);
  325.     If (PlayerOneScore >= PlayerTwoScore)
  326.       Then
  327.         Begin
  328.           UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
  329.           UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
  330.         End
  331.       Else
  332.         Begin
  333.           UpdateTopScores(TopScores, PlayerTwoName, PlayerTwoScore);
  334.           UpdateTopScores(TopScores, PlayerOneName, PlayerOneScore);
  335.         End;
  336.     Writeln;
  337.     Writeln('Press the Enter key to continue');
  338.     Readln;
  339.   End;
  340.  
  341.  
  342. Begin
  343.   Randomize;
  344.   ResetTopScores(TopScores);
  345.   Write('What is player one''s name? ');
  346.   PlayerOneName := GetValidPlayerName;
  347.   Write('What is player two''s name? ');
  348.   PlayerTwoName := GetValidPlayerName;
  349.   Repeat
  350.     Repeat
  351.       DisplayMenu;
  352.       OptionSelected := GetMenuChoice;
  353.     Until OptionSelected In [1..4, 9];
  354.     Writeln;
  355.     If OptionSelected In [1..4]
  356.       Then
  357.         Case OptionSelected Of
  358.           1 : PlayDiceGame(PlayerOneName, PlayerTwoName, True, TopScores);
  359.           2 : PlayDiceGame(PlayerOneName, PlayerTwoName, False, TopScores);
  360.           3 : LoadTopScores(TopScores);
  361.           4 : DisplayTopScores(TopScores);
  362.           5 : ResetTopScores(TopScores);
  363.         End;
  364.   Until OptionSelected = 9;
  365. End.
RAW Paste Data
Top