PROGRAM HELLOWORLD
C+
C
C  Copyright 2003 Hewlett-Packard Development Company, L.P.
C
C  Confidential computer software. Valid license from HP and/or its 
C  subsidiaries required for possession, use, or copying. Consistent with 
C  FAR 12.211 and 12.212, Commercial Computer Software, Computer Software 
C  Documentation, and Technical Data for Commercial Items are licensed to 
C  the U.S. Government under vendor's standard commercial license
C 
C ABSTRACT: 
C 
C	 Example program to demonstrate use of the Motif toolkit from FORTRAN.
C
C        To compile and link:
C
C	  $ FORTRAN DECW$EXAMPLES:HELLOMOTIF
C	  $ LINK HELLOMOTIF,SYS$INPUT:/OPTIONS
C           SYS$LIBRARY:DECW$XTLIBSHRR5/SHARE
C	    SYS$LIBRARY:DECW$DXMLIBSHR12/SHARE
C           SYS$LIBRARY:DECW$MRMLIBSHR12/SHARE
C
C        To run, HELLOMOTIF.UID must be in your default directory.
C        To create it:
C
C	  $ UIL/MOTIF DECW$EXAMPLES:HELLOMOTIF
C
C        Then:
C
C	  $ RUN HELLOMOTIF
C
C        A window will be displayed that will contain a pushbutton widget that
C        says "Hello World!".  Click once on the button to cause the callback
C        routine to be called to change the label.  The second click on the
C        button will exit the program.
C
C	 
C 
C AUTHOR(S): 
C 
C	 Steven B. Lionel, Digital Equipment Corporation
C 
C CREATION DATE: 
C 
C	 20-December-1990
C 
C DESIGN:
C  
C     Based on HELLOWORLD.FOR, translated and modified from the original
C     'C' version by the author.
C  
C 
C MODIFICATION HISTORY:
C 
C	 Date     | Name  | Description
C ----------------+-------+-----------------------------------------------------
C 20-Dec-1990     |  SBL  | Original Motif version.
C ----------------+-------+-----------------------------------------------------
C [change_entry]
C-

	INCLUDE 'SYS$LIBRARY:DECW$MOTIF'

	! Declare the two widget IDs
	!
	INTEGER*4 TOPLEVEL, HELLOWORLD_MAIN

	! UID file specification and pointer array
	CHARACTER*(*) HIERARCHY_FILE_NAME
	PARAMETER (HIERARCHY_FILE_NAME = 'HELLOMOTIF.UID'//CHAR(0))
	INTEGER*4 HIERARCHY_FILE_NAME_ARRAY (0:0)

	! Declare callback routine and its name as a case-sensitive,
	! null-terminated string
	!
	EXTERNAL HELLOWORLD_BUTTON_ACTIVATE
	CHARACTER*(*) CALLBACK_NAME
	PARAMETER (CALLBACK_NAME = 
	1  'helloworld_button_activate'//CHAR(0))

	! Declare callback routine argument list for resource manager
	!
	RECORD /MrmRegisterArg/ CALLBACK_ARGLIST(0:0)

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

	INTEGER*4 MRM_HIERARCHY		! Mrm hierarchy ID
	INTEGER*4 APP_CONTEXT		! Application context
	INTEGER*4 DISPLAY		! Display
	COMMON /ARG/ MRM_HIERARCHY, DISPLAY

	EXTERNAL applicationShellWidgetClass
	
	INTEGER*4 ARGC/0/,CLASS

	INTEGER*4 FETCH_FROM_ADDRESS
	INTEGER*4 HIERARCHY_STATUS,FETCH_STATUS,REGISTER_STATUS

	HIERARCHY_FILE_NAME_ARRAY(0) = %LOC(HIERARCHY_FILE_NAME)
	CALLBACK_ARGLIST(0).NAME = %LOC(CALLBACK_NAME)
	CALLBACK_ARGLIST(0).VALUE = %LOC(HELLOWORLD_BUTTON_ACTIVATE)

	! Initialize the MRM
	!
	CALL MrmInitialize

	! Initialize the toolkit
	!
	CALL XtToolkitInitialize

	APP_CONTEXT = XtCreateApplicationContext ()

	! Open the display.
	!
	DISPLAY= XtOpenDisplay (
	1   %VAL(APP_CONTEXT),	!
	2   %VAL(0),
	3   %VAL(0),
	4   %REF('helloworldclass'//CHAR(0)),
	5   %VAL(NULL),
	6   %VAL(0),
	7   ARGC,
	8   %VAL(0))
	IF (DISPLAY .EQ. NULL) THEN
	    TYPE *,'Can''t open display'
	    STOP
	    END IF

	! Make sure the top-level widget allows resize so the
	! button always fits.
	!
	ARG_LIST(0).NAME = %LOC(XmNallowShellResize)
	ARG_LIST(0).VALUE = TRUE
	
	! Create the application shell This call returns the ID of the
	! "toplevel" widget.  The application's "main" widget must be
	! the only child of this widget.
	!
	TOPLEVEL = XtAppCreateShell (
	1   %VAL(0),	    ! ARGV
	2   %VAL(NULL),
	3   %VAL(FETCH_FROM_ADDRESS(applicationShellWidgetClass)),
	4   %VAL(DISPLAY),  ! DISPLAY
	5   ARG_LIST,	    ! ARGLIST
	6   %VAL(1))	    ! ARGCOUNT

	! Open the MRM hierarchy (only one file)
	!
	HIERARCHY_STATUS = MrmOpenHierarchy (
	1   %VAL(1),
	2   HIERARCHY_FILE_NAME_ARRAY,
	3   %VAL(0),	    ! ANCILIARY_STRUCTURES_LIST
	3   MRM_HIERARCHY)
	IF (HIERARCHY_STATUS .NE. MrmSUCCESS) 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 = MrmRegisterNames (
	1   CALLBACK_ARGLIST,%VAL(1))
	IF (REGISTER_STATUS .NE. MrmSUCCESS) 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 = MrmFetchWidget (
	1   %VAL(MRM_HIERARCHY),! HIERARCHY_ID
	2   %REF('helloworld_main'//CHAR(0)),	! INDEX
	3   %VAL(TOPLEVEL),	! PARENT
	4   HELLOWORLD_MAIN,	! W_RETURN
	5   CLASS)		! CLASS_RETURN
	IF (FETCH_STATUS .NE. MrmSUCCESS) 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 XtManageChild (%VAL(HELLOWORLD_MAIN))

	! Realize the toplevel widget.  This will cause the entire
	! "managed" widget hierarchy to be displayed.
	!
	CALL XtRealizeWidget (%VAL(TOPLEVEL))

	! Loop and process events
	!
	CALL XtAppMainLoop (%VAL(APP_CONTEXT))

	! Control never returns here

	END

	! Callback routine from the pushbutton widget which sets the
	! value of the label to "Goodbye World!" on the first push,
	! and on the second push, exits the program.
	! 
	SUBROUTINE HELLOWORLD_BUTTON_ACTIVATE (
	1   WIDGET, TAG, CALLBACK_DATA)
C+
C 
C FUNCTIONAL DESCRIPTION:	
C 
C    Callback routine activated when pushbutton is pushed.
C
C    Upon the first push, the label of the widget is changed to
C    "Goodbye World".  On the second push, the program exits.
C 
C FORMAL PARAMETERS:
C  
C     WIDGET:
C	  The pushbutton widget which was pushed.
C      
C     TAG:
C	  Unused.
C      
C     CALLBACK_DATA:
C	  Unused.
C  
C 
C-

	INCLUDE 'SYS$LIBRARY:DECW$MOTIF'
	
	INTEGER*4 WIDGET, TAG, CALLBACK_DATA	! Only WIDGET is used

	RECORD /ARG/ ARG_LIST(0:1)

	COMMON /ARG/ MRM_HIERARCHY, DISPLAY
	INTEGER*4 DATA_TYPE
	! Compound string identifier for label
	!
	INTEGER*4 CSTRING

	! Variable in which to record state
	!
	LOGICAL PUSHED /.FALSE./
	SAVE PUSHED	! Ensure that it is static

	IF (PUSHED) THEN
	    STOP
	ELSE
	    STAT = MrmFetchLiteral (
	1	%VAL(MRM_HIERARCHY), 
	2	%REF('goodbye_label'//CHAR(0)),
	3	%VAL(DISPLAY), 
	4	CSTRING, 
	5	DATA_TYPE) 



	    ! Set up the argument list to modify the label
	    ! and its position
	    ! 
	    ARG_LIST(0).NAME = %LOC(XmNlabelString)
	    ARG_LIST(0).VALUE = CSTRING
	    ARG_LIST(1).NAME = %LOC(XmNx)
	    ARG_LIST(1).VALUE = 30

	    CALL XtSetValues (%VAL(WIDGET), ARG_LIST, %VAL(2))

	    ! Free the compound string we created
	    !
	    CALL XtFree (%VAL(CSTRING))

	    ! Indicate that the button has been pressed
	    ! 
	    PUSHED = .TRUE.
	END IF

	RETURN
	END

	! Routine to fetch the contents of a variable at a given address.
	! This is used to reference external variables.
	!
	INTEGER*4 FUNCTION FETCH_FROM_ADDRESS (LOCATION)
C+
C 
C FUNCTIONAL DESCRIPTION:
C 
C    Function to fetch the contents of a variable at a give address.
C
C    This is used to reference external variables such as the toolkit's
C    "widgetclass" variables, since FORTRAN doesn't have the concept of
C    an external variable.
C 
C FORMAL PARAMETERS:
C  
C     LOCATION:
C	  The INTEGER*4 variable whose contents are to be fetched.  Typically,
C	  this will be specified in the calling routine as an EXTERNAL
C	  passed by reference.
C  
C 
C FUNCTION VALUE:
C 
C    The contents of the variable specified by LOCATION.
C 
C DESIGN:
C  
C     This routine relies on the EXTERNAL declaration in FORTRAN declaring
C     the identifier as an external function.  When such an identifier is
C     passed as an argument, the compiler passes the address by immediate
C     value.  By deliberately NOT declaring the argument as EXTERNAL in
C     the subroutine, we get it treated as if it were a variable passed by
C     reference and thus we can fetch the value.
C  
C-
	INTEGER*4 LOCATION
	FETCH_FROM_ADDRESS = LOCATION
	RETURN
	END