home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / COIN10.ZIP / COIN-2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-26  |  5.6 KB  |  193 lines
  1. PROGRAM          COINS_PROGRAM;
  2. (*************************************************************************)
  3. (*************************************************************************)
  4. (**                            Microcomputer Application and Design I   **)
  5. (**                            Section 1                                **)
  6. (**                            Assignment 5                             **)
  7. (*************************************************************************)
  8. (****                                                                  ***)
  9. (****   This Program Will Simulate a coin toss twenty times and count  ***)
  10. (****       the number of heads and the number of tails thrown.        ***)
  11. (****                                                                  ***)
  12. (*************************************************************************)
  13. (*************************************************************************)
  14.  
  15. Uses Crt;
  16. Var
  17.    QuitFlag           : Boolean;
  18.    HeadsCount,
  19.    TailsCount,
  20.    Ran_Seed,
  21.    Count              : Integer;
  22.    Number             : Real;
  23.  
  24.  
  25. (******************************************************)
  26. (*                  Quit  Procedure                   *)
  27. (******************************************************)
  28. (*      This Procedure Procedure will display the     *)
  29. (*              Quit or continue option.              *)
  30. (******************************************************)
  31. PROCEDURE QuitProc(Var QuitFlag: Boolean);
  32.  
  33. Var
  34.    P    : Char;
  35.  
  36. Begin
  37.    WriteLn;
  38.    WriteLn;
  39.    WriteLn;
  40.    TextColor(LightBlue);
  41.    Write('       Please enter ');
  42.    TextColor(LightRed + Blink);
  43.    Write('Q');
  44.    TextColor(LightBlue);
  45.    Write(' to quit or ');
  46.    TextColor(Red + Blink);
  47.    Write('<Enter>');
  48.    TextColor(LightBlue);
  49.    Write(' to continue:  ');
  50.    Read(p);
  51.    TextColor(LightBlue);
  52.  
  53.    P := UpCase(P);
  54.  
  55.    If (P = 'Q') Then
  56.       QuitFlag := True
  57.    Else
  58.       QuitFlag := False;
  59. End;
  60.  
  61. (******************************************************)
  62. (*             Title Screen Procedure                 *)          
  63. (******************************************************)
  64. (*       This Procedure Prints The Title Screen.      *)
  65. (******************************************************)
  66. PROCEDURE TitleScreen(Var QuitFlag:Boolean);
  67.    
  68. Begin
  69.    ClrScr;
  70.    TextColor(Cyan);
  71.    WriteLn;
  72.    WriteLn('   Programmer: C. Ben Davis');
  73.    WriteLn('   SS#         361-52-5415');
  74.    WriteLn('   Class:      ACS 255');
  75.    TextColor(LightBlue);
  76.    WriteLn;
  77.    WriteLn;
  78.    WriteLn('          This program will simulate a coin toss twenty times, and');
  79.    WriteLn('       count the number of heads and the numbers of tails thrown.');
  80.    WriteLn;
  81.    WriteLn;
  82.    WriteLn;
  83. End;
  84.  
  85. (******************************************************)
  86. (*              Print Graph Procedure                 *)          
  87. (******************************************************)
  88. (*  This Procedure Prints the graph to the screen.    *)
  89. (******************************************************)
  90. PROCEDURE PrintGraph;
  91.  
  92. Begin
  93.   WriteLn;
  94.   WriteLn;
  95.   WriteLn;
  96.   WriteLn;
  97.   TextColor(LightBlue);
  98.   Write('HEADS:  ');
  99.   TextColor(DarkGray);
  100.  
  101.   While HeadsCount > 0 Do
  102.   Begin
  103.      Write('▓');
  104.      HeadsCount := HeadsCount - 1
  105.   End;
  106.  
  107.   TextColor(LightBlue);
  108.   WriteLn;
  109.   WriteLn;
  110.   Write('TAILS:  ');
  111.   TextColor(LightGray);
  112.  
  113.   While TailsCount > 0 Do
  114.   Begin
  115.      Write('▒');
  116.      TailsCount := TailsCount - 1
  117.   End;
  118.   TextColor(LightGreen);
  119.  
  120. End;
  121.  
  122. (******************************************************)
  123. (*                Flip Coin Procedure                 *)          
  124. (******************************************************)
  125. (*                                                    *)
  126. (*  This Procedure Procedure flips the coin 20 times. *)
  127. (*                                                    *)
  128. (******************************************************)
  129. PROCEDURE FlipCoin(var QuitFlag:Boolean;Ran_Seed:Integer);
  130.  
  131. Begin
  132.    HeadsCount := 0;
  133.    TailsCount := 0;
  134.    Count := 0;
  135.    Randomize;
  136.    RandSeed := Ran_Seed;
  137.    While (Count < 20) do
  138.       Begin
  139.          Number := Random;
  140.          If (Number < 1/2) or (Number = 1/2) Then
  141.             TailsCount := TailsCount +1                  {Writeln ('  Tails')}
  142.          Else
  143.            If Number > 1/2 Then
  144.               HeadsCount := HeadsCount + 1                {Writeln('  Heads')}
  145.            Else
  146.          If Number > 1 Then
  147.             Writeln( ' ERROR');
  148.          Count := Count +1;
  149.       End;
  150.       WriteLn;
  151.       WriteLn;
  152.       TextColor(White);
  153.       WriteLn('Number of Tails Thrown:  ',TailsCount);
  154.       WriteLn('Number of Heads Thrown:  ',HeadsCount);
  155.      PrintGraph;
  156.  
  157.    QuitProc(QuitFlag);
  158. End;
  159.  
  160. (****************************************************************************)
  161. (*                              MAIN PROCEDURE                              *)
  162. (****************************************************************************)
  163.  
  164. Begin
  165.    QuitFlag := False;
  166.    TitleScreen(QuitFlag);
  167.    QuitProc(QuitFlag);
  168.  
  169.  
  170.    While (QuitFlag = False) Do
  171.       Begin
  172.          Clrscr;
  173.          TextColor(LightGray);
  174.          Write('Enter a Number Between 1 and 100:  ');
  175.          Readln(Ran_Seed);
  176.          If Ran_Seed > 100 then
  177.             Begin
  178.                TextColor(Yellow);
  179.                WriteLn('   Please Choose A Number Less than or equal to 100!');
  180.                Readln;
  181.             End
  182.          Else
  183.             FlipCoin(QuitFlag,Ran_Seed);
  184.       End;
  185.  
  186.    ClrScr;
  187.    Writeln;
  188.    WriteLn;
  189.    WriteLn;
  190.    TextColor (LightGray);
  191.    Write ('  Give Me an A+!!!!');
  192. End.
  193.