(**********************************************************************

:Program.    Apfelmenu.mod
:Contens.    Menuoberfläche und Hauptmodul für das Modul Apfelmann.
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Oberon
:Translator. Amiga Oberon A+L V2.0
:Imports.    Apfelmann, IntuiSupport, Req [Amok#47], IFFLib [Amok#49]
:Support     iff.library von Christian Weber
:Support.    req.library von Colin Fox und Bruce Dawson
:History.    V1.0 31.Mai.1990 Erste Modula-2 Version
:History.    V2.0  3.Dez.1990 Erste Oberon Version
:History.    V2.1  9.Jul.1991 Benuzt Requester.
:History.                     Gemaltes Bild kann abgespeichert werden.
:Remark.     iff.library und req.library müssen in libs: sein.
***********************************************************************)

MODULE Apfelmenu;

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)

   IMPORT r  : Requests,
          e  : Exec,
          g  : Graphics,
          if : IFFLib,
          i  : Intuition,
          is : IntuiSupport,
          a  : ApfelMann,
          re : Req,
          o  : OberonLib,
          d  : Dos,
          s  : SYSTEM;

   CONST
      WHITE    = 2;
      compl    = SHORTSET { g.complement };
      memerr   = "Kein Speicher mehr!";
      YMIN     = 11;

   VAR
      myscreen     : i.ScreenPtr;
      oldwindow,
      mywindow     : i.WindowPtr;
      myclass      : LONGSET;
      myaddress    : e.ADDRESS;
      menustrip    : ARRAY 6 OF i.MenuPtr;
      menuItem     : ARRAY 6, 8 OF i.MenuItemPtr;
      myflag       : SET;
      myrp         : g.RastPortPtr;
      myvp         : g.ViewPort;
      mycode,
      MenuStrip,
      MenuItem     : INTEGER;
      myproc       : d.ProcessPtr;
      freqPtr      : re.FileRequesterPtr;
      dirstring    : re.DirString;
      filestring   : re.FileString;
      wholefilePtr : re.PathStringPtr;

      xmax, ymax, x1, x2, y1, y2,
      farben, tiefe, maxiter, modus : INTEGER;

   (* Setzt als Windowfarben die Spectralfarben ein *)
   PROCEDURE SetColors ( vp : g.ViewPort );
      VAR
         v : g.ViewPortPtr;
   BEGIN
      v := s.ADR ( vp );
      g.SetRGB4 ( v,  0,  0,  0,  0 );
      g.SetRGB4 ( v,  1, 15, 15, 15 );
      g.SetRGB4 ( v,  2,  0,  0,  9 );
      g.SetRGB4 ( v,  3,  0,  0, 15 );
      g.SetRGB4 ( v,  4,  0,  5, 15 );
      g.SetRGB4 ( v,  5,  0, 10, 15 );
      g.SetRGB4 ( v,  6,  0, 15, 15 );
      g.SetRGB4 ( v,  7,  0, 15, 10 );
      g.SetRGB4 ( v,  8,  0, 15,  0 );
      g.SetRGB4 ( v,  9, 10, 15,  0 );
      g.SetRGB4 ( v, 10, 15, 15,  0 );
      g.SetRGB4 ( v, 11, 15, 10,  0 );
      g.SetRGB4 ( v, 12, 15,  5,  0 );
      g.SetRGB4 ( v, 13, 15,  0,  0 );
      g.SetRGB4 ( v, 14, 10,  0,  0 );
      g.SetRGB4 ( v, 15,  5,  0,  0 );
   END SetColors;

   (* Schließt Window und Screen *)
   PROCEDURE Cleanup;
   BEGIN
      IF myproc.windowPtr # NIL THEN
         myproc.windowPtr := oldwindow;
      END;
      IF mywindow # NIL THEN
         i.ClearMenuStrip ( mywindow );
         i.CloseWindow    ( mywindow );
         mywindow := NIL;
      END;
      IF myscreen # NIL THEN
         i.OldCloseScreen ( myscreen );
         myscreen := NIL;
      END;
   END Cleanup;

   (* Malt ein Kreuz auf den Bildschirm *)
   PROCEDURE DrawCross ( x, y : INTEGER );
   BEGIN
      g.Move ( myrp, 0, y );
      g.Draw ( myrp, xmax, y );
      g.Move ( myrp, x, 0 );
      g.Draw ( myrp, x, ymax );
   END DrawCross;

   (* Löscht ein Kreuz und läßt den Bildschirm aufblinken *)
   PROCEDURE EraseCrosses ( x1, y1, x2, y2 : INTEGER );
   BEGIN
      g.SetDrMd ( myrp, compl );
      DrawCross ( x1, y1 );
      DrawCross ( x2, y2 );
      g.SetDrMd ( myrp, g.jam1 );
      re.SimpleRequest ( "Operation abgebrochen!", NIL );
   END EraseCrosses;

   (* Holt sich die Koordinaten eines Ausschnitts *)
   PROCEDURE GetRange ( VAR x1, y1, x2, y2 : INTEGER ) : BOOLEAN;
      VAR
         ratio : LONGREAL;
   BEGIN
      ratio := ( ymax - YMIN ) / xmax;
      g.SetDrMd ( myrp, compl );
      LOOP  (* Linke obere Ecke holen *)
         x1 := mywindow.mouseX;
         y1 := mywindow.mouseY;
         DrawCross ( x1, y1 );
         is.GetIMes ( mywindow, myclass, mycode, myaddress );
         IF i.mouseButtons IN myclass THEN EXIT END;
         DrawCross ( x1, y1 );
      END;
      LOOP  (* Rechte untere Ecke holen *)
         x2 := mywindow.mouseX;
         y2 := mywindow.mouseY;
         IF y2 > y1 THEN
            y2 := SHORT ( ENTIER ( y1 + ( x2 - x1 ) * ratio ) );
         ELSE
            y2 := SHORT ( ENTIER ( y1 + ( x1 - x2 ) * ratio ) );
         END;
         DrawCross ( x2, y2 );
         is.GetIMes ( mywindow, myclass, mycode, myaddress );
         IF i.mouseButtons IN myclass THEN EXIT END;
         DrawCross ( x2, y2 );
      END;
      g.SetDrMd ( myrp, g.jam1 );
      RETURN ( x1 < x2 ) AND ( y1 < y2 );
   END GetRange;

   (* Screen und Window initialisieren *)
   PROCEDURE InitScreenundWindow;
   BEGIN
      myscreen := is.SetScreen ( s.ADR ( "ApfelMenu © 1991 Bernd Braun" ),
                                 xmax, ymax, tiefe );
      r.Assert ( myscreen # NIL, "Fehler beim Screen!" );
      mywindow := is.SetWindow ( 0, 0, xmax, ymax, NIL,
                                 LONGSET { i.borderless, i.backDrop,
                                           i.activate, i.reportMouse },
                                 LONGSET { i.menuPick,
                                           i.mouseButtons  },
                                           myscreen );
      r.Assert ( mywindow # NIL, "Fehler beim Window!" );
      myrp := mywindow . rPort;
      myvp := myscreen . viewPort;
      SetColors ( myvp );
      g.SetAPen ( myrp, WHITE );
      g.RectFill ( myrp, 0, 0, xmax, ymax );
      (* Window für Req in Taskstruktur eintragen. *)
      myproc.windowPtr := mywindow;
   END InitScreenundWindow;

   (* Menues initialisieren *)
   PROCEDURE InitMenu;
   BEGIN
      myflag := SET { i.itemEnabled, i.itemText, i.highBox };

      (* 0. Menuitems eintragen. *)

      is.SetMenuItem ( menuItem [ 0, 4 ], menuItem [ 0, 5 ], 1, 44, 70, 10,
                       myflag, s.ADR ( "Ende" ) );
      is.SetMenuItem ( menuItem [ 0, 3 ], menuItem [ 0, 4 ], 1, 33, 70, 10,
                       myflag, s.ADR ( "Info" ) );
      is.SetMenuItem ( menuItem [ 0, 2 ], menuItem [ 0, 3 ], 1, 22, 70, 10,
                       myflag, s.ADR ( "Speichern" ) );
      is.SetMenuItem ( menuItem [ 0, 1 ], menuItem [ 0, 2 ], 1, 11, 70, 10,
                       myflag, s.ADR ( "Farben" ) );
      is.SetMenuItem ( menuItem [ 0, 0 ], menuItem [ 0, 1 ], 1, 0, 70, 10,
                       myflag, s.ADR ( "Malen" ) );

      (* 1. Menuitems eintragen. *)

      IF ymax = 512 THEN
         is.SetMenuItem ( menuItem [ 1, 1 ], menuItem [ 1, 2 ],0,11,75,10,
                          myflag, s.ADR ( "Nolace" ) );
      ELSE
         is.SetMenuItem ( menuItem [ 1, 1 ], menuItem [ 1, 2 ],0,11,75,10,
                          myflag, s.ADR ( "Interlace" ) );
      END;
      IF xmax = 640 THEN
         is.SetMenuItem ( menuItem [ 1, 0 ], menuItem [ 1, 1 ], 0, 0,75,10,
                          myflag, s.ADR ( "Lowres" ) );
      ELSE
         is.SetMenuItem ( menuItem [ 1, 0 ], menuItem [ 1, 1 ], 0, 0,75,10,
                          myflag, s.ADR ( "Hires" ) );
      END;

      (* 2. Menuitems eintragen. *)

      is.SetMenuItem ( menuItem [ 2, 2 ], menuItem [ 2, 3 ], 0, 22, 70, 10,
                       myflag, s.ADR ( "Reset" ) );
      is.SetMenuItem ( menuItem [ 2, 1 ], menuItem [ 2, 2 ], 0, 11, 70, 10,
                       myflag, s.ADR ( "Zoom raus" ) );
      is.SetMenuItem ( menuItem [ 2, 0 ], menuItem [ 2, 1 ], 0, 0, 70, 10,
                       myflag, s.ADR ( "Zoom rein" ) );

      (* 3. Menuitems eintragen. *)

      INCL ( myflag, i.checkIt );

      IF maxiter = 1000 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 6 ], menuItem [ 3, 7 ], 0, 66, 70, 10,
                       myflag, s.ADR ( "  1000" ) );
      menuItem [ 3, 6 ] . mutualExclude := LONGSET { 0 .. 5 };
      IF maxiter = 1000 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 500 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 5 ], menuItem [ 3, 6 ], 0, 55, 70, 10,
                       myflag, s.ADR ( "   500" ) );
      menuItem [ 3, 5 ] . mutualExclude := LONGSET { 0 .. 4, 6 };
      IF maxiter = 500 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 200 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 4 ], menuItem [ 3, 5 ], 0, 44, 70, 10,
                       myflag, s.ADR ( "   200" ) );
      menuItem [ 3, 4 ] . mutualExclude := LONGSET { 0 .. 3, 5 .. 6 };
      IF maxiter = 200 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 100 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 3 ], menuItem [ 3, 4 ], 0, 33, 70, 10,
                       myflag, s.ADR ( "   100" ) );
      menuItem [ 3, 3 ] . mutualExclude := LONGSET { 0 .. 2, 4 .. 6 };
      IF maxiter = 100 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 75 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 2 ], menuItem [ 3, 3 ], 0, 22, 70, 10,
                       myflag, s.ADR ( "    75" ) );
      menuItem [ 3, 2 ] . mutualExclude := LONGSET { 0 .. 1, 3 .. 6 };
      IF maxiter = 75 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 50 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 1 ], menuItem [ 3, 2 ], 0, 11, 70, 10,
                       myflag, s.ADR ( "    50" ) );
      menuItem [ 3, 1 ] . mutualExclude := LONGSET { 0, 2 .. 6 };
      IF maxiter = 50 THEN EXCL ( myflag, i.checked ) END;

      IF maxiter = 30 THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 3, 0 ], menuItem [ 3, 1 ], 0, 0, 70, 10,
                       myflag, s.ADR ( "    30" ) );
      menuItem [ 3, 0 ] . mutualExclude := LONGSET { 1 .. 6 };
      IF maxiter = 30 THEN EXCL ( myflag, i.checked ) END;

      (* 4. Menuitems eintragen. *)

      IF modus = a.Real THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 4, 2 ], menuItem [ 4, 3 ], 0, 22, 55, 10,
                       myflag, s.ADR ( "  REAL" ) );
      menuItem [ 4, 2 ] . mutualExclude := LONGSET { 0, 1 };
      IF modus = a.Real THEN EXCL ( myflag, i.checked ) END;

      IF modus = a.Long THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 4, 1 ], menuItem [ 4, 2 ], 0, 11, 55, 10,
                       myflag, s.ADR ( "  32Bit" ) );
      menuItem [ 4, 1 ] . mutualExclude := LONGSET { 0, 2 };
      IF modus = a.Long THEN EXCL ( myflag, i.checked ) END;

      IF modus = a.Word THEN INCL ( myflag, i.checked ) END;
      is.SetMenuItem ( menuItem [ 4, 0 ], menuItem [ 4, 1 ], 0, 0, 55, 10,
                       myflag, s.ADR ( "  16Bit" ) );
      menuItem [ 4, 0 ] . mutualExclude := LONGSET { 1, 2 };
      IF modus = a.Word THEN EXCL ( myflag, i.checked ) END;

      (* Menunamen eintragen. *)

      is.InitMenuStrip ( menustrip [ 4 ], menustrip [ 5 ], 250, 60, 10,
                         s.ADR ( "Zahlen" ), menuItem [ 4, 0 ] );
      is.InitMenuStrip ( menustrip [ 3 ], menustrip [ 4 ], 180, 70, 10,
                         s.ADR ( "Tiefe" ), menuItem [ 3, 0 ] );
      is.InitMenuStrip ( menustrip [ 2 ], menustrip [ 3 ], 140, 40, 10,
                         s.ADR ( "Zoom" ), menuItem [ 2, 0 ] );
      is.InitMenuStrip ( menustrip [ 1 ], menustrip [ 2 ], 70, 70, 10,
                         s.ADR ( "Graphic" ), menuItem [ 1, 0 ] );
      is.InitMenuStrip ( menustrip [ 0 ], menustrip [ 1 ],  1, 70, 10,
                         s.ADR ( "Projekt" ), menuItem [ 0, 0 ] );

      r.Assert ( i.SetMenuStrip ( mywindow, menustrip [ 0 ]^ ),
                 "Fehler beim Menu!" );
   END InitMenu;

   (* Hauptschleife des Programms *)
   PROCEDURE DoIt;
      VAR
         IMes         : POINTER TO i.IntuiMessage;
         result       : INTEGER;
         saveok       : BOOLEAN;
   BEGIN
      xmax    := 320;
      ymax    := 256;
      tiefe   := 4;
      farben  := ASH ( 1, tiefe );
      maxiter := 30;
      modus   := a.Word;

      (* Window in Taskstruktur für Req eintragen. *)
      myproc := s.VAL ( d.ProcessPtr, e.FindTask ( NIL ) );
      oldwindow := myproc.windowPtr;

      IF a.UebergebeWerte ( xmax, ymax, farben, modus ) THEN END;
      InitScreenundWindow;
      InitMenu;

      (* Window in Taskstruktur für Req eintragen. *)
      myproc := s.VAL ( d.ProcessPtr, e.FindTask ( NIL ) );
      oldwindow := myproc.windowPtr;
      myproc.windowPtr := mywindow;

      LOOP
         e.WaitPort ( mywindow.userPort );
         is.GetIMes ( mywindow, myclass, mycode, myaddress );
         IF ( i.menuPick IN myclass ) THEN
            MenuStrip := 0;
            MenuItem  := 0;
            is.CheckMenu ( mycode, MenuStrip, MenuItem );
            CASE MenuStrip OF
               0: CASE MenuItem OF
                     0  :  g.SetAPen  ( myrp, WHITE );
                           g.RectFill ( myrp, 0, 0, xmax, ymax );
                           a.BerechneBild ( myrp, maxiter, mywindow );
                  |  1  :  IF re.ColorRequester ( 0 ) # 0 THEN END;
                  |  2  :  IF re.FileRequest ( freqPtr ) THEN
                              saveok := if.SaveBitMap 
                                 ( wholefilePtr^, s.ADR ( myscreen.bitMap ),
                                   myscreen.viewPort.colorMap.colorTable,
                                   { if.cmpByteRun1 } );
                              IF saveok THEN
                                 re.SimpleRequest
                                 ( "Bild in %s gespeichert.",
                                 s.ADR ( wholefilePtr ) );
                              ELSE
                                 re.SimpleRequest
                                 ( "Kann Bild nicht in %s speichern!",
                                   s.ADR ( wholefilePtr ) );
                              END;
                           END;
                  |  3  :  re.SimpleRequest("\
ApfelMenu V3.6 11.7.1991\n\
     © Bernd Braun\n\
     Public Domain\
",NIL);
                  |  4  :  result := re.TwoGadRequest
                                     ( "Wirklich Programm beenden?", NIL );
                           IF result = 1 THEN
                              EXIT;
                           END;
                  END;
            |  1: CASE MenuItem OF
                     0: IF xmax = 320 THEN
                           xmax := 640;
                        ELSE
                           xmax := 320;
                        END;
                  |  1:IF ymax = 256 THEN
                           ymax := 512;
                        ELSE
                           ymax := 256;
                        END;
                  END;
                  WHILE NOT a.UebergebeWerte 
                            ( xmax, ymax, farben, modus ) DO
                  END;
                  Cleanup;
                  InitScreenundWindow;
                  InitMenu;
            |  2: CASE MenuItem OF
                     0: IF GetRange ( x1, y1, x2, y2 ) THEN
                           IF NOT a.BerechneWerte 
                                  ( x1, y1, x2, y2, modus ) THEN
                              re.SimpleRequest 
                              ( "Nehme größeren Zahlenbereich!", NIL );
                           END;
                           InitMenu;
                        ELSE
                           EraseCrosses ( x1, y1, x2, y2 );
                        END;
                  |  1: a.ZoomOut;
                  |  2: a.Reset;
                        modus  := a.Word;
                        maxiter := 30;
                        InitMenu;
                  END;
            |  3: CASE MenuItem OF
                     0: maxiter := 30;
                  |  1: maxiter := 50;
                  |  2: maxiter := 75;
                  |  3: maxiter := 100;
                  |  4: maxiter := 200;
                  |  5: maxiter := 500;
                  |  6: maxiter := 1000;
                  END;
            |  4: modus := MenuItem + 1;
                  IF NOT a.TestModus ( modus ) THEN
                     re.SimpleRequest
                     ( "Genauigkeitsbereich wird unterschritten!", NIL );
                     WHILE NOT a.TestModus ( modus ) DO
                     END;
                  END;
                  InitMenu;
            ELSE
            END;
         END;
      END;
   END DoIt;

BEGIN
   NEW ( freqPtr );
   r.Assert ( freqPtr # NIL, memerr );
   NEW ( wholefilePtr );
   r.Assert ( wholefilePtr # NIL, memerr );
   freqPtr.dir   := s.ADR ( dirstring );
   freqPtr.file  := s.ADR ( filestring );
   freqPtr.pathName := wholefilePtr;
   freqPtr.flags := LONGSET { re.infogadget,re.caching };
   freqPtr.dirnamescolor := 13;
   freqPtr.devicenamescolor := 10;
   freqPtr.show := "*";

   DoIt ();
CLOSE
   Cleanup ();

   IF freqPtr # NIL THEN
      DISPOSE ( freqPtr );
      freqPtr := NIL;
   END;
   IF wholefilePtr # NIL THEN
      DISPOSE ( wholefilePtr );
      wholefilePtr := NIL;
   END;
END Apfelmenu.