(* Copyright (C) 1989, 1990 Digital Equipment Corporation	*)
(* All rights reserved.						*)
(* See the file COPYRIGHT for a full description.		*)

(* File: xmenu2.i3						*)
(* Last modified on Thu Apr 12 01:18:06 1990 by muller		*)
(*      modified on Wed Feb 14 11:40:10 1990 by jerome		*)

(*==============================================================*)
(*	The X11 R4 Interface for Modula 3			*)
(*								*)
(*	The Athena Widgets Set Example (re)coded in Modula3	*)
(*==============================================================*)

(*
 * A more complicated Simple Menu Widget example.
 * 
 * November 30, 1989 - Chris D. Peterson
 *)

(*
 * $XConsortium: xmenu2.c,v 1.8 89/12/15 19:33:17 kit Exp $
 *
 * Copyright 1989 Massachusetts Institute of Technology
 *
 * Permission to use, copy, modify, distribute, and sell this software and its
 * documentation for any purpose is hereby granted without fee, provided that
 * the above copyright notice appear in all copies and that both that
 * copyright notice and this permission notice appear in supporting
 * documentation, and that the name of M.I.T. not be used in advertising or
 * publicity pertaining to distribution of the software without specific,
 * written prior permission.  M.I.T. makes no representations about the
 * suitability of this software for any purpose.  It is provided "as is"
 * without express or implied warranty.
 *
 * M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL M.I.T.
 * BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION
 * OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN 
 * CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)


MODULE xmenu2 EXPORTS Main;

FROM   M3toC   IMPORT	TtoS, StoT, PtoI, ItoP, UtoP, argc, argv;

IMPORT Fmt, Stdio, Wr, Cstring, Cstdlib, X, Xrm, Xt, XtN, Xaw;

(*	Function Name: Syntax
 *	Description: Prints a the calling syntax for this function to stdout.
 *	Arguments: app_con - the application context.
 *                 call - the name of the application.
 *	Returns: none - exits tho.
 *)

PROCEDURE Syntax (app_con: Xt.AppContext; call: Xt.String) =
BEGIN
    Xt.DestroyApplicationContext (app_con);
    Wr.PutText (Stdio.stdout, "Usage: ");
    Wr.PutText (Stdio.stdout, StoT (call));
    Wr.PutText (Stdio.stdout, " [-label <label name>]\n");
    Cstdlib.exit (1);
END Syntax;


(*	Function Name: MenuSelect
 *	Description: called whenever a menu item is selected.
 *	Arguments: w - the menu item that was selected.
 *                 number - the number of the menu item selected.
 *                 garbage - *** unused ***.
 *	Returns: 
 *)


PROCEDURE MenuSelect (w: Xt.Widget; 
                      client_data: ADDRESS;
                      <*UNUSED*> call_data: ADDRESS) =
VAR
    args := NEW (Xt.ArgList);
    numb: INTEGER := 0;
