home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Pascal / Snippets / Approximate Pi / Pi.p < prev   
Encoding:
Text File  |  1995-10-12  |  3.2 KB  |  142 lines  |  [TEXT/MMCC]
  1. {----------------------------------------------------------
  2.  
  3. Pascal source code for a program which calculates the value of Pi.  
  4.  
  5. This program uses 80-bit number crunching to approximate values for pi. 
  6. It also uses number tables to format the 80-bit number for output.
  7.  
  8. This program was originally posted in C (author unknown), and I've
  9. translated it into Pascal.  Error handling for formatting the number has
  10. been added to display error messages instead of a number if there are
  11. problems during formatting.
  12.  
  13. This program demos simple uses of the following toolbox calls:
  14.  
  15. GetIntlResourceTable
  16. BlockMove
  17. StringToFormatRec
  18.  
  19.     10/7/95 - Bill Catambay, catambay@aol.com
  20. ----------------------------------------------------------}
  21.  
  22. Program Pi;
  23.  
  24. Uses
  25.     fp, IntlResources, TextUtils, Fonts, Windows, Menus, Dialogs;
  26.     
  27. Function Ipow(x:    extended80;  y:    longint): extended80;
  28.  
  29. { ipow returns an 80-bit floating point number raised to the power of a positive integer. }
  30.  
  31. Var
  32.     result: extended80;
  33.     i: longint;
  34.     
  35.     begin
  36.     result := 1;
  37.     for i := 1 to y do
  38.         result := result * x;
  39.     Ipow := result;        
  40.     end;
  41.  
  42. Function ApproxPi(iterations:    longint): extended80;
  43.  
  44. { ApproxPi returns an 80-bit approximation of π. }
  45.  
  46. Var
  47.     y,a,temp: extended80;
  48.     i: longint;
  49.     
  50.     begin
  51.     y := sqrt(2) - 1;
  52.     a := 6 - 4 * sqrt(2);
  53.     for i := 1 to iterations do
  54.         begin
  55.         temp := sqrt(sqrt(1 - ipow(y, 4)));
  56.         y := (1 - temp) / (1 + temp);
  57.         a := ipow(1 + y, 4) * a + ipow(-2.0, 2 * (i - 1) + 3) * y * (1 + y + y * y);
  58.         end;
  59.     ApproxPi := 1/a;
  60.     end;
  61.  
  62. Function FormatExtended(x: extended80; formatStr: str255): str255;
  63.  
  64. Var
  65.     itlHandle: Handle;
  66.     offset,length: longint;
  67.     partsTable: NumberParts;
  68.     outString: NumFormatString;
  69.     status: FormatStatus;
  70.     displayStr: Str255;
  71.  
  72.     begin
  73.     GetIntlResourceTable(smCurrentScript, smNumberPartsTable, itlHandle, offset, length);
  74.     if itlHandle <> NIL then
  75.         begin
  76.         BlockMove(Ptr(ord4(itlHandle^) + offset), @partsTable, length);
  77.         status := StringToFormatRec(formatStr, partsTable, outString);
  78.         if status <> NoErr then
  79.             begin
  80.             FormatExtended := 'FORMAT ERROR';
  81.             exit(FormatExtended);
  82.             end;
  83.         status := extendedToString(x, outString, partsTable, displayStr);
  84.         if status = NoErr then
  85.             FormatExtended := displayStr
  86.         else
  87.             FormatExtended := 'CONVERSION ERROR';
  88.         end
  89.     else
  90.         FormatExtended := 'TABLE ERROR';
  91.     end;
  92.     
  93. Procedure DrawPi(pi:    extended80);
  94.  
  95. Const
  96.     formatStr = '#.#################';
  97.     
  98.     begin
  99.     Drawstring('π ≈ ');
  100.     Drawstring(FormatExtended(pi,formatStr));
  101.     end;
  102.  
  103. Var
  104.     window: WindowPtr;
  105.     windowRect: Rect;
  106.     pi: extended80;
  107.     
  108. begin
  109. MaxApplZone;
  110. InitGraf(@qd.thePort);
  111. InitFonts;
  112. InitWindows;
  113. InitMenus;
  114. TEInit;
  115. InitDialogs(nil);
  116. SetRect(windowRect, 50, 70, 350, 220);
  117. window := NewWindow(nil, windowRect, '', true, dBoxProc, WindowPtr(-1), false, 0);
  118. if window <> NIL then
  119.     begin
  120.     SetPort(window);
  121.     TextFont(monaco);
  122.     TextSize(9);
  123.     pi := ApproxPi(0);
  124.     MoveTo(12, 24);
  125.     drawstring('Initial value:         ');
  126.     DrawPi(pi);
  127.     pi := ApproxPi(1);
  128.     MoveTo(12, 36);
  129.     drawstring('First iteration:       ');
  130.     DrawPi(pi);
  131.     pi := ApproxPi(2);
  132.     MoveTo(12, 48);
  133.     drawstring('Second iteration:      ');
  134.     DrawPi(pi);
  135.     if Button then
  136.         repeat until not Button;
  137.     repeat until Button;
  138.     repeat until not Button;
  139.     FlushEvents(everyEvent, 0);
  140.     DisposeWindow(window);
  141.     end;
  142. end.