(*-------------------------------------------------------------------
  :Program.       Fraktal
  :Author.        Philippe Gressly
  :Address.       Näfenhaus CH 8926 Kappel a/A
  :History.       V1.0, 11-Dec-89, Philippe Gressly
  :Copyright.     PD
  :Language.      Modula-II
  :Translator.    M2Amiga 3.2d
  :Imports.       ARP, FileHelp;
  :Contents.      Fraktale Kurven und unzusammenhängende Rekursive Mengen
  :Contents.      zeichnen. Beispiele:
  :Contents.       - Koch-Kurve,
  :Contents.       - Cantorsches Diskontinuum,
  :Contents.       - Weihnachtsbäume, und und und...
---------------------------------------------------------------------
*)



MODULE Fraktal;

FROM Str IMPORT Copy, Concat;
FROM Arts IMPORT TermProcedure, Assert;
FROM Windows IMPORT OpenWindow, CloseWindow, Window, WinGad, WinGadSet;
FROM Graphics IMPORT Move, Draw, RastPortPtr, SetAPen, RectFill;
FROM SYSTEM IMPORT FFP, ADR, ADDRESS;
FROM ARP IMPORT FileReqFlags, FileReqFlagSet, FileReqFunc,
                FileRequesterPtr, FileRequester, FileRequest;
FROM Dos IMPORT FileHandlePtr, FileHandle, oldFile, Open, Close;
FROM FileHelp IMPORT ReadFFPF, ReadIntF;
FROM Intuition IMPORT IntuiMessagePtr, ModifyIDCMP, IDCMPFlagSet, IDCMPFlags,
                      SetWindowTitles, ActivateWindow, DisplayBeep;
FROM exec IMPORT GetMsg, WaitPort, ReplyMsg;


CONST MaxGenerator = 30;          (* Strecken im Streckenzug des Generis *)
      MaxStrecken = MaxGenerator; (* Strecken im Traeger maximal *)
      MaxDepth = 9;              (* Maximale Iterationstiefe *)
      Breite = 500; Hoehe = 220;  (* Startdimension des Fensters *)




TYPE Strecke = RECORD x1,y1, x2,y2: FFP END; (* eine Typische Strecke *)

     StreckenZug = RECORD n: INTEGER;
                          S: ARRAY[1..MaxGenerator] OF Strecke
                   END;

TYPE MyEvent = (Ende, TiefeNeu, GeneriVonDisk,
                CLS, Zeichnen, TraegerVonDisk);

                (* Ich wollte zuerst die Abfrage mit Menus machen,
                 * bin aber nach dem lesen des Intuition-reference
                 * Manuals davon abgekommen.
                 *)


VAR Generi, Traeger, AktTraeger: StreckenZug;
    Tiefe: INTEGER; (* Anzahl Iterationen *)
    MyWindowPtr : Window;
    WindowTitel: ARRAY[0..80] OF CHAR;
    rp: RastPortPtr; (* der Rastport des Windows "MyWindowPtr" *)
    MSG: MyEvent; (* Dieses Event wurde vom Benutzer gewählt *)
    MyFh: FileHandlePtr;
    AktBreite, AktHoehe, i: INTEGER; (* AktBreite und Hoehe geben die
                                      * aktuelle Fenstergröße an, i ist ein
                                      * Zähler.
                                      *)


PROCEDURE FileAuf(Dir: ARRAY OF CHAR; Col: BOOLEAN): FileHandlePtr;
(* Verlangt vom Anwender einen Filenamen, und öffnet dann das File wenn
   möglich.
 *)
VAR FR: FileRequester;
    dir, dirTit, File: ARRAY[0..255] OF CHAR;
BEGIN
  Copy(dir, Dir); Copy(dirTit, Dir);
  File := "";
  WITH FR DO
    hail      := ADR(dirTit);
    ddef      := ADR(File);
    ddir      := ADR(dir);
    wind      := NIL;
    IF Col THEN
       funcFlags := FileReqFlagSet{doColor}
    ELSE
       funcFlags := FileReqFlagSet{}
    END;
    reserved1 := 0;
    function  := NIL;
    reserved2 := 0;
  END;
  IF FileRequest(ADR(FR))#NIL THEN
    Concat(dir, "/");
    Concat(dir, File);
    RETURN Open(ADR(dir), oldFile)
  END;
  RETURN NIL;
END FileAuf;



PROCEDURE StreckenEingabe(VAR S:Strecke);
(* Liest eine Strecke vom aktuellen FileHandle ein. *)
VAR ok: BOOLEAN;
BEGIN
   ok := ReadFFPF(MyFh, S.x1, FALSE); ok := ReadFFPF(MyFh, S.y1, FALSE);
   ok := ReadFFPF(MyFh, S.x2, FALSE); ok := ReadFFPF(MyFh, S.y2, FALSE)
