home *** CD-ROM | disk | FTP | other *** search
/ AMIGA PD 1 / AMIGA-PD-1.iso / Programme_zum_Heft / Programmieren / Kurztests / PascalPCQ / Examples / Circle.p < prev    next >
Text File  |  1990-07-18  |  3KB  |  130 lines
  1. Program Circle;
  2.  
  3. {
  4.       This program just draws two simple circles.  The first is
  5.       drawn using PCQ's new (at the moment) sine and cosine
  6.       functions.  The second is drawn directly over the top with
  7.       the SPSin and SPCos functions from the mathtrans.library.
  8.  
  9.       I wrote this to determine whether the trig functions I had
  10.       just written were accurate enough to be worthwhile.  Since
  11.       these two circles come pretty close to overlapping, I
  12.       left them in.
  13.  
  14.       To run this program without the mathtrans.library, just
  15.       remove the MathTrans.i include, the open and close
  16.       of the library, and lines that draw the second circle.
  17.       That's all.
  18.  
  19.       Later Note: I replaced the older, less accurate functions
  20.       with more traditional series-based functions, which are
  21.       much more accurate and only a little slower.
  22. }
  23.  
  24. {$I "Include:Exec/Libraries.i"}
  25. {$I "Include:Exec/Interrupts.i"}
  26. {$I "Include:Exec/Ports.i"}
  27. {$I "Include:Intuition/Intuition.i"}
  28. {$I "Include:Graphics/Graphics.i"}
  29. {$I "Include:Graphics/Pens.i"}
  30. {$I "Include:Libraries/MathTrans.i"}
  31. {$I "Include:Utils/MathTransUtils.i"}
  32.  
  33. Const
  34.     Pi = 3.1415927;
  35.     TwoPi = Pi * 2.0;
  36.  
  37.     Aspect = 2.0;    { To account for pixel shape }
  38.  
  39. var
  40.     w  : WindowPtr;
  41.     m  : MessagePtr;
  42.  
  43. Function OpenTheWindow() : Boolean;
  44. var
  45.     nw : NewWindowPtr;
  46. begin
  47.     new(nw);
  48.     with nw^ do begin
  49.     LeftEdge := 0;
  50.     TopEdge := 0;
  51.     Width := 640;
  52.     Height := 200;
  53.  
  54.     DetailPen := -1;
  55.     BlockPen  := -1;
  56.     IDCMPFlags := CLOSEWINDOW_f;
  57.     Flags := WINDOWSIZING + WINDOWDRAG + WINDOWDEPTH +
  58.          WINDOWCLOSE + SMART_REFRESH + ACTIVATE;
  59.     FirstGadget := nil;
  60.     CheckMark := nil;
  61.     Title := "Horseshoes, handgrenades, and some trigonomentry";
  62.     Screen := Nil;
  63.     BitMap := nil;
  64.     MinWidth := 50;
  65.     MaxWidth := -1;
  66.     MinHeight := 20;
  67.     MaxHeight := -1;
  68.     WType := WBENCHSCREEN_f;
  69.     end;
  70.  
  71.     w := OpenWindow(nw);
  72.     dispose(nw);
  73.     OpenTheWindow := w <> nil;
  74. end;
  75.  
  76. Procedure DoCircle(RP : RastPortPtr; CX, CY, Radius : Short);
  77. {
  78.     Draw a circle using 500 line segments
  79. }
  80. Const
  81.     Division = TwoPi / 500.0;
  82. var
  83.     t : Real;
  84.     i : Integer;
  85.     RealRad : Real;
  86. begin
  87.     SetAPen(rp, 1);
  88.     RealRad := Float(Radius);
  89.     Move(rp, CX + Round(RealRad * Aspect), CY);
  90.     for i := 1 to 500 do
  91.     Draw(rp, CX + Round(Cos(Float(i) * Division) * RealRad * Aspect),
  92.          CY + round(Sin(Float(i) * Division) * RealRad));
  93.     Draw(rp, CX + Round(RealRad * Aspect), CY);
  94.     SetAPen(rp, 3);
  95.     Move(rp, CX + Round(RealRad * Aspect), CY);
  96.     for i := 1 to 500 do
  97.     Draw(rp, CX + Round(SPCos(Float(i) * Division) * RealRad * Aspect),
  98.          CY + round(SPSin(Float(i) * Division) * RealRad));
  99.     Draw(rp, CX + Round(RealRad * Aspect), CY);
  100. end;
  101.  
  102. begin
  103.     { Note that the startup code of all PCQ programs depends on
  104.       Intuition, so if we got to this point Intuition must be
  105.       open, so the run time library just uses the pointer that
  106.       the startup code created.  Same with DOS, although we don't
  107.       use that here. }
  108.  
  109.     GfxBase := OpenLibrary("graphics.library", 0);
  110.     if GfxBase <> nil then begin
  111.     if OpenMathTrans then begin
  112.         if OpenTheWindow() then begin
  113.         DoCircle(w^.RPort, 320, 105, 92);
  114.         m := WaitPort(w^.UserPort);
  115.         Forbid;
  116.         repeat
  117.             m := GetMsg(w^.UserPort);
  118.         until m = nil;
  119.         CloseWindow(w);
  120.         Permit;
  121.         end else
  122.         writeln('Could not open the window');
  123.         CloseMathTrans;
  124.     end else
  125.         Writeln('Could not open math library');
  126.     CloseLibrary(GfxBase);
  127.     end else
  128.     Writeln('Could not open graphics.library');
  129. end.
  130.