PROGRAM MOTIFBURGER

C
C © 2000 Compaq Computer Corporation
C
C COMPAQ Registered in U.S. Patent and Trademark Office.
C
C Confidential computer software.  Valid license from Compaq required for
C possession, use or copying.  Consistent with FAR 12.211 and 12.212, Commercial
C Computer Software, Computer Software Documentation, and Technical Data for
C Commercial Items are licensed to the U.S. Government under vendor's standard
C commercial license.
C
C	MOTIFBURGER.FOR
C
C	FORTRAN example of using the Motif Resource Manager and
C	Toolkit.  Adapted from the DECwindows example "DECBURGER".
C
C	Requires DECW$EXAMPLES:MOTIFBURGER_DEFS.FOR, which contains common
C	declarations used in the application, and
C	SYS$LIBRARY:DECW$MOTIF.FOR which contains Motif toolkit declarations.
C
C	To compile and link, use the following commands:
C
C	  $ FORTRAN DECW$EXAMPLES:MOTIFBURGER
C	  $ LINK/NOTRACE MOTIFBURGER,SYS$INPUT:/OPTIONS
C	  SYS$LIBRARY:DECW$DXMLIBSHR/SHARE
C	  $
C
C	Before running, MOTIFBURGER.UID must exist in your default
C	directory.  To create it, use the following commands:
C
C	  $ UIL/MOTIF DECW$EXAMPLES:MOTIFBURGER
C
C	When you run the program, a the initial dialog box will come up.
C	Pull down the "Order" menu and select "Create Order Box...". (There
C	will be a delay before the menu appears while the Resource Manager
C	fetches all the subsidiary widgets from the hierarchy.
C
C	Author:  Steven B. Lionel
C		 Converted from DECBURGER.FOR for Motif
C
C	Change History:
C
C	1-Feb-1991	Converted from DECBURGER.FOR (XUI version) by author.
C

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

C
C	Define list of hierarchy file names (array of pointers to
C	string descriptors).  To change the location of the
C	hierarchy file, change the value of the following PARAMETER
C	constant.
C
	PARAMETER HIERARCHY_FILE_NAME = 'MOTIFBURGER.UID'//CHAR(0)
	INTEGER*4 HIERARCHY_FILE_NAME_ARRAY(0:0)

C
C	Define argument list for registering callback routines.
C	The names do not have to be in order.
C
	RECORD /MrmRegisterArg/ MRM_REGISTER_LIST(8)

C
C	Define names of callback routines as ASCIZ strings
C
	PARAMETER
	1  ACTIVATE_PROC_NAME = 'activate_proc'//CHAR(0),
	1  CREATE_PROC_NAME = 'create_proc'//CHAR(0),
	1  LIST_PROC_NAME = 'list_proc'//CHAR(0),
	1  PULL_PROC_NAME = 'pull_proc'//CHAR(0),
	1  QUIT_PROC_NAME = 'quit_proc'//CHAR(0),
	1  SCALE_PROC_NAME = 'scale_proc'//CHAR(0),
	1  SHOW_HIDE_PROC_NAME = 'show_hide_proc'//CHAR(0),
	1  TOGGLE_PROC_NAME = 'toggle_proc'//CHAR(0)

C
C	Define callback routines as external
C
	EXTERNAL ACTIVATE_PROC,CREATE_PROC,LIST_PROC,PULL_PROC,
	1 QUIT_PROC,SCALE_PROC,SHOW_HIDE_PROC,TOGGLE_PROC

C
C	Declare attributes argument list
C
	RECORD /ARG/ ARG_LIST(0:0)
	
C
C	Define other identifiers
C
	INTEGER*4 APP_CONTEXT	    ! Application context
	INTEGER*4 DISPLAY	    ! Display
	INTEGER*4 ARGC /0/  
	INTEGER*4 CLASS	
	INTEGER*4 FETCH_FROM_ADDRESS ! Function
	INTEGER*4 BYTE_COUNT
	INTEGER*4 STATUS
	INTEGER*4 STAT
	INTEGER*4 DATA_TYPE
	EXTERNAL applicationShellWidgetClass

C
C	Define status variables
C
	INTEGER*4 HIERARCHY_STATUS,FETCH_STATUS,REGISTER_STATUS

C
C	End of declarations

C
C	Fill in the hierarchy filename list
C
	HIERARCHY_FILE_NAME_ARRAY(0) = %LOC(HIERARCHY_FILE_NAME)

C
C	Fill in the argument list for registering callbacks
C
	MRM_REGISTER_LIST(1).NAME = %LOC(ACTIVATE_PROC_NAME)
	MRM_REGISTER_LIST(1).VALUE = %LOC(ACTIVATE_PROC)
	MRM_REGISTER_LIST(2).NAME = %LOC(CREATE_PROC_NAME)
	MRM_REGISTER_LIST(2).VALUE = %LOC(CREATE_PROC)
	MRM_REGISTER_LIST(3).NAME = %LOC(LIST_PROC_NAME)
	MRM_REGISTER_LIST(3).VALUE = %LOC(LIST_PROC)
	MRM_REGISTER_LIST(4).NAME = %LOC(PULL_PROC_NAME)
	MRM_REGISTER_LIST(4).VALUE = %LOC(PULL_PROC)
	MRM_REGISTER_LIST(5).NAME = %LOC(QUIT_PROC_NAME)
	MRM_REGISTER_LIST(5).VALUE = %LOC(QUIT_PROC)
	MRM_REGISTER_LIST(6).NAME = %LOC(SCALE_PROC_NAME)
	MRM_REGISTER_LIST(6).VALUE = %LOC(SCALE_PROC)
	MRM_REGISTER_LIST(7).NAME = %LOC(SHOW_HIDE_PROC_NAME)
	MRM_REGISTER_LIST(7).VALUE = %LOC(SHOW_HIDE_PROC)
	MRM_REGISTER_LIST(8).NAME = %LOC(TOGGLE_PROC_NAME)
	MRM_REGISTER_LIST(8).VALUE = %LOC(TOGGLE_PROC)



C
C	Initialize our global state to correspond to the UIL.  This code
C	makes some assumptions about the contents of the UIL.  To
C	correct this, the following values should be read from the
C	hierarchy file or from the widgets upon creation:
C
C	    Text of "Create order box..." and "Dismiss order box..." labels
C	    Initial settings of toggles
C	    Initial settings of fries size and drink selection
C
C	In addition, to properly implement "Reset", the initial quantities
C	of burgers, fries and drinks should be read from the interface and
C	stored for later use.
C
C
C
C	Set the medium "hamburger doneness" toggle so that the radio
C	box has one toggle button ON at startup.  This matches the UIL.
C
	TOGGLE_ARRAY(BURGER_MEDIUM) = .TRUE.


C
C	Now that we have our global state set up, start the application
C

C
C	Initialize the Motif Resource Manager
C
	CALL MrmInitialize

C
C	Initialize the toolkit
C
	CALL XtToolkitInitialize

C
C	Create the application context
C
	APP_CONTEXT = XtCreateApplicationContext ()

C
C	Open the display
C
	DISPLAY = XtOpenDisplay (
	1 %VAL(APP_CONTEXT),	    ! APP_CONTEXT
	2 %VAL(0),		    ! DISPLAY_STRING
	3 %REF('MotifBurger in FORTRAN'//CHAR(0)),  ! APPLICATION_NAME
	4 %REF('example'//CHAR(0)), ! APPLICATION_CLASS
	5 %VAL(0),		    ! OPTIONS
	6 %VAL(0),		    ! NUM_OPTIONS
	7 ARGC,			    ! ARGC
	8 %VAL(0))		    ! ARGV
	IF (DISPLAY .EQ. NULL) THEN
	    TYPE *,'Can''t open display'
	    STOP
	    END IF

C
C	Make sure the top-level widget allows resize.
C
	ARG_LIST(0).NAME = %LOC(XmNallowShellResize)
	ARG_LIST(0).VALUE = TRUE

C
C	Create the application shell.  This call returns the ID of the
C	"top-level" widget.  The application's "main" widget must be the
C	only child of this widget.
C
	TOPLEVEL_WIDGET = XtAppCreateShell (
	1  %VAL(0),	    ! APPLICATION_NAME
	2  %VAL(0),	    ! APPLICATION_CLASS
	3  %VAL(FETCH_FROM_ADDRESS(applicationShellWidgetClass)),
	4  %VAL(DISPLAY),   ! DISPLAY
	5  ARG_LIST,	    ! ARGLIST
	6  %VAL(1))	    ! ARGCOUNT

C
C	Open the Mrm hierarchy file (UID file)
C
	HIERARCHY_STATUS = MrmOpenHierarchy (
	1  %VAL(1),
	2  HIERARCHY_FILE_NAME_ARRAY,
	3  %VAL(0),
	4  MRM_HIERARCHY)
	IF (HIERARCHY_STATUS .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t open hierarchy, status = ', HIERARCHY_STATUS
	    STOP
	    END IF

C
C	Register the callback routines
C
	REGISTER_STATUS = MrmRegisterNames (MRM_REGISTER_LIST, %VAL(8))
	IF (REGISTER_STATUS .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t register callbacks, status = ', REGISTER_STATUS
	    STOP
	    END IF

C
C	Fetch the main widget of the application
C
	FETCH_STATUS = MrmFetchWidget (
	1  %VAL(MRM_HIERARCHY),
	2  %REF('S_MAIN_WINDOW'//CHAR(0)),
	3  %VAL(TOPLEVEL_WIDGET),
	4  MAIN_WINDOW_WIDGET,
	5  CLASS)
	IF (FETCH_STATUS .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t fetch main window, status = ', FETCH_STATUS
	    STOP
	    END IF
	

C
C	Set the fries size and drink type to match the UIL
C
	STAT = MrmFetchLiteral (
	1   %VAL(MRM_HIERARCHY),
	2   %REF('k_drink_init'//CHAR(0)),
	3   %VAL(DISPLAY),
	4   CURRENT_DRINK,
	5   DATA_TYPE)
	IF (STAT .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t fetch literal k_drink_init'
	END IF

	STAT = MrmFetchLiteral (
	1   %VAL(MRM_HIERARCHY),
	2   %REF('k_fries_init'//CHAR(0)),
	3   %VAL(DISPLAY),
	4   CURRENT_FRIES,
	5   DATA_TYPE)
	IF (STAT .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t fetch literal k_fries_init'
	END IF



C
C	Set up utility compound strings we use
C
	STAT = MrmFetchLiteral (
	1   %VAL(MRM_HIERARCHY),
	2   %REF('k_create_init'//CHAR(0)),
	3   %VAL(DISPLAY),
	4   LATIN_CREATE,
	5   DATA_TYPE)
	IF (STAT .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t fetch literal k_create_init'
	END IF

	STAT = MrmFetchLiteral (
	1   %VAL(MRM_HIERARCHY),
	2   %REF('k_dismiss_init'//CHAR(0)),
	3   %VAL(DISPLAY),
	4   LATIN_DISMISS,
	5   DATA_TYPE)
	IF (STAT .NE. MrmSUCCESS) THEN
	    TYPE *,'Can''t fetch literal k_dismiss_init'
	END IF

	LATIN_SPACE = DXmCvtFCtoCS (
	1   %REF(' '//CHAR(0)),
	2   %REF(BYTE_COUNT),
	3   %REF(STATUS))
	LATIN_ZERO = DXmCvtFCtoCS (
	1   %REF(' 0 '//CHAR(0)),
	2   %REF(BYTE_COUNT),
	3   %REF(STATUS))
C
C	Manage the main part and realize everything.  The interface
C	comes up on the display now.
C
	CALL XtManageChild (%VAL(MAIN_WINDOW_WIDGET))
	CALL XtRealizeWidget (%VAL(TOPLEVEL_WIDGET))

C
C	Sit around forever waiting to process X-events.  We never
C	leave XtAppMainLoop.  From here on, we only execute our
C	callback routines.  The program is terminated by a call
C	to EXIT.  
C
	CALL XtAppMainLoop (%VAL(APP_CONTEXT))

	END


	SUBROUTINE S_ERROR (MESSAGE)

C	Routine to print an error message and terminate the program
C
	IMPLICIT NONE
	CHARACTER*(*) MESSAGE

	TYPE *,MESSAGE
	CALL EXIT(1)
	RETURN
	END

	INTEGER*4 FUNCTION GET_VALUE (W,RESOURCE)

C	Function to get the value of a resource from a widget.
C	In this application, used for both integer and compound string
C	values (both of which are longwords).  Note that if multiple
C	values are desired, XtGetValues can be used to obtain them
C	all in one call.
C
C	The application should be careful not to free or modify any
C	compound string resource values returned.
C
	IMPLICIT NONE
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W		! Widget to get resource of
	CHARACTER*(*) RESOURCE	! Resource name

	RECORD /ARG/ ARG_LIST(0:0)
	INTEGER*4 LCL_VALUE

C
C	Set up the argument list
C
	
	ARG_LIST(0).NAME = %LOC(RESOURCE)
	ARG_LIST(0).VALUE = %LOC(LCL_VALUE)
C
C	Fetch the resource value
C
	CALL XtGetValues (
	1  %VAL(W),		! Widget to get resource of
	2  ARG_LIST,		! Argument list
	3  %VAL(1))		! Length of argument list

	GET_VALUE = LCL_VALUE	! Return value
	RETURN
	END

	SUBROUTINE SET_VALUE (W,RESOURCE,VALUE)

C	Function to set the value of a resource in a widget.
C	In this application, used for integer, widget and compound string
C	values (all of which are longwords).  Note that if multiple
C	values are desired, XtSetValues can be used to set them
C	all in one call.
C
	IMPLICIT NONE
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W		! Widget to set resource of
	CHARACTER*(*) RESOURCE	! Resource name
	INTEGER*4 VALUE		! Value to set

	RECORD /ARG/ ARG_LIST(0:0)

C
C	Set up the argument list to say what we want to set
C

	ARG_LIST(0).NAME = %LOC(RESOURCE)
	ARG_LIST(0).VALUE = VALUE
C
C	Set the resource value
C
	CALL XtSetValues (
	1  %VAL(W),		! Widget to set resource of
	2  ARG_LIST,		! Argument list
	3  %VAL(1))		! Length of argument list

	RETURN
	END

	SUBROUTINE SET_BOOLEAN (WHICH,STATE)

C	Subroutine to keep our toggle array consistent with the
C	user interface toggle buttons
C
	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'

	INTEGER*4 WHICH		! Index into toggle and widget arrays
	LOGICAL*4 STATE		! State to set it to

	TOGGLE_ARRAY(WHICH) = STATE
	CALL XmToggleButtonSetState (
	1  %VAL(WIDGET_ARRAY(WHICH)),	! Toggle widget to set
	2  %VAL(STATE),			! State to set
	3  %VAL(.FALSE.))		! Don't notify us

	RETURN
	END

	SUBROUTINE UPDATE_DRINK_DISPLAY

C	Subroutine to format and update the drink quantity widget
C
	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 CSTRING	! Compound string
	CHARACTER*13 TEMP_STR	! String for formatting value
	INTEGER*4 FIRST_SIG	! First non-blank position
	INTEGER   BYTE_COUNT
	INTEGER	  STATUS

	TEMP_STR = ' '
	CALL CONVERT_NUMBER (QUANTITIES(DRINKS),TEMP_STR(2:),FIRST_SIG)

C
C	Convert to compound string, set the widget label and then
C	free the compound string.  Note that since we passed CONVERT_NUMBER
C	the substring 2:13, FIRST_SIG is actually one less than the position
C	of the first non-blank in TEMP_STR, which is what we want because
C	there needs to be a leading blank (for consistency in formatting.)
C
	CSTRING = DXmCvtFCtoCS (
	1   %REF(TEMP_STR(FIRST_SIG:)),
	2   %REF(BYTE_COUNT),
	3   %REF(STATUS))
	CALL SET_VALUE (WIDGET_ARRAY(DRINK_QUANTITY),
	1   XmNlabelString,CSTRING)
	CALL XtFree(%VAL(CSTRING))

	RETURN
	END

	SUBROUTINE RESET_VALUES

C	Callback routine to reset the user interface and the
C	application to a known state
C
C	This code makes assumptions about the UIL.  It should really
C	record the state of the interface upon startup and reset to
C	that state.  

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 WHICH	    ! Loop index

C
C	Reset the toggle buttons and our toggle array
C
	DO WHICH=MIN_TOGGLE,MAX_TOGGLE
	    CALL SET_BOOLEAN (WHICH,.FALSE.)
	    ENDDO

C
C	The radio box requires one button to be set, choose "medium"
C	
	CALL SET_BOOLEAN (BURGER_MEDIUM,.TRUE.) 

C
C	Reset the burger quantity scale widget and global value
C
	CALL SET_VALUE (WIDGET_ARRAY(BURGER_QUANTITY),XmNvalue,0)
	QUANTITIES(BURGERS) = 0

C
C	Reset the fries quantity widget.  We do not have a
C	global for this; we read the widget whenever we need
C	to know the quantity.
C
	CALL XmTextSetString (%VAL(WIDGET_ARRAY(FRIES_QUANTITY)),
	1   %REF('0'//CHAR(0)))

C
C	Reset the drink quantity widget and global value.
C
	CALL SET_VALUE (WIDGET_ARRAY(DRINK_QUANTITY), XmNlabelString,
	1  LATIN_ZERO)
	QUANTITIES(DRINKS) = 0

	RETURN
	END

	SUBROUTINE CLEAR_ORDER

C	Routine to clear the order display area in the main window
C
	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	RECORD /ARG/ ARG_LIST(0:1)

	ARG_LIST(0).NAME = %LOC(XmNitemCount)
	ARG_LIST(0).VALUE = 0
	ARG_LIST(1).NAME = %LOC(XmNSelectedItemCount)
	ARG_LIST(1).VALUE = 0
	CALL XtSetValues (%VAL(WIDGET_ARRAY(TOTAL_ORDER)),
	1 ARG_LIST,%VAL(2))

	RETURN
	END

	SUBROUTINE CONVERT_NUMBER (VALUE, STRING, FIRST_SIG)

C	Utility routine to convert an integer to a decimal
C	string with trailing blank.  The result is right-justified
C	in the first eleven characters of STRING.  FIRST_SIG is then
C	assigned the position of the first non-blank character.  A trailing
C	NUL is then added
C
	IMPLICIT NONE
	INTEGER*4 VALUE		! Input
	CHARACTER*(*) STRING	! Output
	INTEGER*2 FIRST_SIG	! Output
	INTEGER*4 IOS,I

	WRITE (STRING,'(I10,'' '')',IOSTAT=IOS) VALUE
	STRING(12:12) = CHAR(0)

C
C	Find the first non-blank.  We know there will be one.
C	
	I = 1
	DO WHILE (STRING(I:I) .EQ. ' ')
	    I = I + 1
	    END DO
	FIRST_SIG = I
	RETURN
	END

	INTEGER*4 FUNCTION READ_NUMBER_FROM_ASCIZ (ASCIZ_STRING)

C	Utility routine to read an integer number from an ASCIZ string
C
	IMPLICIT NONE
	BYTE ASCIZ_STRING(*)
	INTEGER*4 RESULT
	INTEGER*4 I

	PARAMETER NUL = 0
	PARAMETER ZERO = ICHAR('0')
	PARAMETER NINE = ICHAR('9')
	PARAMETER BLANK = ICHAR (' ')

	RESULT = 0
	I = 1

C
C	While we haven't seen a NUL, accumulate the integer value
C	Ignore embedded blanks
C

	DO WHILE (ASCIZ_STRING(I) .NE. 0)
	    IF (ASCIZ_STRING(I) .NE. BLANK) THEN
		IF ((ASCIZ_STRING(I) .LT. ZERO) .OR.
	1	    (ASCIZ_STRING(I) .GT. NINE) .OR.
	2	    (RESULT .GT. 1000000000)) THEN
		    READ_NUMBER_FROM_ASCIZ = 0	! Invalid
		    RETURN
		    END IF
		RESULT = (RESULT * 10) + (ASCIZ_STRING(I) - ZERO)
		END IF
	    I = I + 1
	    END DO

	READ_NUMBER_FROM_ASCIZ = RESULT
	RETURN
	END

	INTEGER*4 FUNCTION FETCH_FROM_ADDRESS (LOCATION)

C	Function used to fetch the contents of a variable at a given
C	address.  This is used to reference external variables
C
	IMPLICIT NONE
	INTEGER*4 LOCATION
	FETCH_FROM_ADDRESS = LOCATION
	RETURN
	END

	SUBROUTINE ACTIVATE_PROC (W,TAG,REASON)

C	Callback routine called whenever any pushbutton is pressed.
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W		! Widget
	INTEGER*4 TAG		! Index into WIDGET_ARRAY
	INTEGER*4 REASON	! Not used

	INTEGER*4 CLASS
	INTEGER*4 FETCH_STATUS	! Status from FETCH_WIDGET
	INTEGER*4 LIST_TEXT,TEXT,CSTEMP	! Compound strings
	INTEGER*4 FRIES_TEXT_PTR
	INTEGER*4 FRIES_NUM
	INTEGER*4 ZERO
	CHARACTER*12 TEMP_STRING
	INTEGER*2 FIRST_SIG
	INTEGER*4 WHICH		! Index into widget and toggle arrays
	INTEGER*4 GET_VALUE	! Function to get a value
	INTEGER*4 IOS		! IOSTAT for conversions
	INTEGER*4 READ_NUMBER_FROM_ASCIZ
	EXTERNAL  READ_NUMBER_FROM_ASCIZ
	INTEGER   BYTE_COUNT
	INTEGER	  STATUS

	ZERO = 0
C
C	Select action based on widget index
C

	IF (TAG .EQ. NYI) THEN
	    !
	    ! The user activated a "not yet implemented" pushbutton.
	    ! Send the user a message
	    !
	    IF (WIDGET_ARRAY(NYI) .EQ. 0) THEN
		! The first time, fetch from the database
		!
		FETCH_STATUS = MrmFetchWidget (
	1	    %VAL(MRM_HIERARCHY),! Hierarchy ID
	2	    %REF('nyi'//CHAR(0)),! Widget index
	3	    %VAL(TOPLEVEL_WIDGET),! Parent
	4	    WIDGET_ARRAY(NYI),	! Widget return
	5	    CLASS)		! Class return
		IF (FETCH_STATUS .NE. MrmSuccess)
	1	  CALL S_ERROR('Can''t fetch NYI widget')
		ENDIF
	    ! Put up the message "not yet implemented"
	    !
	    CALL XtManageChild (%VAL(WIDGET_ARRAY(NYI)))
	    ! END NYI

	ELSE IF (TAG .EQ. SUBMIT_ORDER) THEN
	    ! This would send the order off to the kitchen.
	    ! In this case, we just pretend the order was
	    ! submitted
	    !
	    CALL CLEAR_ORDER
	    ! END SUBMIT_ORDER

	ELSE IF (TAG .EQ. CANCEL_ORDER) THEN
	    ! Clear out the order display
	    !
	    CALL CLEAR_ORDER
	    ! END CANCEL_ORDER

	ELSE IF (TAG .EQ. DISMISS) THEN
	    ! Bring down the control box and reset the
	    ! values to the default
	    !
	    CALL XtUnmanageChild (%VAL(WIDGET_ARRAY(ORDER_BOX)))
	    CALL RESET_VALUES
	    ! END DISMISS

	ELSE IF (TAG .EQ. NOAPPLY) THEN
	    CALL RESET_VALUES
	    ! END NOAPPLY

	ELSE IF (TAG .EQ. APPLY) THEN
	    ! Take the current settings and write them into
	    ! the list box
	    !
	    IF (QUANTITIES(BURGERS) .GT. 0) THEN
		! Put the burger quantity in the display string
		! First, convert number to decimal string with
		! trailing blank
		! 
		CALL CONVERT_NUMBER (QUANTITIES(BURGERS),
	1	    TEMP_STRING,FIRST_SIG)
		LIST_TEXT = DXmCvtFCtoCS (
	1	%REF(TEMP_STRING(FIRST_SIG:)),
	2	%REF(BYTE_COUNT),
	3	%REF(STATUS))

		! Collect hamburger attributes that are on
		!
		DO WHICH=MIN_TOGGLE,MAX_TOGGLE
		    IF (TOGGLE_ARRAY(WHICH)) THEN
			! Get the name of the qualifier from the
			! widget and add to the display string
			! Be careful to free old compound strings,
			! but not those retrieved with GET_VALUE
			!
			TEXT = GET_VALUE (WIDGET_ARRAY(WHICH),
	1		    XmNlabelString)
			CSTEMP = LIST_TEXT
			LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1		    %VAL(TEXT))
			CALL XtFree (%VAL(CSTEMP))
			CSTEMP = LIST_TEXT
			LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1		    %VAL(LATIN_SPACE))
			CALL XtFree (%VAL(CSTEMP))
			END IF
		    END DO

		! Concatenate hamburger name to the display string
		!
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(NAMES(BURGERS)))
		CALL XtFree (%VAL(CSTEMP))
		CALL XmListAddItem (%VAL(WIDGET_ARRAY(TOTAL_ORDER)),
	1	    %VAL(LIST_TEXT),%VAL(ZERO))
		CALL XtFree (%VAL(LIST_TEXT))
		END IF

	    ! Fries text widget does not have a callback.  So we
	    ! query the widget now to determine what its value is,
	    ! and then convert to an integer.  If it did have a callback,
	    ! we could use QUANTITIES(FRIES) to store the value, but we
	    ! ignore that here.
	    !
	    FRIES_TEXT_PTR = XmTextGetString (
	1	%VAL(WIDGET_ARRAY(FRIES_QUANTITY)))
	    FRIES_NUM = READ_NUMBER_FROM_ASCIZ (%VAL(FRIES_TEXT_PTR))

	    IF (FRIES_NUM .LT. 0) THEN
		CALL XmTextSetString (%VAL(WIDGET_ARRAY(FRIES_QUANTITY)),
	1	    %REF(' 0 '//CHAR(0)))
	    ELSE IF (FRIES_NUM .GT. 0) THEN
		CALL CONVERT_NUMBER (FRIES_NUM,
	1	    TEMP_STRING,FIRST_SIG)
		LIST_TEXT = DXmCvtFCtoCS (
	1	%REF(TEMP_STRING(FIRST_SIG:)),
	2	%REF(BYTE_COUNT),
	3	%REF(STATUS))
		! Append the fries size
		!
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(CURRENT_FRIES))
		CALL XtFree (%VAL(CSTEMP))
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(LATIN_SPACE))
		CALL XtFree (%VAL(CSTEMP))
		! Append the fries name and add to total order display
		!
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(NAMES(FRIES)))
		CALL XtFree (%VAL(CSTEMP))
		CALL XmListAddItem (%VAL(WIDGET_ARRAY(TOTAL_ORDER)),
	1	    %VAL(LIST_TEXT),%VAL(ZERO))
		CALL XtFree (%VAL(LIST_TEXT))
		END IF

	    IF (QUANTITIES(DRINKS) .GT. 0) THEN
		! Put drinks quantity into the display string
		!
		CALL CONVERT_NUMBER (QUANTITIES(DRINKS),
	1	    TEMP_STRING,FIRST_SIG)
		LIST_TEXT = DXmCvtFCtoCS (
	1	%REF(TEMP_STRING(FIRST_SIG:)),
	2	%REF(BYTE_COUNT),
	3	%REF(STATUS))
		! Concatenate drink size and name to the display
		! string
		!
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(CURRENT_DRINK))
		CALL XtFree (%VAL(CSTEMP))
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(LATIN_SPACE))
		CALL XtFree (%VAL(CSTEMP))
		CSTEMP = LIST_TEXT
		LIST_TEXT = XmStringConcat (%VAL(LIST_TEXT),
	1	    %VAL(NAMES(DRINKS)))
		CALL XtFree (%VAL(CSTEMP))
		CALL XmListAddItem (%VAL(WIDGET_ARRAY(TOTAL_ORDER)),
	1	    %VAL(LIST_TEXT),%VAL(ZERO))
		CALL XtFree (%VAL(LIST_TEXT))
		END IF
	    ! END APPLY

	ELSE IF ((TAG .GE. FRIES_TINY) .AND. (TAG .LE. FRIES_HUGE)) THEN
	    ! Some fries push button was activated, so get the string
	    ! from the interface.  Free the old fries size name and make
	    ! a new copy to keep (since the value returned by GET_VALUE
	    ! is the toolkit's internal pointer.)
	    !
	    CALL XtFree (%VAL(CURRENT_FRIES))
	    CURRENT_FRIES = XmStringCopy (
	1     %VAL(GET_VALUE(W,XmNlabelString)))
	    ! END FRIES_XXX

	ELSE IF (TAG .EQ. DRINK_ADD) THEN
	    ! Increment the drink quantity and update the display
	    !
	    QUANTITIES(DRINKS) = QUANTITIES(DRINKS) + 1
	    CALL UPDATE_DRINK_DISPLAY
	    ! END DRINK_ADD

	ELSE IF (TAG .EQ. DRINK_SUB) THEN
	    ! Decrement drink quantity, but do not let it go
	    ! below zero
	    IF (QUANTITIES(DRINKS) .GT. 0) QUANTITIES(DRINKS) =
	1	QUANTITIES(DRINKS) - 1
	    CALL UPDATE_DRINK_DISPLAY

	    END IF  ! End of cases

	RETURN
	END	

	SUBROUTINE TOGGLE_PROC (W,TAG,TOGGLE)

C	Routine called by toggle buttons for "hamburger doneness"
C	and toppings when they change state.  Use the tag to index
C	into the toggle array.  Keep the array consistent with the
C	user interface
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG
	RECORD /XmToggleButtonCallbackStruct/ TOGGLE

	TOGGLE_ARRAY (TAG) = TOGGLE.IS_SET
	RETURN
	END	

	SUBROUTINE LIST_PROC (W,TAG,LIST)

C	Routine called by the drink selection list box whenever
C	the user selects a drink.  Keep the current drink up
C	to date.  We must copy the compound string from the callback
C	structure rather than just remembering the value.
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG
	RECORD /XmListCallbackStruct/ LIST

	CALL XtFree (%VAL(CURRENT_DRINK))  ! Free old one
	CURRENT_DRINK = XmStringCopy (%VAL(LIST.ITEM))
	RETURN
	END	

	SUBROUTINE SCALE_PROC (W,TAG,SCALE)

C	Routine called by the hamburger quantity scale widget when
C	the user changes it.  Keep the current quantity up to date.
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG
	RECORD /XmScaleCallbackStruct/ SCALE

	QUANTITIES(BURGERS) = SCALE.VALUE

	RETURN
	END	

	SUBROUTINE SHOW_HIDE_PROC (W,TAG,REASON)

C	Routine called when the user selected the Order push button
C	in the control pulldown menu.  We just change the state of the
C	order box.  If the order box is currently displayed (managed)
C	then remove (unmanage) it.  Otherwise we manage the order box
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG,REASON

	IF (XtIsManaged (%VAL(WIDGET_ARRAY(ORDER_BOX)))) THEN
	    CALL XtUnmanageChild (%VAL(WIDGET_ARRAY(ORDER_BOX)))
	ELSE
	    CALL XtManageChild (%VAL(WIDGET_ARRAY(ORDER_BOX)))
	    END IF
	RETURN
	END	

	SUBROUTINE CREATE_PROC (W,TAG,REASON)

C	Routine called when any widget is created.  We record the ID
C	in WIDGET_ARRAY and make a copy of the widget label name.
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG,REASON
	INTEGER*4 GET_VALUE	! Utility function

	WIDGET_ARRAY(TAG) = W

	IF (TAG .EQ. BURGER_LABEL) THEN
	    NAMES(BURGERS) = XmStringCopy (%VAL(GET_VALUE(W,
	1	XmNlabelString)))
	ELSE IF (TAG .EQ. FRIES_LABEL) THEN
	    NAMES(FRIES) = XmStringCopy (%VAL(GET_VALUE(W,
	1	XmNlabelString)))
	ELSE IF (TAG .EQ. DRINK_LABEL) THEN
	    NAMES(DRINKS) = XmStringCopy (%VAL(GET_VALUE(W,
	1	XmNlabelString)))
	    END IF

	RETURN
	END	

	SUBROUTINE QUIT_PROC (W,TAG,REASON)

C	Routine called when the user pushes the Quit button to
C	exit the application.
C	

	IMPLICIT NONE
	INTEGER*4 W,TAG,REASON

	CALL EXIT(1)
	RETURN
	END	

	SUBROUTINE PULL_PROC (W,TAG,REASON)

C	Routine called just as a pulldown menu is about to be pulled
C	down.  It fetches the menu if it is currently empty, and
C	does other special processing as required.
C	

	IMPLICIT NONE
	INCLUDE 'DECW$EXAMPLES:MOTIFBURGER_DEFS/NOLIST'
	INCLUDE 'SYS$LIBRARY:DECW$MOTIF/NOLIST'

	INTEGER*4 W,TAG,REASON
	INTEGER*4 FETCH_STATUS,CLASS

	IF (TAG .EQ. FILE_PDME) THEN
	    IF (WIDGET_ARRAY(FILE_MENU) .EQ. 0) THEN
		FETCH_STATUS = MrmFetchWidget (
	1	    %VAL(MRM_HIERARCHY),
	2	    %REF('file_menu'//CHAR(0)),
	3	    %VAL(WIDGET_ARRAY(MENU_BAR)),
	4	    WIDGET_ARRAY(FILE_MENU),
	5	    CLASS)
		IF (FETCH_STATUS .NE. MrmSuccess)
	1	    CALL S_ERROR ('Can''t fetch file pulldown menu widget')
		END IF
	    CALL SET_VALUE (WIDGET_ARRAY(FILE_PDME),XmNsubMenuId,
	1	WIDGET_ARRAY(FILE_MENU))

	ELSE IF (TAG .EQ. EDIT_PDME) THEN
	    IF (WIDGET_ARRAY(EDIT_MENU) .EQ. 0) THEN
		FETCH_STATUS = MrmFetchWidget (
	1	    %VAL(MRM_HIERARCHY),
	2	    %REF('edit_menu'//CHAR(0)),
	3	    %VAL(WIDGET_ARRAY(MENU_BAR)),
	4	    WIDGET_ARRAY(EDIT_MENU),
	5	    CLASS)
		IF (FETCH_STATUS .NE. MrmSuccess)
	1	    CALL S_ERROR ('Can''t fetch edit pulldown menu widget')
		END IF
	    CALL SET_VALUE (WIDGET_ARRAY(EDIT_PDME),XmNsubMenuId,
	1	WIDGET_ARRAY(EDIT_MENU))

	ELSE IF (TAG .EQ. ORDER_PDME) THEN
	    IF (WIDGET_ARRAY(ORDER_MENU) .EQ. 0) THEN
		FETCH_STATUS = MrmFetchWidget (
	1	    %VAL(MRM_HIERARCHY),
	2	    %REF('order_menu'//CHAR(0)),
	3	    %VAL(WIDGET_ARRAY(MENU_BAR)),
	4	    WIDGET_ARRAY(ORDER_MENU),
	5	    CLASS)
		IF (FETCH_STATUS .NE. MrmSuccess)
	1	    CALL S_ERROR ('Can''t fetch order pulldown menu widget')
		END IF
	    CALL SET_VALUE (WIDGET_ARRAY(ORDER_PDME),XmNsubMenuId,
	1	WIDGET_ARRAY(ORDER_MENU))

	    IF (WIDGET_ARRAY(ORDER_BOX) .EQ. 0) THEN
		FETCH_STATUS = MrmFetchWidget (
	1	    %VAL(MRM_HIERARCHY),
	2	    %REF('control_box'//CHAR(0)),
	3	    %VAL(TOPLEVEL_WIDGET),
	4	    WIDGET_ARRAY(ORDER_BOX),
	5	    CLASS)
		IF (FETCH_STATUS .NE. MrmSuccess)
	1	    CALL S_ERROR ('Can''t fetch order box widget')
		END IF

	    ! Figure out what the label of the pushbutton in the
	    ! pulldown menu should be.
	    !
	    IF (XtIsManaged (%VAL(WIDGET_ARRAY(ORDER_BOX)))) THEN
		CALL SET_VALUE (WIDGET_ARRAY(CREATE_ORDER),XmNlabelString,
	1	    LATIN_DISMISS)
	    ELSE
		CALL SET_VALUE (WIDGET_ARRAY(CREATE_ORDER),XmNlabelString,
	1	    LATIN_CREATE)
		END IF
	    END IF
	RETURN
	END