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

: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 V1.17.1
:Imports.    Apfelmann, IntuiSupport 
:History.    V1.0 31.Mai.1990 Erste Modula-2 Version
:History.    V2.0  3.Dez.1990 Erste Oberon Version

***********************************************************************)

MODULE Apfelmenu;

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

   IMPORT r  : Requests,
          e  : Exec,
          g  : Graphics,
          i  : Intuition,
          is : IntuiSupport,
          a  : ApfelMann,
          s  : SYSTEM;

   CONST
      WHITE    = 1;
      compl    = SHORTSET { g.complement };

   VAR
      myscreen  : i.ScreenPtr;
      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;

      xmax, ymax, x1, x2, y1, y2,
      tiefe, farben, 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,  0,  0,  5 );
      g.SetRGB4 ( v,  2,  0,  0, 10 );
      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 mywindow # NIL THEN
         i.ClearMenuStrip ( mywindow );
         i.CloseWindow    ( mywindow )
      END;
      IF myscreen # NIL THEN
         i.CloseScreen ( myscreen );
      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 );
      i.DisplayBeep ( myscreen );
   END EraseCrosses;

   (* Holt sich die Koordinaten eines Ausschnitts *)
   PROCEDURE GetRange ( VAR x1, y1, x2, y2 : INTEGER ) : BOOLEAN;
   BEGIN
      g.SetDrMd ( myrp, compl );
      LOOP  (* Linke obere Ecke holen *)
         y1 := mywindow.mouseY;
         x1 := mywindow.mouseX;
         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 *)
         y2 := mywindow.mouseY;
         x2 := mywindow.mouseX;
         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 ( "" ), xmax, ymax, tiefe );
      r.Assert ( myscreen # NIL, "Fehler beim Screen!" );
      mywindow := is.SetWindow ( 0, 0, xmax, ymax, s.ADR ( "" ),
                                 LONGSET { i.reportMouse, i.activate },
                                 LONGSET { i.menuPick, i.menuVerify, 
                                           i.mouseButtons, i.noCareRefresh },
                                           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 );
   END InitScreenundWindow;

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

      (* 0. Menuitems eintragen. *)

      is.SetMenuItem ( menuItem [ 0, 1 ], menuItem [ 0, 2 ], 1, 11, 50, 10,
                       myflag, s.ADR ( "Ende" ) );
      is.SetMenuItem ( menuItem [ 0, 0 ], menuItem [ 0, 1 ], 1, 0, 50, 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 out" ) );
      is.SetMenuItem ( menuItem [ 2, 0 ], menuItem [ 2, 1 ], 0, 0, 70, 10,
                       myflag, s.ADR ( "Zoom in" ) );

      (* 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, 80, 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, 80, 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, 80, 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, 80, 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, 80, 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, 80, 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, 80, 10,
                       myflag, s.ADR ( "    30" ) );
      menuItem [ 3, 0 ] . mutualExclude := LONGSET { 1 .. 5 };
      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 ], 255, 60, 10,
                         s.ADR ( "Zahlen" ), menuItem [ 4, 0 ] );
      is.InitMenuStrip ( menustrip [ 3 ], menustrip [ 4 ], 165, 90, 10,
                         s.ADR ( "Iteration" ), menuItem [ 3, 0 ] );
      is.InitMenuStrip ( menustrip [ 2 ], menustrip [ 3 ], 125, 40, 10,
                         s.ADR ( "Zoom" ), menuItem [ 2, 0 ] );
      is.InitMenuStrip ( menustrip [ 1 ], menustrip [ 2 ], 65, 60, 10,
                         s.ADR ( "Graphic" ), menuItem [ 1, 0 ] );
      is.InitMenuStrip ( menustrip [ 0 ], menustrip [ 1 ],  1, 64, 10,
                         s.ADR ( "Project" ), menuItem [ 0, 0 ] );

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

   (* Hauptschleife des Programms *)
   PROCEDURE DoIt;
   BEGIN
      xmax    := 320;
      ymax    := 256;
      tiefe   := 4;
      farben  := 16;
      maxiter := 30;
      modus   := a.Word;
      IF a.UebergebeWerte ( xmax, ymax, farben, modus ) THEN END;
      InitScreenundWindow;
      InitMenu;
      LOOP
         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  :  EXIT;
                  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
                           a.BerechneWerte ( x1, y1, x2, y2, modus );
                           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
                     i.DisplayBeep ( myscreen );
                     WHILE NOT a.TestModus ( modus ) DO
                     END;
                  END;
                  InitMenu;
            ELSE
            END;
         END;
      END;
   END DoIt;

BEGIN
   DoIt ();
CLOSE
   Cleanup ();
END Apfelmenu.