BEGIN
    numb := PtoI (client_data);
    Wr.PutText (Stdio.stdout, "Menu item ");
    Wr.PutText (Stdio.stdout, StoT (Xt.Name (w)));
    Wr.PutText (Stdio.stdout, " has been selected.\n");
    IF (numb = 0)    (* quit selected *)
       THEN Xt.DestroyApplicationContext (Xt.WidgetToApplicationContext (w));
            Cstdlib.exit (0)
    END;
    IF (status[numb] # 0)
       THEN args[0] := Xt.Arg {XtN.leftBitmap, NIL};
            status[numb] := 1
       ELSE args[0] := Xt.Arg {XtN.leftBitmap, UtoP (mark)};
            status[numb] := 0
    END;
    Xt.SetValues (w, args, 1);
END MenuSelect;


CONST
    NUM_MENU_ITEMS = 12;

VAR
    fb_res    := NEW (Xt.FallbackResList);
    items:    ARRAY [0..NUM_MENU_ITEMS] OF Xt.String;
    status:   ARRAY [0..NUM_MENU_ITEMS] OF INTEGER;
    app_con:  Xt.AppContext;
    mark:     X.Pixmap;
    root:     Xt.Widget;
    menu:     Xt.Widget;
    button:   Xt.Widget;    
    entry:    Xt.Widget;    

    xlogo16_width	:= 16;
    xlogo16_height	:= 16;
    xlogo16_bits:       Xt.String;

BEGIN

    fb_res[00] := TtoS ("*SimpleMenu*foreground:		SteelBlue");
    fb_res[01] := TtoS ("*SimpleMenu*menuLabel.foreground:	Gold");
    fb_res[02] := TtoS ("*SimpleMenu*line.foreground:		Grey");
    fb_res[03] := TtoS ("*menuButton.label:		Click here for menu");
    fb_res[04] := TtoS ("*SimpleMenu*menuLabel.vertSpace:	100");
    fb_res[05] := TtoS ("*SimpleMenu*menuLabel.leftMargin:	70");
    fb_res[06] := TtoS ("*SimpleMenu.label: 			Xmenu2 Menu");
    fb_res[07] := TtoS ("*SimpleMenu*quit*label:	Select this item to quit the menu demo.");
    fb_res[08] := TtoS ("*SimpleMenu*RowHeight:			16");
    fb_res[09] := TtoS ("*SimpleMenu*item7*sensitive: 		off");
    fb_res[10] := TtoS ("*SimpleMenu*HorizontalMargins:     	30");
    fb_res[11] := TtoS ("*menuLabel*font: -*-courier-medium-r-normal--34-*-100-100-*-*-iso8859-1");
    fb_res[12] := TtoS ("*item1*font: -*-courier-medium-r-normal--11-*-100-100-*-*-iso8859-1");
    fb_res[13] := TtoS ("*item2*font: -*-courier-bold-r-normal--11-*-100-100-*-*-iso8859-1");
    fb_res[14] := TtoS ("*item3*font: -*-courier-medium-r-normal--14-*-100-100-*-*-iso8859-1");
    fb_res[15] := TtoS ("*item4*font: -*-courier-bold-r-normal--14-*-100-100-*-*-iso8859-1");
    fb_res[16] := TtoS ("*item5*font: -*-courier-medium-r-normal--17-*-100-100-*-*-iso8859-1");
    fb_res[17] := TtoS ("*item6*font: -*-courier-bold-r-normal--17-*-100-100-*-*-iso8859-1");
    fb_res[18] := TtoS ("*item7*font: -*-courier-medium-r-normal--20-*-100-100-*-*-iso8859-1");
    fb_res[19] := TtoS ("*item8*font: -*-courier-bold-r-normal--20-*-100-100-*-*-iso8859-1");
    fb_res[20] := NIL;


    items[00]  :=  TtoS ("quit");
    items[01]  :=  TtoS ("item1");
    items[02]  :=  TtoS ("item2");
    items[03]  :=  TtoS ("item3");
    items[04]  :=  TtoS ("item4");
    items[05]  :=  TtoS ("item5");
    items[06]  :=  TtoS ("item6");
    items[07]  :=  TtoS ("item7");
    items[08]  :=  TtoS ("item8");
    items[09]  :=  TtoS ("menu1");
    items[10]  :=  TtoS ("menu2");
    items[11]  :=  TtoS ("menu3");

    xlogo16_bits := TtoS ("\017\200\036\200\074\100\170\040" &
	                  "\170\020\360\010\340\011\300\005" &
	                  "\300\002\100\007\040\017\040\036" &
	                  "\020\036\010\074\004\170\002\360");

    root := Xt.AppInitialize (app_con, TtoS ("Xmenu2"), NIL, 0,
			      argc, argv, fb_res);
    
    IF (argc # 1) THEN Syntax (app_con, argv[0]) END;

    button := Xt.CreateManagedWidget (TtoS ("menuButton"), 
                                      Xaw.menuButtonWidgetClass, root);
    
    menu := Xt.CreatePopupShell (TtoS ("menu"), 
                                 Xaw.simpleMenuWidgetClass, button);

    FOR i:= 0 TO NUM_MENU_ITEMS
        DO entry := Xt.CreateManagedWidget (items[i], 
                                            Xaw.smeBSBObjectClass, menu);
           Xt.AddCallback (entry, XtN.callback, MenuSelect, ItoP (i));
           (* 
            * Put a couple of line seperators in at the apropriate place. 
            *)
           IF (i = 4) THEN
              EVAL Xt.CreateManagedWidget (TtoS ("line"), 
                                           Xaw.smeLineObjectClass, menu) END;
           IF (i = 8) THEN
              EVAL Xt.CreateManagedWidget (TtoS ("blank"), 
                                           Xaw.smeObjectClass, menu) END;
           status[i] := 0;
        END;
    (*
     * Create the bitmap for marking selected items. 
     *)

    mark := X.XCreateBitmapFromData (Xt.Display (root),
				     X.XRootWindowOfScreen (Xt.Screen (root)),
				     xlogo16_bits,
                                     xlogo16_width,
                                     xlogo16_height);

    Xt.RealizeWidget (root);
    Xt.AppMainLoop (app_con);


END xmenu2.