PROGRAM HELLOMOTIF

!
!******************************************************************************
!*                                                                            *
!*  © Copyright 2000 Hewlett-Packard Development Company, L.P.                *
!*                                                                            *
!*  Confidential computer software.  Valid license from HP required for       *
!*  possession, use or copying.  Consistent with FAR 12.211 and 12.212,       *
!*  Commercial Computer Software, Computer Software Documentation, and        *
!*  Technical Data for Commercial Items are licensed to the U.S. Government   *
!*  under vendor's standard commercial license.                               *
!*                                                                            *
!*  HP shall not be liable for technical or editorial errors or omissions     *
!*  contained herein.  The information in this document is provided "as is"   *
!*  without warranty of any kind and is subject to change without notice.     *
!*  The warranties for HP products are set forth in the express limited       *
!*  warranty statements accompanying such products.  Nothing herein should be *
!*  construed as constituting an additional warranty.                         *
!*                                                                            *
!******************************************************************************
!

!+
!	HELLOMOTIF.bas
!
!	Basic version of Motif HelloWorld example.
!
!	Requires SYS$LIBRARY:DECW$MOTIF.BAS which contains the Motif toolkit
!	declarations.
!
!   To build and run the HELLOMOTIF example perform the following steps:
!
!   1) Copy the needed files into you current directory
!
!	$ COPY DECW$EXAMPLES:BASIC$HELLOMOTIF.* *.*
!
!   2) Build the Resource (UID) file
!
!	$ UIL/MOTIF BASIC$HELLOMOTIF.UIL
!
!   3) Compile the BASIC program
!
!	$ BASIC BASIC$HELLOMOTIF
!
!   4) Link the resulting object file with the appropiate options.
!
!	For Motif V1.1
!
!	    $ LINK BASIC$HELLOMOTIF,SYS$INPUT/OPTIONS
!	    SYS$LIBRARY:DECW$DXMLIBSHR.EXE/SHARE
!	    SYS$LIBRARY:DECW$XMLIBSHR.EXE/SHARE
!	    SYS$LIBRARY:DECW$XTSHR.EXE/SHARE
!	    ^Z
!	    $
!
!	For Motif V1.2
!
!	    $ LINK BASIC$HELLOMOTIF,SYS$INPUT/OPTIONS
!	    SYS$LIBRARY:DECW$DXMLIBSHR12.EXE/SHARE
!	    SYS$LIBRARY:DECW$XMLIBSHR12.EXE/SHARE
!	    SYS$LIBRARY:DECW$MRMLIBSHR12.EXE/SHARE
!	    SYS$LIBRARY:DECW$XTLIBSHRR5.EXE/SHARE
!	    ^Z
!	    $
!
!	NOTE:  You may want to create an options file, MOTIF.OPT with the
!	appropiate options in it and link using:
!
!	    $ LINK BASIC$HELLOMOTIF,MOTIF/OPTIONS
!
!   5) If you are not running on a workstation, make sure that your
!	display is set correctly, for example:
!
!	$ SET DISPLAY/CREATE/NODE=xxxx
!
!	where xxxx is the node name of a workstation with appropiate
!	graphic capability.
!
!   6) Run the application.  Note that the .UID file must be kept in the
!	same directory as the .EXE when run.  This program looks in the
!	current directory for the UID.
!
!	$ RUN BASIC$HELLOMOTIF
!
!	Then follow the instructions in the dialog box.
!
! Authors:
!
!	Steven B. Lionel, Digital Equipment Corporation
!	Peter Haynes,  Digital Equipment Corporation
!
! Change history:
!
!	20-Dec-1990 - Adapted for Motif from original DECwindows version
!	26-Jul-1994 - Modified for use with VAX/DEC BASIC
!	31-Aug-1994 - Updated linking insturctions for V1.2
!-

