Conference bulova::decw_jan-89_to_nov-90

    If this may be of some help.
    

    MBUTTONS.UIL
    
            <<< ELKTRA::NOTESPUBLIC:[NOTES$LIBRARY]DW_EXAMPLES.NOTE;1 >>>
                           -< "DECwindows examples" >-
================================================================================
Note 244.3   Looking for FORTRAN (Translation/Action table) example       3 of 4
HPSCAD::MBOUCHER                                     46 lines  20-SEP-1989 08:59
                       -< Fortran example, MBUTTONS.UIL >-
--------------------------------------------------------------------------------

module mbuttons
  version = 'v1.0'
  names = case_sensitive

procedure
  mbuttons_activate (integer);
  quit_activate     (integer);

value
  red                        : color('red', background);

object
  mbuttons_main : main_window {
    arguments {
      width = 600;
      height = 600;
      background_color = red;
      translations = translation_table
        ( '<Btn1Down>: MBUTTONS_ACTIVATE()');
    };
    controls { menu_bar   mbutton_menu_bar; };
};

object
  mbutton_menu_bar : menu_bar {
    controls { pulldown_entry file_menu_entry; };
};

object
  file_menu_entry : pulldown_entry {
    arguments { label_label = "File"; };
    controls  { pulldown_menu file_menu; };
};

object
  file_menu : pulldown_menu {
    controls { push_button m_quit_button; };
};
        
object
  m_quit_button : push_button {
    arguments { label_label = "Exit"; };
    callbacks { activate = procedure quit_activate (1); };
};      

end module;

    
        
    MBUTTONS.FOR
    
          <<< ELKTRA::NOTESPUBLIC:[NOTES$LIBRARY]DW_EXAMPLES.NOTE;1 >>>
                           -< "DECwindows examples" >-
================================================================================
Note 244.2   Looking for FORTRAN (Translation/Action table) example       2 of 4
HPSCAD::MBOUCHER                                    205 lines  20-SEP-1989 08:58
                       -< Fortran example, MBUTTONS.FOR >-
--------------------------------------------------------------------------------

      
    	PROGRAM MBUTTONS

