Program Snowflake;

{ Ce programme dessine un motif fractal d'un flocon de neige. Je crois
l'avoir trouvé dans une revue il y a plusieurs années. Il était écrit
en BASIC pour un PC et je l'avais modifié en AmigaBASIC. Depuis le
temps, j'ai oublié comment il fonctionne en détail, par conséquent j'ai
été incapable de donner des noms de variables significatifs. Evidemment,
le mérite de ces noms revient à l'auteur d'origine. Appelez le programme
par la ligne "Snow <niveau>", où <niveau> est un chiffre entre 1 et 6.
Afin de pouvoir bien voir ce qui va se passer, essayez de lancer les
niveaux dans l'ordre. Le niveau 6 prend beaucoup de temps et, franchement,
n'est pas aussi bon que le niveau 5. }

{$I "Include:Exec/Ports.i" pour GetMsg et WaitPort }
{$I "Include:Intuition/Intuition.i" pour les fenêtres }
{$I "Include:Graphics/Pens.i" pour move() et draw() }
{$I "Include:Graphics/Graphics.i" pour GfxBase }
{$I "Include:Exec/Libraries.i" seulement pour OpenLibrary et CloseLibrary }
{$I "Include:Exec/Interrupts.i" pour Forbid() et Permit() }

var
    dx : array [0..11] of real;
    dy : array [0..11] of real;
    sd : array [0..6] of integer;
    rd : array [0..6] of integer;
    sn : array [0..6] of integer;
    ln : array [0..6] of real;
    a  : real;
    nc : integer;
    x, y, t : real;
    w  : WindowPtr;
    rp : RastPortPtr;
    n  : integer;
    d, ns, i, j : integer;
    l : real;
    m : MessagePtr;

Procedure usage;
begin
    writeln('Usage: Prg6 <Niveau>');
    writeln('       avec <Niveau> un nombre entre 1 et 6');
    {exit(20);}
end;

Function readcycles(): integer;
var
    index : integer;
    cycles : integer;
begin
    index := 0;
    while ((commandline[index] = ' ') or (commandline[index] = chr(9))) and
        (index < 128) do
        index := index + 1;
    if index >= 128 then
        usage;
    cycles := ord(commandline[index]) - ord('0');
    if (cycles > 6) or (cycles < 1) then begin
        cycles := 3;
        usage;
        end;
    readcycles := cycles;
end;

Function OpenTheWindow() : Boolean;
var
    nw : NewWindowPtr;
begin
    new(nw);

    nw^.LeftEdge := 0;
    nw^.TopEdge := 0;
    nw^.Width := 640;
    nw^.Height := 200;

    nw^.DetailPen := -1;
    nw^.BlockPen  := -1;
    nw^.IDCMPFlags := CLOSEWINDOW_f;
    nw^.Flags := WINDOWDEPTH + WINDOWCLOSE + SMART_REFRESH + ACTIVATE;
    nw^.FirstGadget := nil;
    nw^.CheckMark := nil;
    nw^.Title := "Fractal Snowflake";
    nw^.Screen := nil;
    nw^.BitMap := nil;
    nw^.MinWidth := 50;
    nw^.MaxWidth := -1;
    nw^.MinHeight := 20;
    nw^.MaxHeight := -1;
    nw^.WType := WBENCHSCREEN_f;

    w := OpenWindow(nw);
    dispose(nw);
    OpenTheWindow := w <> nil;
end;

procedure initarrays;
begin
    sd[0] := 0;
    rd[0] := 0;
    sd[1] := 1;
    rd[1] := 0;
    sd[2] := 1;
    rd[2] := 7;
    sd[3] := 0;
    rd[3] := 10;
    sd[4] := 0;
    rd[4] := 0;
    sd[5] := 0;
    rd[5] := 2;
    sd[6] := 1;
    rd[6] := 2;

    for n := 0 to 6 do
        ln[n] := 1.0 / 3.0;
    ln[2] := sqrt(ln[1]);
    a := 0.0;
    for n := 6 to 11 do begin
        dy[n] := sin(a);
        dx[n] := cos(a);
        a := a + 0.52359;
    end;
    for n := 0 to 5 do begin
        dx[n] := -(dx[n + 6]);
        dy[n] := -(dy[n + 6]);
    end;
    x := 534.0;
    y := 151.0;
    t := 324.0;
end;

begin
    nc := readcycles();
    initarrays;

    GfxBase := OpenLibrary("graphics.library", 0);
    if GfxBase = nil then begin
        writeln('Could not open Graphics.library');
        exit(20);
    end;

    if OpenTheWindow() then begin
        rp := w^.RPort;

        for n := 0 to nc do
            sn[n] := 0;

        Move(rp, trunc(x), trunc(y));

        repeat
            d := 0;
            l := t;
            ns := 0;

            for n := 1 to nc do begin
                i := sn[n];
                l := l * ln[i];
                j := sn[n - 1];
                ns := ns + sd[j];
                if odd(ns) then
                    d := (d + 12 - rd[i]) mod 12
                else
                    d := (d + rd[i]) mod 12;
            end;

            x := x + 1.33 * l * dx[d];
            y := y - 0.5 * l * dy[d];

            Draw(rp, trunc(x), trunc(y));
            sn[nc] := sn[nc] + 1;
            n := nc;
            while (n >= 1) and (sn[n] = 7) do begin
                sn[n] := 0;
                sn[n - 1] := sn[n - 1] + 1;
                n := n - 1;
            end;
        until sn[0] <> 0;
        m := WaitPort(w^.UserPort);
        forbid;
        repeat
            m := GetMsg(w^.UserPort);
        until m = nil;
        permit;
        CloseWindow(w);
    end else
        writeln('Could not open the window');
    CloseLibrary(GfxBase);
end.