home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / M2V11-1.LHA / modula / examples / src / NLMenu.mod < prev    next >
Encoding:
Text File  |  1994-10-03  |  7.2 KB  |  259 lines
  1. MODULE NLMenu ; (* Converted from example in 3.1 native developers update *)
  2.  
  3. (* Demo shows off the new look menu features of V39. *)
  4.  
  5. IMPORT
  6.   S    := SYSTEM,
  7.   SLib := StdLib,
  8.   M2   := M2Lib,
  9.   E    := Exec,
  10.   U    := Utility,
  11.   G    := Graphics{39},
  12.   I    := Intuition{39},
  13.   CL   := Classes,
  14.   GT   := GadTools{39},
  15.   DF   := DiskFont{37},
  16.   Dos  := Dos{37} ;
  17.  
  18. VAR
  19.   mynewmenu    : ARRAY [0..20] OF GT.NewMenu ;
  20.   customtattr    : G.TextAttr ;
  21.   tattr        : G.TextAttrPtr ;
  22.   mysc        : I.ScreenPtr ;
  23.   menu        : I.MenuPtr ;
  24.   mywin        : I.WindowPtr ;
  25.   customfont    : G.TextFontPtr  ;
  26.   vi        : S.ADDRESS ;
  27.   dri        : I.DrawInfoPtr ;
  28.   checkimage    : I.ImagePtr ;
  29.   amigakeyimage : I.ImagePtr ;
  30.   terminated    : BOOLEAN ;
  31.  
  32. (*------------------------------------------------------------------------*)
  33.  
  34. PROCEDURE bail_out( int : LONGINT ) ; FORWARD ;
  35. PROCEDURE HandleMenuEvent( UWORD : CARDINAL ) : BOOLEAN ; FORWARD ;
  36.  
  37. (*------------------------------------------------------------------------*)
  38.  
  39. PROCEDURE MoreTags( ) : U.Tag ;
  40. BEGIN
  41.   IF customfont = NIL THEN RETURN U.TAG_END
  42.   ELSE RETURN U.TAG_MORE
  43.   END ;
  44. END MoreTags ;
  45.  
  46. PROCEDURE main( ) ;
  47.   VAR
  48.     imsg      : I.IntuiMessagePtr ;
  49.     imsgClass : LONGSET ;
  50.     imsgCode  : CARDINAL ;
  51.     moretags  : ARRAY [0..2] OF U.TagItem ;
  52. BEGIN
  53.   terminated := FALSE ;
  54.  
  55.   IF M2.argc = 2 THEN
  56.     Dos.Printf("Usage:\n\tnlmenu\nor\n\tnlmenu fontname.font fontsize\n");
  57.     Dos.Printf("Example:\n\tnlmenu courier.font 15\n");
  58.     bail_out(0);
  59.   END ;
  60.  
  61.   mysc := I.LockPubScreen( NIL ) ;
  62.   IF mysc = NIL THEN bail_out(0) END;
  63.  
  64.   vi := GT.GetVisualInfo( mysc, U.TAG_DONE ) ;
  65.   IF vi = NIL THEN bail_out(0) END;
  66.  
  67.   dri := I.GetScreenDrawInfo( mysc ) ;
  68.   IF dri = NIL THEN bail_out(0) END;
  69.  
  70.   IF M2.argc < 3 THEN (* Default to screen's font *)
  71.     tattr := mysc^.Font
  72.   ELSE
  73.     customtattr.ta_Style := { } ;
  74.     customtattr.ta_Flags := { } ;
  75.  
  76.     (* Attempt to use the font specified on the command line: *)
  77.     customtattr.ta_Name := M2.argv^[1] ;
  78.  
  79.     (* Convert decimal size to long *)
  80.     customtattr.ta_YSize := SLib.atol(M2.argv^[2]) ;
  81.     tattr := S.ADR( customtattr ) ;
  82.  
  83.     customfont := DF.OpenDiskFont( tattr ) ;
  84.     IF customfont = NIL THEN
  85.       Dos.Printf("Could not open font %s %ld\n", customtattr.ta_Name,
  86.       customtattr.ta_YSize);
  87.       bail_out(20);
  88.     END ;
  89.  
  90.     (* Generate a custom checkmark whose size matches our custom font *)
  91.     checkimage := CL.NewObject(
  92.         NIL, "sysiclass",
  93.         CL.SYSIA_DrawInfo, dri,
  94.         CL.SYSIA_Which, CL.MENUCHECK,
  95.         CL.SYSIA_ReferenceFont, customfont, (* If NIL, uses dri_Font *)
  96.         U.TAG_DONE ) ;
  97.  
  98.     IF checkimage = NIL THEN bail_out(20) END ;
  99.  
  100.     (* Generate a custom Amiga-key image whose size matches our custom font*)
  101.  
  102.     amigakeyimage := CL.NewObject(
  103.         NIL, "sysiclass",
  104.         CL.SYSIA_DrawInfo, dri,
  105.         CL.SYSIA_Which, CL.AMIGAKEY,
  106.         CL.SYSIA_ReferenceFont, customfont, (* If NIL, uses dri_Font *)
  107.         U.TAG_DONE ) ;
  108.     IF amigakeyimage = NIL THEN bail_out(20) END ;
  109.   END ;
  110.  
  111.   (* Build and layout menus using the right font: *)
  112.   menu := GT.CreateMenus( mynewmenu , U.TAG_DONE ) ;
  113.   IF menu = NIL THEN bail_out( 20 ) END ;
  114.  
  115.   (* These are only necessary if a custom font was supplied... *)
  116.   moretags := [[GT.GTMN_Checkmark,checkimage],
  117.                [GT.GTMN_AmigaKey,amigakeyimage],
  118.                [U.TAG_DONE]];
  119.  
  120.   IF ~GT.LayoutMenus(  menu, vi,
  121.                GT.GTMN_TextAttr, tattr,
  122.                GT.GTMN_NewLookMenus, TRUE,
  123.                MoreTags( ) , moretags ) THEN bail_out(20) END ;
  124.  
  125.   (* These are only necessary if a custom font was supplied...    *)
  126.   (* Note: we re-use some of the tag-array initializations from above *)
  127.  
  128.   moretags[0].ti_Tag := I.WA_Checkmark;
  129.   moretags[1].ti_Tag := I.WA_AmigaKey;
  130.  
  131.   mywin := I.OpenWindowTags( NIL,
  132.     I.WA_Width, 500,
  133.     I.WA_InnerHeight, 100,
  134.     I.WA_Top, 50,
  135.  
  136.     I.WA_Activate, TRUE,
  137.     I.WA_DragBar, TRUE,
  138.     I.WA_DepthGadget, TRUE,
  139.     I.WA_CloseGadget, TRUE,
  140.     I.WA_SizeGadget, TRUE,
  141.     I.WA_SmartRefresh, TRUE,
  142.  
  143.     (* NOTE: NOCAREREFRESH is not allowed if you use GadTools Gadgets! *)
  144.     I.WA_NoCareRefresh, TRUE,
  145.  
  146.     I.WA_IDCMP, I.CLOSEWINDOW+I.MENUPICK,
  147.  
  148.     I.WA_MinWidth, 50,
  149.     I.WA_MinHeight, 50,
  150.     I.WA_Title, "GadTools Menu Demo",
  151.     I.WA_NewLookMenus, TRUE,
  152.     MoreTags( ) , moretags ) ;
  153.  
  154.   IF mywin = NIL THEN bail_out( 20 ) END ;
  155.  
  156.   I.SetMenuStrip( mywin , menu ) ;
  157.  
  158.   WHILE ~terminated DO
  159.     E.Wait( {mywin^.UserPort^.mp_SigBit} ) ;
  160.  
  161.     (* NOTE:  If you use GadTools gadgets, you must use GT_GetIMsg( ) *)
  162.     (* and GT_ReplyIMsg() instead of GetMsg() and ReplyMsg( ).          *)
  163.     (* Regular GetMsg() and ReplyMsg() are safe if the only part      *)
  164.     (* of GadTools you use are menus...                      *)
  165.  
  166.     LOOP
  167.       IF terminated THEN EXIT END ;
  168.       imsg := E.GetMsg( mywin^.UserPort ) ;
  169.       IF imsg = NIL THEN EXIT END ;
  170.       imsgClass := imsg^.Class ;
  171.       imsgCode := imsg^.Code ;
  172.       E.ReplyMsg( imsg ) ;
  173.       IF imsgClass = I.MENUPICK THEN
  174.     terminated := HandleMenuEvent( imsgCode )
  175.       ELSIF imsgClass = I.CLOSEWINDOW THEN
  176.     Dos.Printf("CLOSEWINDOW.\n") ;
  177.     terminated := TRUE
  178.       END ;
  179.     END ;
  180.   END ;
  181.   bail_out( 0 ) ;
  182. END main ;
  183.  
  184. (*------------------------------------------------------------------------*)
  185.  
  186. PROCEDURE bail_out( code : LONGINT );
  187. (* Function to close down or free any opened or allocated stuff, and then exit*)
  188. BEGIN
  189.   IF mywin # NIL THEN I.ClearMenuStrip( mywin ) ; I.CloseWindow( mywin ) END ;
  190.  
  191.   (* None of these two calls mind a NIL parameter, so it's not *)
  192.   (* necessary to check for non-NIL before calling.           *)
  193.  
  194.   GT.FreeMenus( menu ) ;
  195.   GT.FreeVisualInfo( vi ) ;
  196.  
  197.   IF dri # NIL THEN I.FreeScreenDrawInfo( mysc , dri ) END ;
  198.   IF customfont # NIL THEN
  199.     CL.DisposeObject( amigakeyimage ) ;
  200.     CL.DisposeObject( checkimage ) ;
  201.     G.CloseFont( customfont ) ;
  202.   END ;
  203.   IF mysc # NIL THEN I.UnlockPubScreen( NIL , mysc ) END ;
  204.   SLib.exit( code ) ;
  205. END bail_out ;
  206.  
  207. (*------------------------------------------------------------------------*)
  208.  
  209. PROCEDURE HandleMenuEvent( code : CARDINAL ) : BOOLEAN ;
  210. (* This function handles IntuiMessage events of type MENUPICK.*)
  211. BEGIN RETURN FALSE
  212.   (* Your code goes here *)
  213. END HandleMenuEvent ;
  214.  
  215. (*------------------------------------------------------------------------*)
  216.  
  217. CONST
  218.   Not1 = -2 ; (* ~1 *)
  219.   Not2 = -3 ; (* ~2 *)
  220.   Not4 = -5 ; (* ~4 *)
  221.  
  222. BEGIN
  223. (* Here we specify what we want our menus to contain: *)
  224.  mynewmenu :=
  225.        [[ GT.NM_TITLE, "Project",    NIL,{ }, 0, 0],
  226.     [ GT.NM_ITEM , "Open...",    "O",{ }, 0, 0],
  227.     [ GT.NM_ITEM , "Save",          NIL,{ }, 0, 0],
  228.     [ GT.NM_ITEM , GT.NM_BARLABEL,  NIL,{ }, 0, 0],
  229.     [ GT.NM_ITEM , "Print",          NIL,{ }, 0, 0],
  230.     [ GT.NM_SUB  , "Draft",          NIL, I.CHECKIT+I.CHECKED, Not1, 0],
  231.     [ GT.NM_SUB  , "NLQ",          NIL, I.CHECKIT, Not2, 0],
  232.     [ GT.NM_SUB  , "Laser",          NIL, I.CHECKIT, Not4, 0],
  233.     [ GT.NM_ITEM , GT.NM_BARLABEL,  NIL,{ }, 0, 0],
  234.     [ GT.NM_ITEM , "Quit...",    "Q",{ }, 0, 0],
  235.  
  236.     [ GT.NM_TITLE, "Edit",          NIL,{ }, 0, 0],
  237.     [ GT.NM_ITEM , "Cut",         "X",{ }, 0, 0],
  238.     [ GT.NM_ITEM , "Copy",         "C",{ }, 0, 0],
  239.     [ GT.NM_ITEM , "Paste",         "V",{ }, 0, 0],
  240.     [ GT.NM_ITEM , GT.NM_BARLABEL,  NIL,{ }, 0, 0],
  241.     [ GT.NM_ITEM , "Undo",         "Z",{ }, 0, 0],
  242.  
  243.     [ GT.NM_END  , NIL,        NIL,{ }, 0, 0]] ;
  244.  
  245.   customtattr    := []  ;
  246.   tattr        := NIL ;
  247.   mysc        := NIL ;
  248.   menu        := NIL ;
  249.   mywin        := NIL ;
  250.   customfont    := NIL ;
  251.   vi        := NIL ;
  252.   dri        := NIL ;
  253.   checkimage    := NIL ;
  254.   amigakeyimage := NIL ;
  255.   terminated    := FALSE ;
  256.  
  257.   main( ) ;
  258. END NLMenu.
  259.