C Fortran translation example, MBUTTONS.FOR
C
C       To compile and link, use the following commands:
C
C         $ FORTRAN MBUTTONS
C         $ LINK MBUTTONS, SYS$INPUT/OPT
C         SYS$SHARE:DECW$DWTLIBSHR/SHARE
C         SYS$LIBRARY:DECW$XLIBSHR/SHARE
C         $EXIT
C
C       Before running, MBUTTONS.UID must exist in your default
C       directory.  To create it, use the following commands:
C
C         $ DEFINE UIL$INCLUDE DECW$INCLUDE:
C         $ UIL MBUTTONS.UIL

	INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF'
	INCLUDE 'SYS$LIBRARY:DECW$DWTDEF'

	! Declare the widget IDs
	!
	INTEGER*4 TOPLEVEL_WIDGET, MBUTTONS_MAIN

	! Declare descriptor for the hierarchy file name and
	! the descriptor list
	!
	STRUCTURE /DESCRIPTOR_STRUCT/
	    INTEGER*2 LENGTH
	    BYTE DTYPE
	    BYTE CLASS
	    INTEGER*4 POINTER
	END STRUCTURE    !DESCRIPTOR_STRUCT
	RECORD /DESCRIPTOR_STRUCT/ HIERARCHY_FILE_DESCR

	INTEGER*4 HIERARCHY_NAME_LIST(0:0)  ! Array of pointers
	CHARACTER*(*) HIERARCHY_FILE_NAME
	PARAMETER (HIERARCHY_FILE_NAME = 'MBUTTONS.UID')

	! Define action pointer structure
	STRUCTURE /ACTION_TYPE/			!XtActionsRec type structure
	    INTEGER*4     ACTION_NAME		!name of action procedure
	    INTEGER*4     ACTION_POINTER	!pointer to action procedure
	    INTEGER*4     ZERO1
	    INTEGER*4     ZERO2
	END STRUCTURE
	RECORD /ACTION_TYPE/ CHAM_ACTION_TABLE  !name of action record

	! Declare callback routine argument list for DRM
	!
	RECORD /DWT$DRMREG_ARG/ CALLBACK_ARGLIST(1)

	! Declare attributes argument list
	!
	RECORD /DWT$ARG/ ARG_LIST(0:0)

	! Declare DRM hierarchy ID
	!
	INTEGER*4 DRM_HIERARCHY

	INTEGER*4 ARGC/0/,CLASS

	INTEGER*4 HIERARCHY_STATUS,FETCH_STATUS,REGISTER_STATUS

	! Declare callback routine and its name as a case-sensitive,
	! null-terminated string
	!
	EXTERNAL MBUTTONS_ACTIVATE,QUIT_ACTIVATE
	CHARACTER*(*) MBUTTONS_CALLBACK_NAME,QUIT_CALLBACK_NAME
	PARAMETER (MBUTTONS_CALLBACK_NAME = 
	1  'mbuttons_activate'//CHAR(0))
	PARAMETER (QUIT_CALLBACK_NAME = 
	1  'quit_activate'//CHAR(0))

	CHARACTER*80  MBUTTONS_CHAR_NAME
	CHARACTER*80 TEST_TRANSLATION_TABLE

	MBUTTONS_CHAR_NAME(1:17) = 'MBUTTONS_ACTIVATE'
	TEST_TRANSLATION_TABLE(1:35) = 
	1  '<Btn1Down>:   	MBUTTONS_ACTIVATE()'//char(0)

	! Set up the descriptor and arrays
	!
	HIERARCHY_FILE_DESCR.LENGTH  = LEN(HIERARCHY_FILE_NAME)
	HIERARCHY_FILE_DESCR.DTYPE   = DSC$K_DTYPE_T
	HIERARCHY_FILE_DESCR.CLASS   = DSC$K_CLASS_S
	HIERARCHY_FILE_DESCR.POINTER = %LOC(HIERARCHY_FILE_NAME)
	HIERARCHY_NAME_LIST(0)       = %LOC(HIERARCHY_FILE_DESCR)

        CHAM_ACTION_TABLE.ACTION_NAME    = %LOC(MBUTTONS_CHAR_NAME)
        CHAM_ACTION_TABLE.ACTION_POINTER = %LOC(MBUTTONS_ACTIVATE)
        CHAM_ACTION_TABLE.zero1          = 0
        CHAM_ACTION_TABLE.zero2          = 0

	CALLBACK_ARGLIST(1).DWT$A_DRMR_NAME  = %LOC(MBUTTONS_CALLBACK_NAME)
	CALLBACK_ARGLIST(1).DWT$L_DRMR_VALUE = %LOC(MBUTTONS_ACTIVATE)
	CALLBACK_ARGLIST(2).DWT$A_DRMR_NAME  = %LOC(QUIT_CALLBACK_NAME)
	CALLBACK_ARGLIST(2).DWT$L_DRMR_VALUE = %LOC(QUIT_ACTIVATE)

	! Initialize the Digital Resource Manager
	!
	CALL DWT$INITIALIZE_DRM

	! Initialize the toolkit.  This call returns the ID of the
	! "toplevel" widget.  The application's "main" widget must be
	! the only child of this widget.
	!
	TOPLEVEL_WIDGET = XT$INITIALIZE (
	1   'mbuttons',		! NAME
	2   'mbuttonsclass',	! CLASS
	3   %VAL(0),		! URLIST (omitted)
	4   0,			! URCOUNT
	5   ARGC,		! ARGCOUNT
	6   %VAL(0))		! ARGVALUE

	!add new action table entry to existing action table
	!
	CALL XT$ADD_ACTIONS (CHAM_ACTION_TABLE,1)

	!return parsed translation table
	!
	CALL XT$PARSE_TRANSLATION_TABLE(TEST_TRANSLATION_TABLE(1:34))

	! Open the DRM hierarchy (only one file)
	!
	HIERARCHY_STATUS = DWT$OPEN_HIERARCHY (
	1   1,
	2   HIERARCHY_NAME_LIST,
	3   %VAL(0),	    ! ANCILIARY_STRUCTURES_LIST
	3   DRM_HIERARCHY)
	IF (HIERARCHY_STATUS .NE. DWT$C_DRM_SUCCESS) THEN
	    TYPE *,'Can''t open hierarchy, status = ',HIERARCHY_STATUS
	    STOP
	END IF

	! Register our callback routine so that the resource manager
	! can resolve it at widget-creation time
	!
	REGISTER_STATUS = DWT$REGISTER_DRM_NAMES (CALLBACK_ARGLIST,2)
	IF (REGISTER_STATUS .NE. DWT$C_DRM_SUCCESS) THEN
	    TYPE *,'Can''t register callback, status = ',REGISTER_STATUS
	    STOP
	END IF

	! Call DRM to fetch and create the pushbutton and its container
	!
	FETCH_STATUS = DWT$FETCH_WIDGET (
	1   %VAL(DRM_HIERARCHY),! HIERARCHY_ID
	2   'mbuttons_main',	! INDEX
	3   TOPLEVEL_WIDGET,	! PARENT
	4   MBUTTONS_MAIN,	! W_RETURN
	5   CLASS)		! CLASS_RETURN
	IF (FETCH_STATUS .NE. DWT$C_DRM_SUCCESS) THEN
	    TYPE *,'Can''t fetch interface, status = ',FETCH_STATUS
	    STOP
	END IF
	
	! Make the toplevel widget "manage" the pushbutton (or
	! whatever the UIL defines as the topmost widget).  This
	! will cause it to be "realized" when the toplevel widget
	! is "realized".
	!
	CALL XT$MANAGE_CHILD (MBUTTONS_MAIN)

	! Realize the toplevel widget.  This will cause the entire
	! "managed" widget hierarchy to be displayed.
	!
	CALL XT$REALIZE_WIDGET (TOPLEVEL_WIDGET)

	! Loop and process events
	!
	CALL XT$MAIN_LOOP

	! Control never returns here

	END


	! callback routine
	SUBROUTINE MBUTTONS_ACTIVATE (WIDGET, BEVENT, TAG, REASON)
	INCLUDE 'SYS$LIBRARY:DECW$XLIBDEF'
	INCLUDE 'SYS$LIBRARY:DECW$DWTDEF'

	RECORD /x$button_event/ BEVENT

	INTEGER*4 WIDGET, TAG, REASON

	WRITE(6,100)BEVENT.x$l_btev_x,BEVENT.x$l_btev_y
100	FORMAT(' Button1 pressed at (',I3,', ',I3,')')

-->         add here your DIALOG BOX code                      <--

    
    	RETURN
	END


	SUBROUTINE QUIT_ACTIVATE (W,TAG,REASON)
C	Routine called when the user pushes the Quit button to
C	exit the application.

	INTEGER*4 W,TAG,REASON

	CALL EXIT(1)
	RETURN
	END