MODULE popDemo;

(* Programm zur Demo von PoPUp-Menüs. M2Amiga V.3.2.

                                 Jochen (SIGMA) für A.I.T. (16-2-89)
                   *)

FROM Intuition IMPORT  CloseWindow, WindowPtr, menuNull,
                       IDCMPFlagSet, IDCMPFlags, SetWindowTitles,
                       IntuiMessagePtr, ScreenPtr, CloseScreen;
FROM Graphics   IMPORT RastPortPtr, ViewPortPtr, SetAPen, DrawEllipse,
                       Draw, Move;
FROM Fenster    IMPORT BildSchirm, FensterAuf, Info, CLS, Farben,
                       Print;
FROM popMenu    IMPORT GetMenuAdresse, itemType;
FROM pop        IMPORT PopChoose;
FROM SYSTEM     IMPORT ADR;
FROM Exec       IMPORT MsgPortPtr;
FROM InputEvent IMPORT rButton;
FROM Arts       IMPORT TermProcedure, CurrentLevel;

CONST
  b   = 640;  h = 236;      (* Bildschirmgröße *)
  x0  = 20;  y0 = 32;       (* Textanfang      *)
  xm  = 319; ym = h/2+19;   (* Bildschirmmitte *)
  a0  = 160; b0 = a0/2;     (* Zeichenfläche   *)
  FensterTitel="      PopUp-Menü Demo      ";
  ScreenTitel =" M2_Kurs.9f PopUp-Menü Demo ";
  t1 = "... Hier stand der SigmaText .....";
  t2 = "... Hier stand der KursText ......";
  t3 = "... Hier stand der EchoText ......";

TYPE
  str       = ARRAY[0..99] OF CHAR;

VAR
  f                   :CARDINAL;
  wPtr                :WindowPtr;
  sPtr                :ScreenPtr;
  uPtr                :MsgPortPtr;
  rPtr                :RastPortPtr;
  vPtr                :ViewPortPtr;
  imPtr               :IntuiMessagePtr;
  fertig              :BOOLEAN;
  myLevel             :INTEGER;

PROCEDURE CleanUp;
  BEGIN
    IF myLevel >= CurrentLevel() THEN
      IF wPtr # NIL THEN CloseWindow(wPtr) END;
      IF sPtr # NIL THEN CloseScreen(sPtr) END;
   END;
  END CleanUp;

PROCEDURE Initialisierung;
  BEGIN
    sPtr := BildSchirm(); (* Screen auf. *)
    wPtr := FensterAuf(0,9,b,h,FensterTitel,sPtr);
    uPtr := wPtr^.userPort;
    rPtr := wPtr^.rPort;
    vPtr := ADR(sPtr^.viewPort);
    Farben(vPtr);
    CLS(rPtr,b,h);
  END Initialisierung;

PROCEDURE PrintText(t:str);
  BEGIN
    CLS(rPtr,b,h);
      Print(rPtr,f,x0,y0,t);
  END PrintText;


PROCEDURE ZeichneKreis;
  BEGIN
    CLS(rPtr,b,h);
    SetAPen(rPtr,f);
    DrawEllipse(rPtr,xm,ym,a0,b0);
  END ZeichneKreis;

PROCEDURE ZeichneRechteck;
  BEGIN
    CLS(rPtr,b,h);
    SetAPen(rPtr,f);
    Move(rPtr,129,27);
    Draw(rPtr,529,27);Draw(rPtr,529,190);
    Draw(rPtr,129,190);Draw(rPtr,129,27);
  END ZeichneRechteck;

PROCEDURE ProcessRequest(value:INTEGER;VAR quit:BOOLEAN);
  BEGIN
    IF value>-1 THEN         (* ... something wonderful happened ... *)
       CASE itemType(value) OF
         | Kreis    : ZeichneKreis;
         | Rechteck : ZeichneRechteck;
         | rot      : f := 1;
         | gruen    : f := 2;
         | blau     : f := 3;
         | SIGMA    : PrintText(t1);
         | Kurs     : PrintText(t2);
         | Echo     : PrintText(t3);
         | Quit     : quit := TRUE;
       END;
    END;
    SetWindowTitles(wPtr,ADR(FensterTitel),ADR(ScreenTitel));
  END ProcessRequest;

PROCEDURE ProcessMenu;
  VAR
    finish   :BOOLEAN;
    class    :IDCMPFlagSet;
    code     :CARDINAL;
    value    :INTEGER;
  BEGIN
    finish := FALSE;
    REPEAT
      class := Info(uPtr,code);
      IF (mouseButtons IN class) AND (code=rButton) THEN
         value := PopChoose(GetMenuAdresse(),wPtr);
         ProcessRequest(value,finish)
      END;
      IF closeWindow IN class THEN finish := TRUE END;
    UNTIL finish;
  END ProcessMenu;


BEGIN             (* Beginn des eigentlichen Programms!!! *)
  myLevel := CurrentLevel();
  TermProcedure(CleanUp); (* Die TermProcedure sollte möglichst weit vorne
                             im Hauptprogramm stehen!        *)
  Initialisierung;

  f := 1;         (* Ausgangsfarbe setzen                    *)

  SetWindowTitles(wPtr,ADR(FensterTitel),ADR(ScreenTitel));

  ProcessMenu;    (* Hier tut sich was!           *)

END popDemo.mod