!
! Main program
!

    OPTION TYPE=EXPLICIT, CONSTANT TYPE=INTEGER, SIZE=INTEGER LONG
    %INCLUDE "SYS$LIBRARY:DECW$MOTIF"

    EXTERNAL LONG FUNCTION address_of_string (STRING BY REF)

    COMMON (c1) LONG pushed 
    pushed = FALSE

    !
    ! Declare a buffer for forming strings to be passed to UI routines
    !
    COMMON (s1) STRING strings(2) = 50
    
    !
    ! Declare the variables to contain the two widget identifiers
    !
    DECLARE Widget toplevel, helloworld_main

    !
    ! Declare descriptor for the hierarchy file name
    !
    COMMON (c1) STRING hierarchy_file_name = 21
    hierarchy_file_name = "BASIC$HELLOMOTIF.UID"+ "0"C

    DECLARE LONG hierarchy_file_name_array(1)
    hierarchy_file_name_array(0) = ADDRESS_OF_STRING (hierarchy_file_name)
    hierarchy_file_name_array(1) = 0

    !
    ! Declare callback routine name as a case-sensitive, null-terminated string
    !
    COMMON (c1) STRING callback_name = 27
    callback_name = "helloworld_button_activate"+ "0"C

    !
    ! Declare callback routine argument list
    !
    DECLARE MrmRegisterArg callback_arglist(1)
    EXTERNAL LONG FUNCTION helloworld_button_activate (Widget, LONG, LONG)
    callback_arglist(0)::name_F  = ADDRESS_OF_STRING (callback_name)
    callback_arglist(0)::value_F = LOC (helloworld_button_activate)
    callback_arglist(1)::name_F  = 0
    callback_arglist(1)::value_F = 0

    !
    ! Miscellaneous declarations
    !
    DECLARE ARG		    arg_list(1)	    ! Declare attributes argument list
    DECLARE MrmHierarchy    mrm_hierarchy
    DECLARE LONG	    argc
    DECLARE XtAppContext    app_context
    DECLARE Display_D	    app_display
    DECLARE CARDINAL	    stat	    ! Status of MRM calls
    DECLARE MrmType	    class	    ! Class of fetched widget

    !
    ! Initialize the Motif Resource Manager
    !
    CALL MrmInitialize

    !
    ! Initialize the toolkit
    !
    CALL XtToolkitInitialize

    !
    ! Create the application context
    !
    app_context = XtCreateApplicationContext

    !
    ! Open the display
    !
    app_display = XtOpenDisplay (app_context,				&
				 ,,					&
				 "helloworldclass"+ "0"C,,		&
				 0,					&
				 argc,)
    IF app_display = 0
    THEN
	PRINT "Can't open display"
	EXIT PROGRAM
    END IF

    !
    ! Make sure the top-level widget allows resize so the button always fits
    !
    strings(0) = XmNallowShellResize + "0"C
    arg_list(0)::name_F  = LOC (strings(0))
    arg_list(0)::value_F = 1
    arg_list(1)::name_F = 0
    arg_list(1)::value_F = 0
    
    !
    ! 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 (,,					&
				 ApplicationShellWidgetClass,		&
				 app_display,				&
				 arg_list(),				&
				 1)

    !
    ! Open the MRM hierarchy (only one file)
    !
    stat = MrmOpenHierarchy (1,						&
			     hierarchy_file_name_array(),,		&
			     mrm_hierarchy)
    IF stat <> MrmSuccess
    THEN
	PRINT "Can't open hierarchy"
	EXIT PROGRAM
    END IF
	
    !
    ! Register our callback routine so that the resource manager
    ! can resolve it at widget-creation time.
    !
    stat = MrmRegisterNames (callback_arglist(),			&
			     1)
    IF stat <> MrmSuccess
    THEN
	PRINT "Can't register callback"
	EXIT PROGRAM
    END IF

    !
    ! Call Mrm to fetch and create the pushbutton and its container
    !
    stat = MrmFetchWidget (mrm_hierarchy,				&
			   "helloworld_main" + "0"C,			&
			   toplevel,					&
			   helloworld_main,				&
			   class)
    IF stat <> MrmSuccess
    THEN
	PRINT "Can't fetch interface"
	EXIT PROGRAM
    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 (helloworld_main)

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

    !
    ! Loop and process events
    !
    WHEN ERROR IN
	CALL XtAppMainLoop (app_context)
    USE
    END WHEN

END PROGRAM

SUB helloworld_button_activate (Widget widget_val, LONG tag, reason)

!+
!   Callback routine which is called each time the pushbutton is pressed
!-

    OPTION TYPE=EXPLICIT, CONSTANT TYPE=INTEGER, SIZE=INTEGER LONG
    %INCLUDE "SYS$LIBRARY:DECW$MOTIF"

    COMMON (c1) LONG pushed 

    DECLARE Widget hello_widget
    hello_widget = LOC (widget_val)

    COMMON (s1) STRING strings(2) = 50

    DECLARE arg		arg_list(2)	! Note that arrays are zero-based
    DECLARE XmString	cstring		! Compound string identifier for label
    DECLARE LONG	cs_status

    !
    ! If button was pushed before, then exit the program
    !
    IF pushed = TRUE
    THEN
	CAUSE ERROR 11
    ELSE
	!
	! Create a compound string for the label
	!
	cstring = XmStringCreateLtoR ("Goodbye World!" + "0"C,		&
				      XmSTRING_DEFAULT_CHARSET + "0"C)

	!
	! Set up the argument list to modify the label
	!
	strings(0) = XmNlabelString + "0"C
	arg_list(0)::name_F  = LOC (strings(0))
	arg_list(0)::value_F = cstring
	strings(1) = XmNx + "0"C
	arg_list(1)::name_F  = LOC (strings(1))
	arg_list(1)::value_F = 11
	arg_list(2)::name_F  = 0
	arg_list(2)::value_F = 0

	!
	! Modify the widget label
	!
	CALL XtSetValues (hello_widget,					&
			  arg_list(),					&
			  2)

	!
	! Free the compound string
	!
	CALL XtFree (cstring)

	!
	! Indicate that the button has been pushed
	!
	pushed = TRUE
    END IF

END SUB

FUNCTION LONG ADDRESS_OF_STRING (STRING STR_ARG BY REF)

!
!	Function used to fetch the address of a string variable.
!
	OPTION TYPE=EXPLICIT, INACTIVE=SETUP

END FUNCTION (LOC (STR_ARG))