home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / dicetest.mzd / DICETEST.MOD
Encoding:
Text File  |  1987-04-26  |  3.5 KB  |  155 lines
  1. MODULE DiceTest;  (* -- Test of dice rolling.   John W. Fort  24 Mar 87
  2.    I got a little suspicious when my game of Backgammon on a VIC-20 never
  3.    rolled me a double 4 (my favorite) in six months of play, so I checked out
  4.    the way the dice were rolled and found there were several other dice pairs
  5.    that would never occur in the first 100 rolls.  I may not be a hot shot,
  6.    but I want a fair chance!
  7. *)
  8. FROM InOut IMPORT WriteString, WriteReal, WriteLn, Write, WriteCard;
  9. FROM Terminal IMPORT ClearScreen, GotoXY, Highlight, Normal;
  10. FROM MathLib IMPORT Random;
  11. FROM Utility IMPORT AnyKeyMsg;    (* Appended to end of this file *)
  12.  
  13. CONST
  14.     COUNT = 200;
  15.  
  16. VAR
  17.     freq1, freq2 : ARRAY[0..5] OF CARDINAL;
  18.     freq3 : ARRAY[0..35] OF CARDINAL;
  19.     x, p, q : CARDINAL;
  20.     y1, y2 : CARDINAL;
  21.     f1, f2 : REAL;
  22.     ch : CHAR;
  23.  
  24. PROCEDURE Display1;
  25.  
  26. BEGIN
  27.     (* display p's *)
  28.     GotoXY(freq1[p]-1, p+6);
  29.     IF (freq1[p] MOD 10 # 0) THEN
  30.     Highlight;
  31.     Write('*');
  32.     Normal;
  33.     ELSE
  34.     Write('*');
  35.     END;
  36.     WriteCard(p+1,1);
  37.  
  38.     (* display q's *)
  39.     GotoXY(freq2[q]-1, q+14);
  40.     IF (freq2[q] MOD 10 # 0) THEN
  41.     Highlight;
  42.     Write('#');
  43.     Normal;
  44.     ELSE
  45.     Write('#');
  46.     END;
  47.     WriteCard(q+1,1);
  48. END Display1;
  49.  
  50.  
  51. PROCEDURE Display2();
  52.  
  53. VAR
  54.     x : CARDINAL;
  55.  
  56. BEGIN
  57.     FOR x := 0 TO 14 DO
  58.     GotoXY(18, 18-x);
  59.     WriteCard(x,2); WriteString('-');
  60.     END;
  61.     FOR x := 0 TO 35 DO
  62.     GotoXY(22+x, 18-freq3[x]);
  63.     Write('*');
  64.     END;
  65. END Display2;
  66.  
  67.  
  68. PROCEDURE RollDice() : CARDINAL;
  69.  
  70. VAR
  71.     rn : REAL;
  72.  
  73. BEGIN
  74.     rn := Random() * 6.0;
  75.     RETURN TRUNC(rn);
  76. END RollDice;
  77.  
  78.  
  79. BEGIN
  80.     ClearScreen;
  81.     GotoXY(29,3);
  82.     WriteString('Test of Dice Rolling');
  83.     AnyKeyMsg;
  84.     GotoXY(0, 5);  WriteString('First Die (p)');
  85.     GotoXY(0, 13); WriteString('Second Die (q)');
  86.     GotoXY(0, 21); WriteString('Count:');
  87.  
  88.     (* clear variables *)
  89.     FOR x := 0 TO 5 DO
  90.     freq1[x] := 0;  freq2[x] := 0;
  91.     END;
  92.     f1 := 0.0;  f2 := 0.0;
  93.  
  94.     (* Main loop *)
  95.     FOR x := 1 TO COUNT DO
  96.     p := RollDice();
  97.     f1 := f1 + FLOAT(p);
  98.     INC(freq1[p]);
  99.  
  100.     q := RollDice();
  101.     f2 := f2 + FLOAT(q);
  102.     INC(freq2[q]);
  103.  
  104.     INC(freq3[p + q * 6]);
  105.     Display1;
  106.     GotoXY(7,21); WriteCard(x,3);
  107.     END;
  108.     GotoXY(20,5);  WriteString('Bias: ');
  109.     WriteReal(f1 / 5.0 / FLOAT(COUNT), 4,2);
  110.     GotoXY(20,13); WriteString('Bias: ');
  111.     WriteReal(f2 / 5.0 / FLOAT(COUNT), 4,2);
  112.     AnyKeyMsg;
  113.     ClearScreen;
  114.     GotoXY(29, 3);
  115.     WriteString('Incidence of p + q roll');
  116.     GotoXY(19,19);  WriteString('p: ');
  117.     FOR x := 1 TO 6 DO
  118.         WriteString('123456');
  119.     END;
  120.     GotoXY(19,20);  WriteString('q: ');
  121.     WriteString('111111222222333333444444555555666666');
  122.     GotoXY(10,22);
  123.     WriteString('Total pairs rolled: ');
  124.     WriteCard(COUNT,3);
  125.     WriteString('        Nominal incidence: ');
  126.     WriteReal(FLOAT(COUNT) / 36.0, 2,2);
  127.     Display2;
  128.     AnyKeyMsg;
  129. END DiceTest.
  130.  
  131. ============== Edit here ======================================================
  132.  
  133. Part of my UTILITY module
  134.  
  135.     PROCEDURE AnyKeyMsg;
  136.     (* Wait for user response, then seed random number generator *)
  137.  
  138.     VAR
  139.     seed : CARDINAL;
  140.     ch : CHAR;
  141.     BEGIN
  142.     GotoXY(10, 23);  WriteString('Press any key to continue: ');
  143.     seed := 1;
  144.     BusyRead(ch);
  145.     WHILE ch = 0C DO
  146.         INC(seed);
  147.         BusyRead(ch);
  148.     END;
  149.     Randomize(seed);
  150.     GotoXY(0, 23);  ClearToEOL;
  151.     END AnyKeyMsg;
  152.  
  153. ==============================================================================
  154. XY(0, 23);  ClearToEOL;
  155.     END AnyKe