END StreckenEingabe;




PROCEDURE GeneratorEingabe;
(* Generator mit FileRequester einlesen *)
VAR i: INTEGER;
BEGIN
   MyFh := FileAuf("Generatoren", FALSE);
   IF MyFh = NIL THEN RETURN END;
   IF NOT ReadIntF(MyFh, Generi.n, FALSE) THEN RETURN END;
   FOR i := 1 TO Generi.n DO
      StreckenEingabe(Generi.S[i])
   END;
   Close(MyFh);
   MyFh := NIL
   (* Damit in TermProcedure nicht ein bereits geschlossenes File
      geschlossen wird *)
END GeneratorEingabe;




PROCEDURE TraegerEingabe;
(* Traeger mit FileRequester einlesen *)
VAR i: INTEGER;
BEGIN
   MyFh := FileAuf("Traeger", TRUE);
   IF MyFh = NIL THEN RETURN END;
   IF NOT  ReadIntF(MyFh, Traeger.n, FALSE) THEN RETURN END;
   FOR i := 1 TO Traeger.n DO
      StreckenEingabe(Traeger.S[i])
   END;
   Close(MyFh);
   MyFh := NIL (* vgl. GeneratorEingabe *)
END TraegerEingabe;



PROCEDURE WindowAuf; (* Öffnet das Fenster in welchem die Bilder
                      * geuzeichnet werden.
                      *)
