The early spirograph program in Modula-2 from 1987

spg.mod

MODULE Spg;


FROM IO       IMPORT WrStr, WrLn, RdCard, RdInt, RdKey;
FROM MATHLIB  IMPORT Cos, Sin;
FROM Graph    IMPORT SetVideoMode, Line;
FROM Lib      IMPORT Sound, NoSound, Delay;


CONST pi= 3.14159265358979;


VAR  i, j, l            : INTEGER;
     st, R, f, k, scrt  : LONGREAL;
     c                  : CHAR;
     Gm                 : BOOLEAN;
     Mr, Sx, Sy, x, y,
     d, prt             : CARDINAL;


LABEL  z, r;


PROCEDURE Beep();  BEGIN Sound ( 880); Delay ( 200); NoSound  END Beep;


PROCEDURE u( a, b: INTEGER): INTEGER;
BEGIN
  IF b=0  THEN RETURN a  ELSE RETURN u( b, a MOD b)  END
END u;


PROCEDURE ScrX( R: CARDINAL; n: LONGREAL): CARDINAL;
BEGIN
  RETURN 85 + TRUNC ( 235.0 * ( n + LONGREAL( R)) / LONGREAL( R))
END ScrX;


PROCEDURE ScrY( R: CARDINAL; n: LONGREAL): CARDINAL;
BEGIN
  RETURN 4 + TRUNC ( 235.0 * ( n + LONGREAL( R)) / LONGREAL( R))
END ScrY;


BEGIN

  d:=10000;

  LOOP

    Gm:= SetVideoMode( 3);

    WrStr ( "              Spirograph                              ");  WrLn;
    WrStr ( "            Q - quit to DOS, Others - begin.          ");  WrLn;

    c:=RdKey();
    IF ( c="q") OR ( c="Q")
    THEN EXIT
    ELSIF ( c="r") OR ( c="R")
    THEN WrLn; WrStr( "Resolution (0: 10000) - "); d:=RdCard();
      IF d=0  THEN d:=10000  END;
    END;

    WrLn; WrStr ( "  Values  l, i, j - integer, i<>0 :");  WrLn;
    WrStr ( "l - ");  l:=RdInt();
 z: WrStr ( "i - ");  i:=RdInt();
    IF i=0  THEN Beep(); WrStr ( " i<>0!"); WrLn; GOTO z  END;
    WrStr ( "j - ");  j:=RdInt();
    R:= 2.0 * pi * LONGREAL( i) / LONGREAL( u(l,i));
    f:= LONGREAL( l) / LONGREAL( i);  k:= LONGREAL( l-i);
    Mr:= ABS( l - i) + ABS( j);

 r: Gm:= SetVideoMode( 18);  scrt:= 0.0;
    Sx:= ScrX( Mr, k + LONGREAL( j) * Cos( f * scrt ));
    Sy:= ScrY( Mr, 0.0);  st:= R / LONGREAL( d);

    FOR prt:= 1  TO d  DO
      scrt:= scrt + st;
      x:= ScrX( Mr, k * Cos( scrt) + LONGREAL( j) * Cos( f * scrt));
      y:= ScrY( Mr, k * Sin( scrt) - LONGREAL( j) * Sin( f * scrt));
      Line ( Sx, Sy, x, y, 15);
      Sx:= x;  Sy:= y;
    END;

    Beep();  c:= RdKey();  IF  c=CHR( 13)  THEN GOTO r  END;

  END;

END Spg.