home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / lang / mod2.hqx / m2-2.pit / PiRandom.MOD < prev   
Encoding:
Text File  |  1985-04-22  |  3.5 KB  |  143 lines
  1. MODULE PiRandom;
  2. (* schiesse in ein Quadrat, und bestimme damit auch einen Nèherungswert
  3.    fƒr Pi.    22.4.85 P. Fink *)
  4.    
  5. FROM Terminal IMPORT Write, WriteString, WriteLn, GotoXY,
  6.        BusyRead, ClearTerminal, Read;
  7. FROM RealTerminal IMPORT WriteR, RFixed;
  8.        
  9. FROM MathLib1  IMPORT random;
  10.  
  11. FROM QuickDraw IMPORT TextFont, TextSize;
  12. FROM QuickDraw IMPORT MoveTo, LineTo, ShowPen, HidePen, PenSize;
  13.  
  14.  
  15. (* Bildschirm Layout *)
  16.  
  17. CONST
  18.   vTitel = 20;
  19.   hTitel = 30;
  20.   vPi = 300;
  21.   htot = 30; htot1 = 100;
  22.   himk = 175; himk1 = 235;
  23.   hpi = 310; hpi1 = 370;
  24.   vPrompt = 310;
  25.   hPrompt = 0;
  26.   
  27.   hQuadrat = 120; vQuadrat = 260;
  28.   lQuadrat = 200;    (* GrÜsse 200 * 200 Pixel *)
  29.   lExtra = 20;
  30.   
  31. VAR
  32.   Total, ImKreis, Pi: REAL;
  33.   TotalMod  : CARDINAL;   (* =Total MOD 10, fƒr Anzeigefrequenz *)
  34.   ch        : CHAR;
  35.   PromptFlag: BOOLEAN;
  36.   
  37.  
  38. PROCEDURE Strecke (hx, vx, hl, vl: INTEGER);
  39. BEGIN
  40.   MoveTo (hx, vx); LineTo (hx+hl, vx+vl);
  41. END Strecke;
  42.  
  43. PROCEDURE Punkt (h,v: INTEGER);
  44. BEGIN
  45.   MoveTo (h,v); LineTo (h,v)
  46. END Punkt;
  47.  
  48.  
  49. PROCEDURE Rahmen;
  50. BEGIN
  51.   ClearTerminal;
  52.   PenSize (2,2);
  53.   Strecke (hQuadrat, vQuadrat, lQuadrat+lExtra, 0);
  54.   Strecke (hQuadrat, vQuadrat, 0, -lQuadrat-lExtra);
  55.   Strecke (hQuadrat+lQuadrat, vQuadrat,0, -lQuadrat);
  56.   Strecke (hQuadrat, vQuadrat-lQuadrat, lQuadrat, 0);
  57.   PenSize (1,1);
  58.   (* Kreis zeichnen: dummy *)
  59.   GotoXY (hTitel, vTitel);
  60.   WriteString ('Zufallstreffer in einem Quadrat         P. Fink, 22.4.85');
  61.   GotoXY(htot,vPi); WriteString ('Schuesse:');
  62.   GotoXY(himk,vPi);  WriteString ('im Kreis:');
  63.   GotoXY(hpi, vPi);  WriteString ('Pi .....:');
  64. END Rahmen;
  65.  
  66. PROCEDURE Schuss;
  67. VAR hr,vr: REAL;
  68.     h,v: INTEGER;
  69. BEGIN
  70.   hr := random();  vr := random();
  71.   h := INTEGER (TRUNC (hr*FLOAT(lQuadrat)+0.5) );
  72.   v := INTEGER (TRUNC (vr*FLOAT(lQuadrat)+0.5) );
  73.   Total:=Total+1.0;
  74.   TotalMod := (TotalMod+1) MOD 10;
  75.   IF (hr*hr+vr*vr)<=1.0 THEN (* im Kreis *)
  76.     ImKreis := ImKreis+1.0;
  77.     PenSize (2,2);
  78.   END;
  79.   Punkt (hQuadrat+h,vQuadrat-v);
  80.   PenSize (1,1)
  81. END Schuss;
  82.  
  83. PROCEDURE Anzeigen;
  84. BEGIN
  85.   IF Total=0.0 THEN Pi:=0.0 ELSE Pi:=4.0*(ImKreis/Total) END;
  86.   GotoXY(htot1, vPi);  WriteR (Total, 6,0,RFixed);
  87.   GotoXY(himk1, vPi);  WriteR (ImKreis,6,0,RFixed);
  88.   GotoXY(hpi1, vPi);   WriteR (Pi, 8,5,RFixed)
  89. END Anzeigen;
  90.  
  91. PROCEDURE ClearPromptLine;
  92. BEGIN
  93.   GotoXY (hPrompt, vPrompt); WriteLn;
  94.   WriteString ('       ');
  95. END ClearPromptLine;
  96.  
  97. PROCEDURE Prompt (VAR s: ARRAY OF CHAR);
  98. BEGIN
  99.   ClearPromptLine;
  100.   WriteString (s);
  101.   Read (ch); Write(ch);
  102.   ch := CAP (ch)
  103. END Prompt;
  104.  
  105. PROCEDURE Steuerung;
  106. BEGIN
  107.   LOOP
  108.     Total := 0.0; TotalMod := 0; ImKreis := 0.0;
  109.     ch := ' ';
  110.     Rahmen;
  111.     Anzeigen;
  112.     Prompt('Druecke eine Taste, um den Prozess zu beginnen (Q=aufhoeren):');
  113.     WHILE ch<>'Q' DO          (* Q von oben, oder von unten *)
  114.       IF PromptFlag THEN
  115.     ClearPromptLine;
  116.     WriteString ('Druecke eine Taste, um eine Pause zu machen');
  117.     PromptFlag := FALSE
  118.       END;
  119.       Schuss;
  120.       IF TotalMod = 0 THEN Anzeigen END;
  121.       BusyRead (ch);
  122.       IF ch<>0C THEN
  123.     Anzeigen;
  124.     Prompt ('Druecke eine Taste, um weiterzufahren (Q=abbrechen):');
  125.     PromptFlag := TRUE;
  126.       END
  127.     END (* while *);
  128.     Prompt ('Nochmals? (Q=nein):');
  129.     IF ch='Q' THEN EXIT END;
  130.   END (*loop*);
  131.   
  132. END Steuerung;
  133.  
  134.  
  135. BEGIN
  136.   WriteString ('Schriftart? ');  WriteLn;
  137.   WriteString ('   k = normal '); WriteLn;   (* Monaco 9 *)
  138.   WriteString ('   g = groesser '); WriteLn; (* Chicago 12 *)
  139.   WriteString ('Waehle bitte: ');
  140.   Read (ch); IF (ch='g') THEN TextFont(0); TextSize(12) END;
  141.   Steuerung
  142. END PiRandom.
  143.