Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB39.ZIP/NEWSPIRO.PAS

Pascal/Delphi Source File | 1986-02-07 | 9.3 KB | 554 lines

Program Spiro;

            {  Place Cosine and Sine values in two arrays     }
            {  This way you can table lookup instead of       }
            {  calling a trig function.  It's a LOT FASTER!   }

const
CosArray: array[1..200] of real =
( 1.00000,
 0.99951,
 0.99803,
 0.99556,
 0.99211,
 0.98769,
 0.98229,
 0.97592,
 0.96858,
 0.96029,
 0.95106,
 0.94088,
 0.92978,
 0.91775,
 0.90483,
 0.89101,
 0.87631,
 0.86074,
 0.84433,
 0.82708,
 0.80902,
 0.79016,
 0.77051,
 0.75011,
 0.72897,
 0.70711,
 0.68455,
 0.66131,
 0.63742,
 0.61291,
 0.58779,
 0.56208,
 0.53583,
 0.50904,
 0.48175,
 0.45399,
 0.42578,
 0.39715,
 0.36813,
 0.33874,
 0.30902,
 0.27899,
 0.24869,
 0.21814,
 0.18738,
 0.15644,
 0.12533,
 0.09411,
 0.06279,
 0.03141,
 0.00000,
-0.03141,
-0.06279,
-0.09411,
-0.12533,
-0.15643,
-0.18738,
-0.21814,
-0.24869,
-0.27899,
-0.30902,
-0.33874,
-0.36812,
-0.39715,
-0.42578,
-0.45399,
-0.48175,
-0.50904,
-0.53583,
-0.56208,
-0.58778,
-0.61291,
-0.63742,
-0.66131,
-0.68455,
-0.70711,
-0.72897,
-0.75011,
-0.77051,
-0.79015,
-0.80902,
-0.82708,
-0.84433,
-0.86074,
-0.87631,
-0.89101,
-0.90483,
-0.91775,
-0.92978,
-0.94088,
-0.95106,
-0.96029,
-0.96858,
-0.97592,
-0.98229,
-0.98769,
-0.99211,
-0.99556,
-0.99803,
-0.99951,
-1.00000,
-0.99951,
-0.99803,
-0.99556,
-0.99212,
-0.98769,
-0.98229,
-0.97592,
-0.96858,
-0.96029,
-0.95106,
-0.94088,
-0.92978,
-0.91776,
-0.90483,
-0.89101,
-0.87631,
-0.86074,
-0.84433,
-0.82708,
-0.80902,
-0.79016,
-0.77052,
-0.75011,
-0.72897,
-0.70711,
-0.68455,
-0.66131,
-0.63743,
-0.61291,
-0.58779,
-0.56209,
-0.53583,
-0.50904,
-0.48176,
-0.45399,
-0.42578,
-0.39715,
-0.36813,
-0.33874,
-0.30902,
-0.27899,
-0.24869,
-0.21815,
-0.18739,
-0.15644,
-0.12534,
-0.09411,
-0.06279,
-0.03141,
 0.00000,
 0.03141,
 0.06279,
 0.09410,
 0.12533,
 0.15643,
 0.18738,
 0.21814,
 0.24869,
 0.27899,
 0.30901,
 0.33873,
 0.36812,
 0.39714,
 0.42578,
 0.45399,
 0.48175,
 0.50904,
 0.53582,
 0.56208,
 0.58778,
 0.61290,
 0.63742,
 0.66131,
 0.68454,
 0.70710,
 0.72897,
 0.75011,
 0.77051,
 0.79015,
 0.80901,
 0.82708,
 0.84433,
 0.86074,
 0.87630,
 0.89100,
 0.90482,
 0.91775,
 0.92977,
 0.94088,
 0.95105,
 0.96029,
 0.96858,
 0.97592,
 0.98229,
 0.98769,
 0.99211,
 0.99556,
 0.99803,
 0.99951);
 SinArray: array[1..200] of real =
(0.00000,
 0.03141,
 0.06279,
 0.09411,
 0.12533,
 0.15643,
 0.18738,
 0.21814,
 0.24869,
 0.27899,
 0.30902,
 0.33874,
 0.36812,
 0.39715,
 0.42578,
 0.45399,
 0.48175,
 0.50904,
 0.53583,
 0.56208,
 0.58778,
 0.61291,
 0.63742,
 0.66131,
 0.68455,
 0.70711,
 0.72897,
 0.75011,
 0.77051,
 0.79015,
 0.80902,
 0.82708,
 0.84433,
 0.86074,
 0.87631,
 0.89101,
 0.90483,
 0.91775,
 0.92978,
 0.94088,
 0.95106,
 0.96029,
 0.96858,
 0.97592,
 0.98229,
 0.98769,
 0.99211,
 0.99556,
 0.99803,
 0.99951,
 1.00000,
 0.99951,
 0.99803,
 0.99556,
 0.99211,
 0.98769,
 0.98229,
 0.97592,
 0.96858,
 0.96029,
 0.95106,
 0.94088,
 0.92978,
 0.91776,
 0.90483,
 0.89101,
 0.87631,
 0.86074,
 0.84433,
 0.82708,
 0.80902,
 0.79016,
 0.77051,
 0.75011,
 0.72897,
 0.70711,
 0.68455,
 0.66131,
 0.63743,
 0.61291,
 0.58779,
 0.56209,
 0.53583,
 0.50904,
 0.48176,
 0.45399,
 0.42578,
 0.39715,
 0.36813,
 0.33874,
 0.30902,
 0.27899,
 0.24869,
 0.21815,
 0.18738,
 0.15644,
 0.12534,
 0.09411,
 0.06279,
 0.03141,
 0.00000,
-0.03141,
-0.06279,
-0.09411,
-0.12533,
-0.15643,
-0.18738,
-0.21814,
-0.24869,
-0.27899,
-0.30901,
-0.33874,
-0.36812,
-0.39715,
-0.42578,
-0.45399,
-0.48175,
-0.50904,
-0.53582,
-0.56208,
-0.58778,
-0.61290,
-0.63742,
-0.66131,
-0.68454,
-0.70710,
-0.72897,
-0.75011,
-0.77051,
-0.79015,
-0.80901,
-0.82708,
-0.84433,
-0.86074,
-0.87630,
-0.89100,
-0.90483,
-0.91775,
-0.92978,
-0.94088,
-0.95106,
-0.96029,
-0.96858,
-0.97592,
-0.98229,
-0.98769,
-0.99211,
-0.99556,
-0.99803,
-0.99951,
-1.00000,
-0.99951,
-0.99803,
-0.99556,
-0.99212,
-0.98769,
-0.98229,
-0.97592,
-0.96858,
-0.96029,
-0.95106,
-0.94088,
-0.92978,
-0.91776,
-0.90483,
-0.89101,
-0.87631,
-0.86074,
-0.84433,
-0.82708,
-0.80902,
-0.79016,
-0.77052,
-0.75011,
-0.72897,
-0.70711,
-0.68455,
-0.66132,
-0.63743,
-0.61291,
-0.58779,
-0.56209,
-0.53583,
-0.50905,
-0.48176,
-0.45399,
-0.42578,
-0.39715,
-0.36813,
-0.33874,
-0.30902,
-0.27900,
-0.24869,
-0.21815,
-0.18739,
-0.15644,
-0.12534,
-0.09411,
-0.06280,
-0.03142);


 var
   X1, X2, Y1, Y2, ITh, IK, IH, ColorNum:  integer;
   YWork,CB,A,B,C,Th,H,DeltaAngle: real;
   Fudge1, Fudge2: real;              { Fudge Factors for overflow bug }
   CH: char;
   OK : boolean;

 Procedure Putem;
  begin;
  If X2 = -1000 then                   { skip, if first time        }
     else
        Draw(X1,Y1,X2,Y2,ColorNum);    { draw a line between two points }
        If ITh < 66 then ColorNum := 1              { change colors      }
           else if ITh < 132 then ColorNum := 2     { every now and then }
                else ColorNum := 3;
        X2 := X1; Y2 := Y1;                         { save new as old    }
  end;

Procedure Spiro;
Begin;
 Repeat
   ColorNum := 1;                               { starting color and }
   ITh := 1;                                    { trig array pointer }
   Repeat
        H := CB * Th;                           { part of the equation }
        If H > 6.28318 then
          Repeat
          H := H - 6.28318;                     { get between 0 and 2PI }
          Until H < 6.28318
        Else if H < 0.0 then
          Repeat
          H := H + 6.28318;
          Until H > 0.0;
        IH := Trunc(H/0.0314159)+1;   { convert radians to trig pointer }
        If IH < 1 then IH := 1        { don''t go too low or too high   }
           else If IH > 200 then IH := 200;

        { The following Fudge assignments are because a screwy   }
        { integer overflow bug slips in if you let the plot continue }
        { for a long period of time.  Rather than find out why,    }
        { this is just a kludgy pass to get by.                 }

        Fudge1 := ((C*CosArray[ITh]) - (B*CosArray[IH])) * 1.1;
        Fudge2 := (C*SinArray[ITh]) - (B*SinArray[IH]);
        If (ABS(Fudge1) > 32767) or (ABS(Fudge2) > 32767) then
           else begin;
                X1 := Trunc(Fudge1) + 160;     { Get new X and Y  }
                Y1 := Trunc(Fudge2) + 100;
                PutEm;                         { Plot Them }
                end;
        If KeyPressed then begin;
           OK := true;                         {Stop Plotting}
           ITh := 201;
           end;
        Th := Th + DeltaAngle;                 { bump radian angle }

           { To get better resolution, change the following statement }
           { to ITH := ITH + 1;  Also, make the DeltaAngle change below }
           { This will give cleaner graphs, but will slow down the  }
           { program by 100%                                        }
        ITh := ITh + 2;                { bump trig pointer }

        Until ITh > 200;
     Until OK;
end;

begin                                           {first time through}
 X2 := -1000;
 Y2 := -1000;
 ClrScr;

        {  See the better resolution statement above.  Change this one }
        { to DeltaAngle := 0.0314159;  Also make the ITH change above. }
        { As mentioned, this will improve resolution at the cost of    }
        { execution speed.                                             }
 DeltaAngle := 0.0314159 * 2;                 { set radian angle increment }

 GraphColorMode;
 Palette(2);
 Th := 0;
 B := 13.0;                                   { these A and B parameters }
 A := 87.5;                                   { work well for the title  }
 C := A - B;                                  { screen.                  }
 CB := C / B;
 OK := false;
 GoToXY(19,12);
 Write('TURBO');
 GoToXY(19,13);
 Write('SPIRO');
 GOTOXY(17,14);
 Write('Key=Start');
 Repeat                                       { Plot the title spirograph }
  Spiro;
  If KeyPressed then OK := True;
  Until OK;
Repeat
 ClrScr;
 Writeln;
 Writeln('Written by: Joey Robichaux  (CompuServe: 71336,336) ');
 Writeln('            1036 Brookhollow Drive');
 Writeln('            Baton Rouge, La. 70810');
 Writeln('*Note:');
 Writeln('<"Ctrl" & "C" terminates program,  <anykey> stops graph>');

  { For what its worth, when A is greater than B, you get hypercycloids. }
  { When B is greater than A, you get epicycloids.                       }

 Repeat
  GotoXY(1,8);
  BufLen := 5;
  Write('Please enter value between 1 and 100: ','':5);
  GoToXY(39,8);
  Read(B);
  Until (B >= 1) and (B <= 100);
 Repeat
  GotoXY(1,9);
  BufLen := 5;
  Write('Please enter another between 1 and 100: ','':5);
  GoToXY(41,9);
  Read(A);
  Until (A >= 1) and (A <= 100);
 GraphColorMode;
 Palette(2);
 X2 := -1000;                           {First time again}
 Y2 := -1000;
 Th := 0;
 C := A - B;
 CB := C / B;
 OK := false;

 Repeat
 Spiro;                                 { start graphing }
 If KeyPressed then OK := true;
 Until OK;
Until true = false;
 end.