Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/079.lha/SpiroGraph/Spirograph.Mod

Text File | 1986-11-20 | 5.1 KB | 188 lines

MODULE Spirograph;

              (* * * * * * * * * * * * * * * * * * * * * * *)
          (*                                           *)
          (* Spirograph v 1.0                          *)
          (* By Steve Faiwiszewski.                    *)
          (*                                           *)
          (* A silly little program that renders       *)
          (* graphics similar to the Spirograph toy.   *)
          (*                                           *)
          (* This was coded for the Oxxi M2 compiler,  *)
          (* but porting it to the TDI compiler should *)
          (* be trivial.                               *)
          (*                                           *)
          (* (c) Copyright 1987 by Steve Faiwiszewski. *)
          (* This program may be freely distributed,   *)
          (* but it is not to be sold.                 *)
          (* Please leave this notice intact.          *)
              (* * * * * * * * * * * * * * * * * * * * * * *)

FROM SpiroDetails
               IMPORT OpenLibs, CleanUp, OpenMyScreen, OpenMyWindow,
                     Position, PlotTo, EraseScreen, SetColor,
                      AddToAboutText,
              ChangeColorReg, GetMessages;
FROM SYSTEM    IMPORT SHIFT, ADR;
FROM MathLib0  IMPORT sin, cos, pi, real;
FROM RandomNumbers
               IMPORT Random, Seed;
FROM AmigaDOS  IMPORT DateStamp, DateStampRecord;

CONST
    WIDTH = 320;
    HEIGHT = 200;
    OFFSET = 12;
    DEPTH = 3;
    MaxX = WIDTH;
    MaxY = HEIGHT;

VAR
   blank : ARRAY[0..1] OF CHAR;

PROCEDURE Randomize;
(* Make sure every time we run this program *)
(* we begin with a different seed.          *)
VAR
    Now : DateStampRecord;
BEGIN
    DateStamp(Now);
    Seed := Now.dsTick;
END Randomize;

PROCEDURE MyRandom(n : CARDINAL): REAL;
(* Routine to generate random numbers of type REAL *)
(* with some fractional value, similar to the RND  *)
(* function of most BASICs                         *)
VAR
    b,c : CARDINAL;
    a,r : REAL;
BEGIN
    a := FLOAT(CARDINAL(Random(n)));
    REPEAT
        b := Random(1000);
        c := Random(1000);
    UNTIL (b > 0) OR (c > 0);
    IF b > c THEN
        r := FLOAT(c)/FLOAT(b)
    ELSE
        r := FLOAT(b)/FLOAT(c)
    END;
    IF (a + r) > FLOAT(n) THEN
        RETURN (a + r - 1.0)
    ELSE
        RETURN (a + r)
    END;
END MyRandom;

PROCEDURE RandomlyGenerateParameters(VAR m,n,stepa : REAL);
BEGIN
    m := MyRandom(30)+3.0;
    n := MyRandom(TRUNC(m)) + 1.0;
    stepa := MyRandom(1) + 0.01;
END RandomlyGenerateParameters;

PROCEDURE DoSpiro;
CONST
    y1 = (MaxY DIV 2) + (OFFSET DIV 2);
    x1 = MaxX DIV 2;
VAR
    MaxColors : CARDINAL;
    Oldm,
    Oldn,
    Oldstepa,
    r,a,m,n,
    stepa   : REAL;
    Done,
    Prev,
    NextPattern,
    PrevPattern,
    LimitedCount,
    first : BOOLEAN;

(* If option 'Prev Pattern' gets selected, then the same *)
(* pattern will continually be rendered until option     *)
(* 'Next Pattern' is selected                            *)
PROCEDURE MessWithScreenColors;
VAR
    NextColorReg,
    red, green,blue : CARDINAL;
BEGIN
    NextColorReg := CARDINAL(Random(MaxColors - 1)) + 1;
    SetColor(NextColorReg);
    NextColorReg := CARDINAL(Random(MaxColors - 2)) + 1;
    REPEAT
    red := Random(16);
    green := Random(16);
    blue := Random(16);
    UNTIL (red > 0) OR (green > 0) OR (blue > 0);
    ChangeColorReg(NextColorReg,red,green,blue);
END MessWithScreenColors;

BEGIN
    Done := FALSE;
    LimitedCount := TRUE;
    PrevPattern := FALSE;
    NextPattern := FALSE;
    MaxColors := SHIFT(2,DEPTH-1);
    RandomlyGenerateParameters(m,n,stepa);
    REPEAT
        EraseScreen(0,WIDTH,HEIGHT);
    MessWithScreenColors;
        a:=0.0;
    IF NextPattern THEN PrevPattern := FALSE END;
    IF PrevPattern THEN
        m := Oldm;
        n := Oldn;
        stepa := Oldstepa;
        LimitedCount := FALSE;
    ELSE
        Oldm := m;
        Oldn := n;
        Oldstepa := stepa;
        RandomlyGenerateParameters(m,n,stepa);
        LimitedCount := TRUE;
    END;
        first:=TRUE;
        REPEAT
            r:=sin((m/n)*a)*FLOAT(y1-OFFSET);
        IF first THEN
           Position(TRUNC(FLOAT(x1)+r*sin(a)),TRUNC(FLOAT(y1)+r*cos(a)))
        ELSE
           PlotTo(TRUNC(FLOAT(x1)+r*sin(a)),TRUNC(FLOAT(y1)+r*cos(a)));
        END;
            first:=FALSE;
        a:=a+stepa;
        GetMessages(Done,NextPattern,Prev);
        PrevPattern := Prev;
         UNTIL ((a>256.0) AND LimitedCount) OR
               Done OR NextPattern OR Prev;
    UNTIL Done;
END DoSpiro;

PROCEDURE SetUpAbout;
BEGIN
    blank := ' ';
    AddToAboutText(ADR('         Spirograph V1.0'));
    AddToAboutText(ADR(blank));
    AddToAboutText(ADR('        Written in Modula-2'));
    AddToAboutText(ADR(blank));
    AddToAboutText(ADR(' Using the Oxxi Benchmark Package'));
    AddToAboutText(ADR(blank));
    AddToAboutText(ADR('       ---------------------'));
    AddToAboutText(ADR(blank));
    AddToAboutText(ADR('        © Copyright 1987 By'));
    AddToAboutText(ADR(blank));
    AddToAboutText(ADR('        Steve Faiwiszewski'));
END SetUpAbout;

BEGIN
    OpenLibs;
    OpenMyScreen(WIDTH,HEIGHT,DEPTH);
    OpenMyWindow(WIDTH,HEIGHT,DEPTH);
    SetUpAbout;
    Randomize;
    DoSpiro;
    CleanUp('Spirograph Exited.',99);
END Spirograph.