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

:Program.    IntuiSupport.mod
:Contens.    Ein Modul zur Unterstützung von Screens, Window, Menus 
:Contens.    und Messages.
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Oberon
:Translator. Amiga Oberon A+L V2.0
:Support.    Modula-2 Version von Hannes Heckner
:History.    V1.0 1.Dez.1990

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

MODULE IntuiSupport;

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

   IMPORT e : Exec,
          g : Graphics,
          i : Intuition,
          s : SYSTEM;

   CONST
      BackPen = -2;

   PROCEDURE SetScreen* ( titel         : e.ADDRESS;
                          wid, hei, dep : INTEGER   ) : i.ScreenPtr;
      VAR
         bs    : i.NewScreen;
         erg   : i.ScreenPtr;
         modes : SET;
   BEGIN
      modes := SET {};
      IF wid > 320 THEN INCL ( modes, g.hires ) END;
      IF hei > 256 THEN INCL ( modes, g.lace  ) END;
      bs.leftEdge  := 0;
      bs.topEdge   := 0;
      bs.width     := wid;
      bs.height    := hei;
      bs.depth     := dep;
      bs.detailPen := 0;
      bs.blockPen  := BackPen;
      bs.viewModes := modes;
      bs.type      := i.customScreen;
      bs.defaultTitle := titel;
      bs.font      := NIL;
      bs.gadgets   := NIL;
      bs.customBitMap := NIL;
      erg := i.OpenScreen ( bs );
      RETURN erg;
   END SetScreen;

   PROCEDURE SetWindow* ( inix, iniy, wid, hei : INTEGER;
                          titel                : e.ADDRESS;
                          windowflags          : LONGSET;
                          idcmpflags           : LONGSET;
                          schirm               : i.ScreenPtr ) : i.WindowPtr;
      VAR
         wi    : i.NewWindow;
         werg  : i.WindowPtr;
   BEGIN
      wi.leftEdge    := inix;
      wi.topEdge     := iniy;
      wi.width       := wid;
      wi.height      := hei;
      wi.detailPen   := 0;
      wi.blockPen    := BackPen;
      wi.idcmpFlags  := idcmpflags;
      wi.flags       := windowflags;
      wi.title       := titel;
      wi.screen      := schirm;
      wi.type        := i.customScreen;
      wi.firstGadget := NIL;
      wi.checkMark   := NIL;
      wi.bitMap      := NIL;
      wi.minWidth    := 50;
      wi.minHeight   := 30;
      wi.maxWidth    := 640;
      wi.maxHeight   := 512;
      werg := i.OpenWindow ( wi );
      RETURN werg;
   END SetWindow;

   PROCEDURE GetIMes* (     window   : i.WindowPtr;
                        VAR getclass : LONGSET;
                        VAR getcode  : INTEGER;
                        VAR getadr   : e.ADDRESS );
   VAR
      IMes : POINTER TO i.IntuiMessage;
   BEGIN
      getclass := LONGSET {};
      getcode  := 0;
      getadr   := NIL;
      IMes := e.GetMsg ( window.userPort );
      IF IMes # NIL THEN
         getclass := IMes.class;
         getcode  := IMes.code;
         getadr   := IMes.iAddress;
         e.ReplyMsg ( IMes );
      END;
   END GetIMes;

   PROCEDURE SetIntuiText* ( text : e.ADDRESS ) : e.ADDRESS;
      VAR
         IntuText : i.IntuiTextPtr;
   BEGIN
      NEW ( IntuText );
      IntuText.frontPen    := 0;
      IntuText.backPen     := MAX(SHORTINT)+BackPen;
      IntuText.drawMode    := g.jam1;
      IntuText.leftEdge    := 0;
      IntuText.topEdge     := 0;
      IntuText.iTextFont   := NIL;
      IntuText.nextText    := NIL;
      IntuText.iText       := text;
      RETURN IntuText;
   END SetIntuiText;

   PROCEDURE InitMenuStrip* ( VAR menustrip   : i.MenuPtr;
                                  nmenu       : i.MenuPtr;
                                  le, wi, he  : INTEGER;
                                  name        : e.ADDRESS;
                                  menuitemPtr : i.MenuItemPtr );
      VAR
         zwischen : i.MenuPtr;
   BEGIN
      NEW ( zwischen );
      menustrip := zwischen;
      menustrip.nextMenu    := nmenu;
      menustrip.leftEdge    := le;
      menustrip.topEdge     := 0;
      menustrip.width       := wi;
      menustrip.height      := he;
      menustrip.flags       := { 0 };
      menustrip.menuName    := name;
      menustrip.firstItem   := menuitemPtr;
   END InitMenuStrip;

   PROCEDURE SetMenuItem* ( VAR menuitemPtr      : i.MenuItemPtr;
                                neitem           : i.MenuItemPtr;
                                left, tp, wi, he : INTEGER;
                                fl               : SET;
                                name             : e.ADDRESS );
      VAR
         zwischen : i.MenuItemPtr;
   BEGIN
      NEW ( zwischen );
      menuitemPtr := zwischen;
      menuitemPtr.nextItem       := neitem;
      menuitemPtr.leftEdge       := left;
      menuitemPtr.topEdge        := tp;
      menuitemPtr.width          := wi;
      menuitemPtr.height         := he;
      menuitemPtr.flags          := fl;
      menuitemPtr.mutualExclude  := LONGSET {};
      menuitemPtr.itemFill       := SetIntuiText ( name );
      menuitemPtr.selectFill     := NIL;
      menuitemPtr.subItem        := NIL;
   END SetMenuItem;

   PROCEDURE CheckMenu* (     mycode              : INTEGER;
                          VAR MenuStrip, MenuItem : INTEGER );
   BEGIN
      MenuStrip := mycode;
      MenuStrip := ASH ( MenuStrip,  11 );
      MenuStrip := ASH ( MenuStrip, -11 );
      MenuItem  := mycode;
      MenuItem  := ASH ( MenuItem,   6 );
      MenuItem  := ASH ( MenuItem, -11 );
   END CheckMenu;

END IntuiSupport.