(********************************************************************
  :Program.       Mandel.mod
  :Author.        Ludwig Geromiller
  :Address.       Filderstr. 63, 7000 Stuttgart 1
  :Phone.         0711/6409664
  :Version.       1.0
  :Date.          10/1989
  :Copyright.     PD
  :Language.      Modula-II
  :Translator.    M2Amiga 3.2d
  :Imports.       Nichts
  :Contents.      Another Mandelbrot Generator-Program with FFP
********************************************************************)

MODULE Mandel ;

(*$S-,$R-,$V-*)  (* SPEED IT UP !! *)

FROM ASCII     IMPORT csi;
FROM SYSTEM    IMPORT ADDRESS, ADR, FFP ;
FROM InOut     IMPORT Read;
FROM FFPInOut  IMPORT ReadReal, WriteReal;
FROM Intuition IMPORT NewScreen, ScreenPtr, customScreen, OpenScreen,
                      CloseScreen, NewWindow, WindowPtr, IDCMPFlags,
                      IDCMPFlagSet, WindowFlags, WindowFlagSet,
                      OpenWindow, CloseWindow, IntuiMessage,
                      RemakeDisplay;
FROM Dos       IMPORT Delay ;
FROM Terminal  IMPORT WriteString, WriteLn, waitCloseGadget, Write ;
FROM Graphics  IMPORT RastPortPtr, SetAPen, WritePixel, LoadRGB4;
FROM Arts      IMPORT TermProcedure, Terminate;
FROM MathTrans IMPORT Sqrt;
FROM Exec      IMPORT WaitPort, GetMsg, ReplyMsg;

