{--------------------------------------------------------------}
{                        SpiroGraph                            }
{                                                              }
{    A fancy curve plotter using nothing but basic graphics    }
{                                                              }
{                             by Jeff Duntemann                }
{                             Turbo Pascal V3.0                }
{                             Last update 2/7/86               }
{                                                              }
{    From the book, COMPLETE TURBO PASCAL, by Jeff Duntemann   }
{    Scott, Foresman & Co. (c) 1985,1986  ISBN 0-673-18600-8   }
{--------------------------------------------------------------}

PROGRAM SpiroGraph;

CONST
  HighResolution   = True;
  MediumResolution = False;

VAR
  A,B,D,I : Integer;
  Quit    : Boolean;


{$I YES.SRC}
{$I GBOX.SRC}


PROCEDURE Cross(X,Y,Size,Color : Integer; HiRes : Boolean);

VAR
  YSize   : Integer;
  YAdjust : Real;

BEGIN
  IF HiRes THEN YAdjust := 0.583 ELSE YAdjust := 0.83;
  YSize := Round(Size * YAdjust);
  Draw(X-(Size DIV 2),Y,X+(Size DIV 2),Y,Color);
  Draw(X,Y-(YSize DIV 2),X,Y+(YSize DIV 2),Color)
END;



FUNCTION HighestCommonFactor(A,B : Integer) : Integer;

VAR
  I,J,HCF : Integer;

BEGIN                 { Euclid's algorithm for finding the HCF }
  IF A < B THEN       { of two integers A and B. }
    BEGIN
      HCF := A;
      I   := B
    END
  ELSE
    BEGIN
      HCF := B;
      I   := A
    END;
  REPEAT
    J := I MOD HCF;
    IF J <> 0 THEN
      BEGIN
        I := HCF;
        HCF := J
      END
  UNTIL J = 0;
  HighestCommonFactor := HCF
END;


PROCEDURE SpinWheels(A,B,D,XO,YO : Integer; HiRes : Boolean);

VAR
  Rab,N,Lines,I,HCF : Integer;
  Alpha,Beta,ADif,AoverB : Real;
  XOLD,YOLD,XPT,YPT : Real;       { Line endpoint coordinates }
  YAdjust           : Real;

BEGIN
  { Y must be adjusted for asymmetrical IBM PC pixels: }
  IF HiRes THEN YAdjust := 0.583 ELSE YAdjust := 0.83;
  RAB := A-B; Alpha := 0.0;
  ADif := PI/50.0; AoverB := A/B;
  HCF := HighestCommonFactor(A,B);
  N := B DIV HCF; Lines := 100 * N;
  XOLD := RAB + D; YOLD := 0.0;
  FOR I := 1 TO Lines DO
    BEGIN
      Alpha := Alpha + Adif;
      Beta := Alpha * AoverB;
      XPT := RAB * COS(Alpha) + D * COS(Beta);
      YPT := RAB * SIN(Alpha) - D * SIN(Beta);
      DRAW
      (Round(XOLD)+XO,Round(YOLD*YAdjust)+YO,
       Round(XPT)+XO,Round(YPT*YAdjust)+YO,1);
      XOLD := XPT; YOLD := YPT;
    END

END;


BEGIN
  Quit := False;
  TextColor(7);
  HiResColor(15);
  HiRes;                   { Draw conceptual illustration: }
  GBox(0,0,639,199,2,1);
  GotoXY(20,2); Write('*Turbo SpiroGraph *** by Jeff Duntemann*');
  SpinWheels(180,180,140,320,110,HighResolution);
  SpinWheels(40,40,40,420,110,HighResolution);
  Cross(320,110,15,1,HighResolution);
  Cross(420,110,10,1,HighResolution);
  Cross(420,95,5,1,HighResolution);
  Draw(180,70,180,100,1);
  Draw(320,70,320,100,1);
  Draw(180,75,240,75,1);
  Draw(260,75,320,75,1);
  GotoXY(32,10); Write('A');
  Draw(380,116,380,150,1);
  Draw(420,116,420,150,1);
  GotoXY(51,19); Write('B');
  Draw(432,86,480,86,1);
  Draw(432,95,480,95,1);
  GotoXY(62,12); Write('D');
  Draw(383,70,418,93,1);
  GotoXY(2,4);  Write('A small cog of radius B moves');
  GotoXY(2,5);  Write(' about the rim of a toothed');
  GotoXY(2,6);  Write(' circle of radius A.');
  GotoXY(2,8);  Write('A pencil follows the');
  GotoXY(2,9);  Write(' motion of the cog');
  GotoXY(2,10); Write(' through a hole,');
  GotoXY(2,11); Write(' distance D from the');
  GotoXY(2,12); Write(' rim of the cog.');
  GotoXY(2,14); Write('The pencil draws a');
  GotoXY(2,15); Write(' curved pattern as it');
  GotoXY(2,16); Write(' moves along.');
  GotoXY(57,4); Write('You may vary the values');
  GotoXY(57,5); Write(' of A, B, and D.');
  GotoXY(57,7); Write('Try 180,100, and 50');
  GotoXY(57,8); Write(' to start!');
  GotoXY(57,24); Write('(CR) to play: ');Readln;
  REPEAT
    HiRes;
    GBox(0,0,639,199,2,1);
    GotoXY(2,2); Write('Enter A (Circle diameter ): '); Readln(A);
    GotoXY(2,3); Write('Enter B (Cog diameter)    : '); Readln(B);
    GotoXY(2,4); Write('Enter D (Pencil radius)   : '); Readln(D);
    FOR I := 2 to 4 DO
      BEGIN
        GotoXY(2,I);
        Writeln('                                ')
      END;
    GotoXY(60,24); Write('A:',A,' B:',B,' D:',D);
    SpinWheels(A,B,D,320,100,HighResolution);
    GotoXY(2,24); Write('Try another one? (Y/N): ');
    IF NOT Yes THEN Quit := True
  UNTIL Quit;
  TextMode
END.