BEGIN
   OpenWindow(MyWindowPtr, 0, 10, Breite, Hoehe, "Gigageilo",
              WinGadSet{moving, arranging, sizing, closing});
   Assert(MyWindowPtr # NIL, ADR("Window Zu!!"));
   ActivateWindow(MyWindowPtr);
   ModifyIDCMP(MyWindowPtr, IDCMPFlagSet{vanillaKey, closeWindow});
   rp := MyWindowPtr^.rPort
END WindowAuf;



PROCEDURE DrawLine(S: Strecke);
(* Zeichnet die Strecke ins Fenster *)
VAR x1,x2,y1,y2: INTEGER;
    Li : LONGINT;
BEGIN
   x1 := INTEGER(S.x1);
   x2 := INTEGER(S.x2);
   y1 := INTEGER(S.y1);
   y2 := INTEGER(S.y2);
   Move(rp, x1, AktHoehe - y1 DIV 2);
   Draw(rp, x2, AktHoehe - y2 DIV 2)
END DrawLine;




PROCEDURE Berechne(St: Strecke; VAR StOut: Strecke; Nr: INTEGER);
(* Diese Procedur berechnet eine Strecke (StOut) aus einer Trägerstrecke (St)
 * und der Nummer im Generator (Nr). Man beachte, daß weder Trigonometrische
 * Funktionen, noch die Wurzel dafür verwendet wurde!!
 *)
VAR x,y: FFP;
    Erg: Strecke;
BEGIN
   x := St.x2 - St.x1;
   y := St.y2 - St.y1;
   Erg.x1 := St.x1 + x * Generi.S[Nr].x1 - y * Generi.S[Nr].y1;
   Erg.y1 := St.y1 + y * Generi.S[Nr].x1 + x * Generi.S[Nr].y1;
   Erg.x2 := St.x1 + x * Generi.S[Nr].x2 - y * Generi.S[Nr].y2;
   Erg.y2 := St.y1 + y * Generi.S[Nr].x2 + x * Generi.S[Nr].y2;
   StOut := Erg
END Berechne;



PROCEDURE Zeichne;
(* Zeichnet die fraktale Kurve aus: Generi, AktTraeger, Tiefe *)

TYPE Vekt = ARRAY[0..MaxDepth] OF RECORD
                                     I: INTEGER; (* Index *)
                                     S: Strecke
                                  END;

(* Vektor v enthällt die Aktuelle Rechnung. z.B
 *  v[0].I = 1; v[1].I = 4; v[2].I = 2 ..
 * bedeutet, daß von der Trägerstrecke (v[0]) das vierte Stück des Generators
 * und das zweite des vierten berechnet sind und jeweils in v[i].S ab-
 * gespeichert sind.
 *)

VAR v: Vekt;
    h, t, i: INTEGER;
    adre: ADDRESS;
BEGIN (* Zeichne Generi, AktTraeger, Tiefe *)
   IF Tiefe <= 0 THEN RETURN END;
   IF AktTraeger.n <= 0 THEN RETURN END;
   IF Generi.n <= 0 THEN RETURN END;

   FOR t := 1 TO AktTraeger.n DO
      v[0].S := AktTraeger.S[t];
      FOR h := 0 TO Tiefe DO v[h].I := 1 END;
      i := 1;
      WHILE i > 0 DO
        (* Falls der Anwender eine Taste drückt, soll Zeichnen aufhören.
         * Gibt also dem Benutzer die Möglichkeit zu lange Wartezeiten
         * zu vermeiden.
         *)
         adre := GetMsg(MyWindowPtr^.userPort);
         IF adre # NIL THEN
            ReplyMsg(adre);
            RETURN
         END;

         FOR h := i  TO Tiefe DO
            Berechne(v[h-1].S, v[h].S, v[h].I);
         END;
         DrawLine(v[Tiefe].S);
         i := Tiefe;
         INC(v[i].I);
         WHILE v[i].I > Generi.n DO
            v[i].I := 1;
            DEC(i);
            (* BreakPoint(ADR("i=0")); *)
            IF i > 0 THEN INC(v[i].I) END
         END
      END
   END; (* For AktTraeger Strecke *)
   (* Bildschirm-Beep *)
   DisplayBeep(MyWindowPtr^.wScreen)
END Zeichne;



PROCEDURE WindowZu;
BEGIN
   IF MyWindowPtr # NIL THEN CloseWindow(MyWindowPtr) END;
   IF MyFh # NIL THEN Close(MyFh) END
END WindowZu;



PROCEDURE WaitMyEvent():MyEvent;
VAR ch: CHAR;
    class: IDCMPFlagSet;
    adre : ADDRESS;
    im : IntuiMessagePtr;
BEGIN
   WaitPort(MyWindowPtr^.userPort);
   adre := GetMsg(MyWindowPtr^.userPort);
   im := IntuiMessagePtr(adre);
   class := im^.class;
   ch := CHAR(im^.code);
   ReplyMsg(im);
   IF closeWindow IN class THEN RETURN Ende END;
   CASE CAP(ch) OF
      "G": RETURN GeneriVonDisk;
   |  "T": RETURN TraegerVonDisk;
   |  "1".."9": Tiefe := ORD(ch) - ORD("0");
                RETURN TiefeNeu
   |  "Z": RETURN Zeichnen;
   |  "C": RETURN CLS;
   ELSE
      RETURN TiefeNeu
   END
END WaitMyEvent;



PROCEDURE WindwoTitelNeu;
BEGIN
   WindowTitel := "Gigageilo (Tiefe = x)"; (* die x wird in überschrieben *)
   WindowTitel[19] := CHAR(Tiefe + ORD("0"));
   SetWindowTitles(MyWindowPtr, ADR(WindowTitel), ADR("Fraktalo"));
END WindwoTitelNeu;




BEGIN (* Hauptprogramm *)
   WindowAuf;
   MyFh := NIL;
   TermProcedure(WindowZu);

   Tiefe := 1;

   Generi.n := 1;
   Generi.S[1].x1 := 0.0; Generi.S[1].x2 := 1.0;
   Generi.S[1].y1 := 0.0; Generi.S[1].y2 := 0.0;

   Traeger.n := 1;
   Traeger.S[1].x1 := 0.0; Traeger.S[1].x2 :=  1.0;
   Traeger.S[1].y1 := 0.5; Traeger.S[1].y2 :=  0.5;

   REPEAT
      WindwoTitelNeu;
      MSG := WaitMyEvent();
      AktHoehe := MyWindowPtr^.height;
      AktBreite := MyWindowPtr^.width;

    (* AktTräger in Höhe und Breite dem Aktuellen Fenster anpassen: *)
      AktTraeger.n := Traeger.n;
      FOR i := 1 TO Traeger.n DO
         AktTraeger.S[i].x1 := FFP(AktBreite) * Traeger.S[i].x1;
         AktTraeger.S[i].x2 := FFP(AktBreite) * Traeger.S[i].x2;
         AktTraeger.S[i].y1 := FFP(AktHoehe) * Traeger.S[i].y1 * 2.0;
         AktTraeger.S[i].y2 := FFP(AktHoehe) * Traeger.S[i].y2 * 2.0;
      END;

      CASE MSG OF
      |  GeneriVonDisk: GeneratorEingabe;
      |  CLS: SetAPen(MyWindowPtr^.rPort, 0);
              RectFill(MyWindowPtr^.rPort, 2, 10, AktBreite-3, AktHoehe-2);
              SetAPen(MyWindowPtr^.rPort, 3);
           (* Das Windowsizing Gadget andeuten: *)
              Move(rp, AktBreite - 16, AktHoehe);
              Draw(rp, AktBreite - 16, AktHoehe - 9);
              Draw(rp, AktBreite     , AktHoehe - 9)
      |  Zeichnen: Zeichne;
      |  TraegerVonDisk: TraegerEingabe;
      ELSE (* Hier z.B. TiefeNeu, da das bereits in der WaitEvent-Schleife
            * eingetragen wird.
            *)
      END
   UNTIL MSG = Ende
END Fraktal.