CONST
   xmax = 319; (* Auflösung 320x256 -> PAL *)
   ymax = 255;
   zerr = 1.11;

   White     = 0FFFH;    GoldenOrange  = 0FB0H;    LightAqua = 01FBH;
   BrickRed  = 0D00H;    CadmiumYellow = 0FD0H;    SkyBlue   = 06FEH;
   Red       = 0F00H;    LemonYellow   = 0FF0H;    LightBlue = 06CEH;
   RedOrange = 0F80H;    ForestGreen   = 00B1H;    Blue      = 000FH;
   Orange    = 0F90H;    LightGreen    = 08E0H;    Purple    = 091FH;
   LimeGreen = 0BF0H;    BrightBlue    = 061FH;    Violet    = 0C1FH;
   Green     = 00F0H;    DarkBlue      = 006DH;    Pink      = 0FACH;
   DarkGreen = 02C0H;    MediumGrey    = 0999H;    Tan       = 0DB9H;
   BlueGreen = 00BBH;    LightGrey     = 0CCCH;    Brown     = 0C80H;
   Aqua      = 00DBH;    Magenta       = 0F1FH;    DarkBrown = 0A87H;
   Black     = 0000H;
   MaxColors = 32;     (* # of colors to load when calling SetScreenColors *)

VAR
    ScreenColors                 : ARRAY [0..MaxColors-1] OF CARDINAL;
    MyScreen                     : NewScreen ;
    MyScreenPtr                  : ScreenPtr ;
    Win                          : NewWindow ;
    WinPtr                       : WindowPtr ;
    rp                           : RastPortPtr;
    class                        : IDCMPFlagSet ;
    IntuiMsg                     : POINTER TO IntuiMessage ;
    spa,zei                      : CARDINAL;
    xc,yc,imstart,imende,
    restart,reende,restep,imstep : FFP;
    p                            : CHAR;
    err                          : LONGINT;

PROCEDURE SetScreenColors (CurrentScreen : ScreenPtr);

 BEGIN
   ScreenColors[ 0] := Black;       ScreenColors[ 1] := White;
   ScreenColors[ 2] := Red;         ScreenColors[ 3] := LimeGreen;
   ScreenColors[ 4] := SkyBlue;     ScreenColors[ 5] := CadmiumYellow;
   ScreenColors[ 6] := LightGreen;  ScreenColors[ 7] := LightGrey;
   ScreenColors[ 8] := DarkGreen;   ScreenColors[ 9] := Brown;
   ScreenColors[10] := Purple;      ScreenColors[11] := Orange;
   ScreenColors[12] := MediumGrey;  ScreenColors[13] := Aqua;
   ScreenColors[14] := Tan;         ScreenColors[15] := Violet;
   ScreenColors[16] := Pink;        ScreenColors[17] := LightAqua;
   ScreenColors[18] := LemonYellow; ScreenColors[19] := Green;
   ScreenColors[20] := DarkBrown;   ScreenColors[21] := LightGrey;
   ScreenColors[22] := GoldenOrange;ScreenColors[23] := DarkBlue;
   ScreenColors[24] := ForestGreen; ScreenColors[25] := BrickRed;
   ScreenColors[26] := SkyBlue;     ScreenColors[27] := BlueGreen;
   ScreenColors[28] := BrightBlue;  ScreenColors[29] := RedOrange;
   ScreenColors[30] := Blue;        ScreenColors[31] := Black;

   IF (CurrentScreen <> NIL) THEN
     LoadRGB4(ADR(CurrentScreen^.viewPort), ADR(ScreenColors), MaxColors);
   END; (* IF CurrentScreen *)
 END SetScreenColors;

PROCEDURE CloseDown ;

   BEGIN (* CloseDown *)
      IF WinPtr # NIL THEN
         CloseWindow(WinPtr) ;
      END (* IF *) ;
      IF MyScreenPtr # NIL THEN
         CloseScreen(MyScreenPtr) ;
      END (* IF *) ;
   END CloseDown ;

PROCEDURE Test(text : ARRAY OF CHAR ; adr : ADDRESS) ;
   (* Test ob Screen oder Fenster erfolgreich geöffnet wurde *)
   BEGIN (* Test *)
      IF adr = NIL THEN
         WriteString(text) ;
         WriteString(" läßt sich nicht öffnen !!") ; WriteLn ;
         WriteString(" ProgrammABBRUCH") ; WriteLn ;
         (*CloseDown ;*)
         Terminate(10) ;
      ELSE
         RETURN ;
      END (* IF *) ;
   END Test ;

PROCEDURE TESTClose;
  (* warte auf linke Maustaste im Fenster *)
  BEGIN
  LOOP
      WaitPort(WinPtr^.userPort);
      IntuiMsg := GetMsg(WinPtr^.userPort) ;
      WHILE IntuiMsg # NIL DO
         class := IntuiMsg^.class ;
         ReplyMsg(IntuiMsg) ;
         IF (mouseButtons IN class) THEN
            EXIT ;
         END (* IF *) ;
         IntuiMsg := GetMsg(WinPtr^.userPort) ;
      END (* WHILE *) ;
   END (* LOOP *) ;
  END TESTClose;

   PROCEDURE Iter(xc, yc: FFP; maxi: CARDINAL): CARDINAL;
     VAR x,y,x2,y2,r,s : FFP;
         k             : CARDINAL;
   BEGIN (* Iter *)
     x:=0.0;y:=0.0;x2:=0.0;y2:=0.0; k:=0;
     r := xc*xc+yc*yc;
     s := Sqrt(r- 0.5*xc + 0.0625);
     IF (((16.0 * r * s) > (5.0 * s - 4.0 * xc + 1.0)) AND
         (((xc + 1.0) * (xc + 1.0) + yc*yc) > 0.0625)) THEN
       REPEAT
         y := 2.0 * x * y + yc;
         x := x2 - y2 + xc;
         x2:= x * x; y2 := y * y;
         k := k+1;
       UNTIL  ((x2+y2 > 4.0) OR (k > maxi))
     ELSE
       k := maxi;
     END; (* IF *)
     IF (k >= maxi) THEN k := 0 END;
     RETURN (k);
   END Iter;

BEGIN (* Mandel *)
  MyScreenPtr:=NIL; WinPtr:=NIL;
  TermProcedure(CloseDown);
  waitCloseGadget:=FALSE;
  WriteLn;
  Write(csi); WriteString("1;33;42m");
  WriteString("------ Mandel V1.0 ------- (C) 1989 by Gero-Soft -------");
  Write(csi); WriteString("0;31;40m"); WriteLn; WriteLn;


   WriteString("Eingabe des Parametersatzes "); WriteLn;
   WriteString("(1..4) oder `e` für eigene Parameter -> ");
   Read(p);WriteLn;

   CASE p OF
   "1":           restart :=  -2.3; (* Apfel *)
                  reende :=    0.7;
                  imstart :=  -1.25;
                  imende :=    1.25|
   "2":           restart :=  -0.2; (*Apfel klein*)
                  reende :=   -0.13;
                  imstart :=   1.015;
                  imende :=    1.06|
   "3":           restart :=   0.0; (*Schnecke*)
                  reende :=   -0.75;
                  imstart :=  -0.74;
                  imende :=    0.105|
   "4":           restart :=  -0.65;
                  reende :=   -0.5;
                  imstart :=  -0.72;
                  imende :=   -0.57|
   "e":           WriteLn;
                  WriteString ("restart, reende, imstart, imende:");WriteLn;
                  ReadReal(restart);
                  ReadReal(restart);ReadReal(reende);
                  ReadReal(imstart);ReadReal(imende)|
   ELSE Terminate(10)
   END; (* CASE *)
   WriteString("Parametersatz : ");Write(p);WriteLn;WriteLn;

   restep := (reende - restart)/FFP(xmax);
   imstep := (imende - imstart)*zerr/FFP(ymax);

   WriteString ("restart = "); WriteReal(restart,10,4);
   WriteString (" reende = "); WriteReal(reende,10,4);
   WriteString (" restep = "); WriteReal(restep,10,6);WriteLn;
   WriteString ("imstart = "); WriteReal(imstart,10,4);
   WriteString (" imende = "); WriteReal(imende,10,4);
   WriteString (" imstep = "); WriteReal(imstep,10,6);WriteLn;
   WriteString ("UND LOS GEHTS !! Zum Abbruch mit Ctrl-C Dieses Window aktivieren");
   WriteLn; WriteString("Beenden mit linker Maustaste!"); WriteLn;
   Delay(60);

   WITH MyScreen DO (* Open Screen *)
      leftEdge := 0 ; topEdge := 0 ;
      width := 320 ; height := 256 ;
      depth := 4 ;
      detailPen := 0 ; blockPen := 0 ;
      type := customScreen ;
      font := NIL ;
      defaultTitle := NIL;
      gadgets := NIL ;
      customBitMap := NIL ;
   END (* WITH *) ;
   MyScreenPtr := OpenScreen(MyScreen) ;
   Test("MyScreen",MyScreenPtr) ;
   SetScreenColors(MyScreenPtr) ; (* Setze Palette *)

   WITH Win DO
      leftEdge := 0 ; topEdge := 0 ;            (* linke obere Ecke *)
      width := 320 ; height := 256 ;            (* Breite und Höhe *)
      detailPen := 0 ; blockPen := 0 ;          (* Farbregister *)
      idcmpFlags := IDCMPFlagSet{mouseButtons} ; (* Nachricht, wenn
                                                    li. Maustaste gedrückt *)
      flags := WindowFlagSet{borderless,noCareRefresh};
      firstGadget := NIL ;
      checkMark := NIL ;
      title := NIL ;
      screen := MyScreenPtr ;
      bitMap := NIL ;
      type := customScreen ;
      minWidth := 300 ; maxWidth := 320 ;
      minHeight := 20 ; maxHeight := 256 ;
   END (* WITH *) ;

   WinPtr := OpenWindow(Win) ;
   Test("Window",WinPtr) ;

   rp:=ADR(MyScreenPtr^.rastPort); (* Rasterport *)

   yc:= imstart;
   FOR zei := 0 TO ymax DO
     xc := restart;
     FOR spa := 0 TO xmax DO
       SetAPen (rp,Iter (xc,yc,16));  (* Farbe       *)
       err := WritePixel(rp,spa,zei); (* Setze Punkt *)
       xc := xc+restep;
     END; (* FOR *)
     yc := yc+imstep;
   END; (* FOR *)

   TESTClose;

END Mandel.