PROGRAM MOTIFBURGER ! !****************************************************************************** !* * !* © Copyright 200 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. * !* * !****************************************************************************** ! ! ! BASIC$MOTIFBURGER.BAS ! ! BASIC example of using the Motif Resource Manager and ! Toolkit. Adapted from the DECwindows example "DECBURGER". ! ! Requires DECW$EXAMPLES:BASIC$MOTIFBURGER_DEFS.BAS, which contains common ! declarations used in the application, and SYS$LIBRARY:DECW$MOTIF.BAS ! which contains Motif toolkit declarations. ! ! To build and run the MOTIFBURGER example perform the following steps: ! ! 1) Copy the needed files into you current directory ! ! $ COPY DECW$EXAMPLES:BASIC$MOTIFBURGER*.* *.* ! ! 2) Build the Resource (UID) file ! ! $ UIL/MOTIF BASIC$MOTIFBURGER.UIL ! ! 3) Compile the BASIC program ! ! $ BASIC BASIC$MOTIFBURGER ! ! 4) Link the resulting object file with the appropiate options. ! ! For Motif V1.1 ! ! $ LINK BASIC$MOTIFBURGER,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$MOTIFBURGER,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$MOTIFBURGER,MOTIF/OPTIONS ! ! 5) If you are not running on a workstation, make sure that your ! display is set correctly. ! ! $ SET DISPLAY/CREATE/NODE=xxxx ! ! 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$MOTIFBURGER ! ! When you run the program, an initial dialog box will come up. ! Pull down the "Order" menu and select "Create Order Box...". (There ! will be a delay before the menu appears while the Resource Manager ! fetches all the subsidiary widgets from the hierarchy. ! ! Authors: ! ! Steven B. Lionel, Digital Equipment Corporation ! Converted from DECBURGER.FOR for Motif ! ! Phillip J. Hudson, Digital Equipment Corporation ! Adapted for DEC/VAX BASIC ! ! Peter C. Haynes, Digital Equipment Corporation ! Adapted for DEC/VAX BASIC ! ! Change History: ! ! 01-Feb-1991 - Converted from DECBURGER.FOR (XUI version) by author ! 13-Jul-1994 - Modified for use with VAX/DEC BASIC ! 03-Aug-1994 - Further changes to make work with DEC BASIC ! 30-Aug-1994 - Added missing nul terminater for V1.2 !- OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" ! ! Define list of hierarchy file names (array of pointers to ! string descriptors). To change the location of the ! hierarchy file, change the value of the following PARAMETER ! constant. ! DECLARE LONG HIERARCHY_FILE_NAME_ARRAY(1) COMMON (c1) STRING HIERARCHY_FILE_NAME = 24 ! Declare descriptor for the hierarchy file name HIERARCHY_FILE_NAME = "BASIC$MOTIFBURGER.UID" + "0"C ! ! Define argument list for registering callback routines. ! The names do not have to be in order. ! DECLARE MrmRegisterArg MRM_REGISTER_LIST(8) ! ! Define callback routines as external ! EXTERNAL LONG FUNCTION ACTIVATE_PROC EXTERNAL LONG FUNCTION CREATE_PROC EXTERNAL LONG FUNCTION LIST_PROC EXTERNAL LONG FUNCTION PULL_PROC EXTERNAL LONG FUNCTION QUIT_PROC EXTERNAL LONG FUNCTION SCALE_PROC EXTERNAL LONG FUNCTION SHOW_HIDE_PROC EXTERNAL LONG FUNCTION TOGGLE_PROC EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) ! ! Define names of callback routines as ASCIZ strings ! COMMON (c1) STRING ACTIVATE_PROC_NAME = 14 COMMON (c1) STRING CREATE_PROC_NAME = 12 COMMON (c1) STRING LIST_PROC_NAME = 10 COMMON (c1) STRING PULL_PROC_NAME = 10 COMMON (c1) STRING QUIT_PROC_NAME = 10 COMMON (c1) STRING SCALE_PROC_NAME = 11 COMMON (c1) STRING SHOW_HIDE_PROC_NAME = 15 COMMON (c1) STRING TOGGLE_PROC_NAME = 12 ACTIVATE_PROC_NAME = "activate_proc" + "0"C CREATE_PROC_NAME = "create_proc" + "0"C LIST_PROC_NAME = "list_proc" + "0"C PULL_PROC_NAME = "pull_proc" + "0"C QUIT_PROC_NAME = "quit_proc" + "0"C SCALE_PROC_NAME = "scale_proc" + "0"C SHOW_HIDE_PROC_NAME = "show_hide_proc" + "0"C TOGGLE_PROC_NAME = "toggle_proc" + "0"C ! ! Declare attributes argument list ! DECLARE ARG ARG_LIST(1) ! ! Define other identifiers ! DECLARE XtAppContext APP_CONTEXT ! Application context DECLARE Display_D APP_DISPLAY ! Display DECLARE LONG ARGC DECLARE LONG DOPTIONS(1) DECLARE MrmType CLASS DECLARE LONG BYTE_COUNT DECLARE LONG ISTATUS DECLARE Cardinal STAT DECLARE MrmCode DATA_TYPE DECLARE STRING TempStr ! ! Define status variables ! DECLARE Cardinal HIERARCHY_STATUS, FETCH_STATUS, REGISTER_STATUS ! ! End of declarations ! ! ! Fill in the hierarchy filename list ! HIERARCHY_FILE_NAME_ARRAY(0) = ADDRESS_OF_STRING (HIERARCHY_FILE_NAME) HIERARCHY_FILE_NAME_ARRAY(1) = 0 ! ! Fill in the argument list for registering callbacks ! MRM_REGISTER_LIST(0)::NAME_F = ADDRESS_OF_STRING (ACTIVATE_PROC_NAME) MRM_REGISTER_LIST(0)::VALUE_F = LOC (ACTIVATE_PROC) MRM_REGISTER_LIST(1)::NAME_F = ADDRESS_OF_STRING (CREATE_PROC_NAME) MRM_REGISTER_LIST(1)::VALUE_F = LOC (CREATE_PROC) MRM_REGISTER_LIST(2)::NAME_F = ADDRESS_OF_STRING (LIST_PROC_NAME) MRM_REGISTER_LIST(2)::VALUE_F = LOC (LIST_PROC) MRM_REGISTER_LIST(3)::NAME_F = ADDRESS_OF_STRING (PULL_PROC_NAME) MRM_REGISTER_LIST(3)::VALUE_F = LOC (PULL_PROC) MRM_REGISTER_LIST(4)::NAME_F = ADDRESS_OF_STRING (QUIT_PROC_NAME) MRM_REGISTER_LIST(4)::VALUE_F = LOC (QUIT_PROC) MRM_REGISTER_LIST(5)::NAME_F = ADDRESS_OF_STRING (SCALE_PROC_NAME) MRM_REGISTER_LIST(5)::VALUE_F = LOC (SCALE_PROC) MRM_REGISTER_LIST(6)::NAME_F = ADDRESS_OF_STRING (SHOW_HIDE_PROC_NAME) MRM_REGISTER_LIST(6)::VALUE_F = LOC (SHOW_HIDE_PROC) MRM_REGISTER_LIST(7)::NAME_F = ADDRESS_OF_STRING (TOGGLE_PROC_NAME) MRM_REGISTER_LIST(7)::VALUE_F = LOC (TOGGLE_PROC) ! ! Initialize our global state to correspond to the UIL. This code ! makes some assumptions about the contents of the UIL. To ! correct this, the following values should be read from the ! hierarchy file or from the widgets upon creation: ! ! Text of "Create order box..." and "Dismiss order box..." labels ! Initial settings of toggles ! Initial settings of fries size and drink selection ! ! In addition, to properly implement "Reset", the initial quantities ! of burgers, fries and drinks should be read from the interface and ! stored for later use. ! ! ! Set the medium "hamburger doneness" toggle so that the radio ! box has one toggle button ON at startup. This matches the UIL. ! TOGGLE_ARRAY(BURGER_MEDIUM) = TRUE ! ! Now that we have our global state set up, start the application ! ! ! 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, ! APP_CONTEXT & , ! DISPLAY_STRING & "MotifBurger in BASIC" + "0"C, ! APPLICATION_NAME & "example" + "0"C, ! APPLICATION_CLASS & DOPTIONS(), ! OPTIONS & 0, ! NUM_OPTIONS & ARGC,) ! ARGC, ARGV IF (APP_DISPLAY = NULL) THEN PRINT "Can't open display" STOP END IF ! ! Make sure the top-level widget allows resize. ! TempStr = XmNallowShellResize + "0"C ARG_LIST(0)::NAME_F = ADDRESS_OF_STRING (TempStr) ARG_LIST(0)::VALUE_F = TRUE ! ! Create the application shell. This call returns the ID of the ! "top-level" widget. The application's "main" widget must be the ! only child of this widget. ! TOPLEVEL_WIDGET = XtAppCreateShell (,, ! APPLICATION_NAME, APPLICATION_CLASS & applicationShellWidgetClass, ! WIDGET_CLASS & APP_DISPLAY, ! DISPLAY & ARG_LIST(), ! ARGLIST & 1) ! ARGCOUNT ! ! Open the Mrm hierarchy file (UID file) ! HIERARCHY_STATUS = MrmOpenHierarchy (1, ! NUM_FILES & HIERARCHY_FILE_NAME_ARRAY(), ! FILENAMES & , & MRM_HIERARCHY) ! HIERARCHY_ID IF (HIERARCHY_STATUS <> MrmSUCCESS) THEN PRINT "Can't open hierarchy, status = ", HIERARCHY_STATUS STOP END IF ! ! Register the callback routines ! REGISTER_STATUS = MrmRegisterNames (MRM_REGISTER_LIST(), 8) IF (REGISTER_STATUS <> MrmSUCCESS) THEN PRINT "Can't register callbacks, status = ", REGISTER_STATUS STOP END IF ! ! Fetch the main widget of the application ! FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, & "S_MAIN_WINDOW" + "0"C, & TOPLEVEL_WIDGET, & MAIN_WINDOW_WIDGET, & CLASS) IF (FETCH_STATUS <> MrmSUCCESS) THEN PRINT "Can't fetch main window, status = ", FETCH_STATUS STOP END IF ! ! Set the fries size and drink type to match the UIL ! STAT = MrmFetchLiteral (MRM_HIERARCHY, & "k_drink_init" + "0"C, & APP_DISPLAY, & CURRENT_DRINK, & DATA_TYPE) IF (STAT <> MrmSUCCESS) THEN PRINT "Can't fetch literal k_drink_init" END IF STAT = MrmFetchLiteral (MRM_HIERARCHY, & "k_fries_init" + "0"C, & APP_DISPLAY, & CURRENT_FRIES, & DATA_TYPE) IF (STAT <> MrmSUCCESS) THEN PRINT "Can't fetch literal k_fries_init" END IF ! ! Set up utility compound strings we use ! STAT = MrmFetchLiteral (MRM_HIERARCHY, & "k_create_init" + "0"C, & APP_DISPLAY, & LATIN_CREATE, & DATA_TYPE) IF (STAT <> MrmSUCCESS) THEN PRINT "Can't fetch literal k_create_init" END IF STAT = MrmFetchLiteral (MRM_HIERARCHY, & "k_dismiss_init" + "0"C, & APP_DISPLAY, & LATIN_DISMISS, & DATA_TYPE) IF (STAT <> MrmSUCCESS) THEN PRINT "Can't fetch literal k_dismiss_init" END IF COMMON (c1) STRING SPACE_STR = 2 SPACE_STR = " " + "0"C LATIN_SPACE = DXmCvtFCtoCS (ADDRESS_OF_STRING (SPACE_STR), BYTE_COUNT, ISTATUS) COMMON (c1) STRING ZERO_STR = 4 ZERO_STR = " 0 " + "0"C LATIN_ZERO = DXmCvtFCtoCS (ADDRESS_OF_STRING (ZERO_STR), BYTE_COUNT, ISTATUS) ! ! Manage the main part and realize everything. The interface ! comes up on the display now. ! CALL XtManageChild (MAIN_WINDOW_WIDGET) CALL XtRealizeWidget (TOPLEVEL_WIDGET) ! ! Sit around forever waiting to process X-events. We never ! leave XtAppMainLoop. From here on, we only execute our ! callback routines. The program is terminated by a call ! to EXIT. ! WHEN ERROR IN CALL XtAppMainLoop (APP_CONTEXT) USE END WHEN END PROGRAM SUB ACTIVATE_PROC (Widget W, LONG TAG, LONG REASON) ! ! Callback routine called whenever any pushbutton is pressed. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" DECLARE MrmType CLASS DECLARE LONG FETCH_STATUS ! Status from FETCH_WIDGET DECLARE LONG LIST_TEXT, TEXT, CSTEMP ! Compound strings DECLARE XtString FRIES_TEXT_PTR DECLARE LONG FRIES_NUM DECLARE LONG ZERO DECLARE LONG FIRST_SIG DECLARE LONG WHICH ! Index into widget and toggle arrays DECLARE LONG IOS ! IOSTAT for conversions DECLARE LONG BYTE_COUNT DECLARE LONG ISTATUS DECLARE STRING TEMP_STRING EXTERNAL LONG FUNCTION READ_NUMBER_FROM_ASCIZ (LONG BY VALUE) EXTERNAL LONG FUNCTION GET_VALUE (Widget, STRING) ! Function to get a value EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) EXTERNAL SUB CONVERT_NUMBER (LONG, STRING, LONG) ZERO = 0 ! ! Select action based on widget index ! SELECT TAG CASE = NYI ! ! The user activated a "not yet implemented" pushbutton. ! Send the user a message ! IF (WIDGET_ARRAY(NYI) = 0) THEN ! ! The first time, fetch from the database ! FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, ! Hierarchy ID & "nyi"+"0"C, ! Widget index & TOPLEVEL_WIDGET, ! Parent & WIDGET_ARRAY(NYI), ! Widget return & CLASS) ! Class return IF (FETCH_STATUS <> MrmSuccess) THEN CALL S_ERROR ("Can't fetch NYI widget") END IF END IF ! ! Put up the message "not yet implemented" ! CALL XtManageChild (WIDGET_ARRAY(NYI)) ! END NYI CASE = SUBMIT_ORDER ! ! 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 CASE = CANCEL_ORDER ! ! Clear out the order display ! CALL CLEAR_ORDER ! END CANCEL_ORDER CASE = DISMISS ! ! Bring down the control box and reset the values to the default ! CALL XtUnmanageChild (WIDGET_ARRAY(ORDER_BOX)) CALL RESET_VALUES ! END DISMISS CASE = NOAPPLY CALL RESET_VALUES ! END NOAPPLY CASE = APPLY ! ! Take the current settings and write them into the list box ! IF (QUANTITIES(BURGERS) > 0) THEN ! ! Put the burger quantity in the display string ! First, convert number to decimal string with ! trailing blank ! TEMP_STRING = " " CALL CONVERT_NUMBER (QUANTITIES(BURGERS), TEMP_STRING, FIRST_SIG) LIST_TEXT = DXmCvtFCtoCS (ADDRESS_OF_STRING (TEMP_STRING), BYTE_COUNT, ISTATUS) ! ! Collect hamburger attributes that are on ! FOR WHICH = MIN_TOGGLE TO 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), XmNlabelString + "0"C) CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, TEXT) CALL XtFree (CSTEMP) CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, LATIN_SPACE) CALL XtFree (CSTEMP) END IF NEXT WHICH ! ! Concatenate hamburger name to the display string ! CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, NAMES(BURGERS)) CALL XtFree (CSTEMP) CALL XmListAddItem (WIDGET_ARRAY(TOTAL_ORDER), LIST_TEXT, ZERO) CALL XtFree (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 (WIDGET_ARRAY(FRIES_QUANTITY)) FRIES_NUM = READ_NUMBER_FROM_ASCIZ (FRIES_TEXT_PTR) IF (FRIES_NUM <= 0) THEN CALL XmTextSetString (WIDGET_ARRAY(FRIES_QUANTITY), " 0 "+"0"C) ELSE IF (FRIES_NUM > 0) THEN TEMP_STRING = " " CALL CONVERT_NUMBER (FRIES_NUM, TEMP_STRING, FIRST_SIG) LIST_TEXT = DXmCvtFCtoCS (ADDRESS_OF_STRING (TEMP_STRING), BYTE_COUNT, ISTATUS) ! ! Append the fries size ! CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, CURRENT_FRIES) CALL XtFree (CSTEMP) CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, LATIN_SPACE) CALL XtFree (CSTEMP) ! ! Append the fries name and add to total order display ! CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, NAMES(FRIES)) CALL XtFree (CSTEMP) CALL XmListAddItem (WIDGET_ARRAY(TOTAL_ORDER), LIST_TEXT, ZERO) CALL XtFree (LIST_TEXT) END IF END IF IF (QUANTITIES(DRINKS) > 0) THEN ! ! Put drinks quantity into the display string ! TEMP_STRING = " " CALL CONVERT_NUMBER (QUANTITIES(DRINKS), TEMP_STRING, FIRST_SIG) LIST_TEXT = DXmCvtFCtoCS (ADDRESS_OF_STRING (TEMP_STRING), BYTE_COUNT, ISTATUS) ! ! Concatenate drink size and name to the display string ! CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, CURRENT_DRINK) CALL XtFree (CSTEMP) CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, LATIN_SPACE) CALL XtFree (CSTEMP) CSTEMP = LIST_TEXT LIST_TEXT = XmStringConcat (LIST_TEXT, NAMES(DRINKS)) CALL XtFree (CSTEMP) CALL XmListAddItem (WIDGET_ARRAY(TOTAL_ORDER), LIST_TEXT, ZERO) CALL XtFree (LIST_TEXT) END IF ! END APPLY CASE FRIES_TINY TO FRIES_HUGE ! ! 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 (CURRENT_FRIES) CURRENT_FRIES = XmStringCopy (GET_VALUE (W, XmNlabelString + "0"C)) ! END FRIES_XXX CASE = DRINK_ADD ! ! Increment the drink quantity and update the display ! QUANTITIES(DRINKS) = QUANTITIES(DRINKS) + 1 CALL UPDATE_DRINK_DISPLAY ! END DRINK_ADD CASE = DRINK_SUB ! ! Decrement drink quantity, but do not let it go below zero IF (QUANTITIES(DRINKS) > 0) THEN QUANTITIES(DRINKS) = QUANTITIES(DRINKS) - 1 END IF CALL UPDATE_DRINK_DISPLAY ! END DRINK_SUB END SELECT END SUB SUB CREATE_PROC (Widget W, LONG TAG, LONG REASON) ! ! Routine called when any widget is created. We record the ID ! in WIDGET_ARRAY and make a copy of the widget label name. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" EXTERNAL LONG FUNCTION GET_VALUE (Widget, STRING) ! Utility function WIDGET_ARRAY(TAG) = W SELECT TAG CASE = BURGER_LABEL NAMES(BURGERS) = XmStringCopy (GET_VALUE (W, XmNlabelString + "0"C)) CASE = FRIES_LABEL NAMES(FRIES) = XmStringCopy (GET_VALUE (W, XmNlabelString + "0"C)) CASE = DRINK_LABEL NAMES(DRINKS) = XmStringCopy (GET_VALUE (W, XmNlabelString + "0"C)) END SELECT END SUB SUB TOGGLE_PROC (Widget W, LONG TAG, XmToggleButtonCallbackStruct TOGGLE) ! ! Routine called by toggle buttons for "hamburger doneness" ! and toppings when they change state. Use the tag to index ! into the toggle array. Keep the array consistent with the ! user interface ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" TOGGLE_ARRAY (TAG) = TOGGLE::IS_SET END SUB SUB LIST_PROC (Widget W, LONG TAG, XmListCallbackStruct DRINKS_LIST) ! ! Routine called by the drink selection list box whenever ! the user selects a drink. Keep the current drink up ! to date. We must copy the compound string from the callback ! structure rather than just remembering the value. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" CALL XtFree (CURRENT_DRINK) ! Free old one CURRENT_DRINK = XmStringCopy (DRINKS_LIST::ITEM) END SUB SUB SCALE_PROC (Widget W, LONG TAG, XmScaleCallbackStruct Q_SCALE) ! ! Routine called by the hamburger quantity scale widget when ! the user changes it. Keep the current quantity up to date. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" QUANTITIES(BURGERS) = Q_SCALE::VALUE_F END SUB SUB SHOW_HIDE_PROC (Widget W, LONG TAG, LONG REASON) ! ! Routine called when the user selected the Order push button ! in the control pulldown menu. We just change the state of the ! order box. If the order box is currently displayed (managed) ! then remove (unmanage) it. Otherwise we manage the order box ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" IF XtIsManaged (WIDGET_ARRAY(ORDER_BOX)) THEN CALL XtUnmanageChild (WIDGET_ARRAY(ORDER_BOX)) ELSE CALL XtManageChild (WIDGET_ARRAY(ORDER_BOX)) END IF END SUB SUB PULL_PROC (Widget W, LONG TAG, LONG REASON) ! ! Routine called just as a pulldown menu is about to be pulled ! down. It fetches the menu if it is currently empty, and ! does other special processing as required. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" DECLARE LONG FETCH_STATUS DECLARE MrmType CLASS SELECT TAG CASE = FILE_PDME IF (WIDGET_ARRAY(FILE_MENU) = 0) THEN FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, & "file_menu"+"0"C, & WIDGET_ARRAY(MENU_BAR), & WIDGET_ARRAY(FILE_MENU), & CLASS) IF (FETCH_STATUS <> MrmSuccess) THEN CALL S_ERROR ("Can't fetch file pulldown menu widget") END IF END IF CALL SET_VALUE (WIDGET_ARRAY(FILE_PDME), XmNsubMenuId + "0"C, WIDGET_ARRAY(FILE_MENU)) CASE = EDIT_PDME IF (WIDGET_ARRAY(EDIT_MENU) = 0) THEN FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, & "edit_menu"+"0"C, & WIDGET_ARRAY(MENU_BAR), & WIDGET_ARRAY(EDIT_MENU), & CLASS) IF (FETCH_STATUS <> MrmSuccess) THEN CALL S_ERROR ("Can't fetch edit pulldown menu widget") END IF END IF CALL SET_VALUE (WIDGET_ARRAY(EDIT_PDME), XmNsubMenuId + "0"C, WIDGET_ARRAY(EDIT_MENU)) CASE = ORDER_PDME IF (WIDGET_ARRAY(ORDER_MENU) = 0) THEN FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, & "order_menu"+"0"C, & WIDGET_ARRAY(MENU_BAR), & WIDGET_ARRAY(ORDER_MENU),& CLASS) IF (FETCH_STATUS <> MrmSuccess) THEN CALL S_ERROR ("Can't fetch order pulldown menu widget") END IF END IF CALL SET_VALUE (WIDGET_ARRAY(ORDER_PDME), XmNsubMenuId + "0"C, WIDGET_ARRAY(ORDER_MENU)) IF (WIDGET_ARRAY(ORDER_BOX) = 0) THEN FETCH_STATUS = MrmFetchWidget (MRM_HIERARCHY, & "control_box"+"0"C, & TOPLEVEL_WIDGET, & WIDGET_ARRAY(ORDER_BOX), & CLASS) IF (FETCH_STATUS <> MrmSuccess) THEN CALL S_ERROR ("Can't fetch order box widget") END IF END IF ! ! Figure out what the label of the pushbutton in the pulldown menu should be. ! IF XtIsManaged (WIDGET_ARRAY(ORDER_BOX)) THEN CALL SET_VALUE (WIDGET_ARRAY(CREATE_ORDER), XmNlabelString + "0"C, LATIN_DISMISS) ELSE CALL SET_VALUE (WIDGET_ARRAY(CREATE_ORDER), XmNlabelString + "0"C, LATIN_CREATE) END IF END SELECT END SUB SUB QUIT_PROC (Widget W, LONG TAG, LONG REASON) ! ! Routine called when the user pushes the Quit button to ! exit the application. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER CAUSE ERROR 11 END SUB FUNCTION LONG GET_VALUE (Widget W, STRING RESOURCE) ! ! Function to get the value of a resource from a widget. ! In this application, used for both integer and compound string ! values (both of which are longwords). Note that if multiple ! values are desired, XtGetValues can be used to obtain them ! all in one call. ! ! The application should be careful not to free or modify any ! compound string resource values returned. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) DECLARE ARG ARG_LIST(1) DECLARE LONG LCL_VALUE ! ! Set up the argument list ! ARG_LIST(0)::NAME_F = ADDRESS_OF_STRING (RESOURCE) ARG_LIST(0)::VALUE_F = LOC(LCL_VALUE) ! ! Fetch the resource value ! CALL XtGetValues (W, ! Widget to get resource of & ARG_LIST(), ! Argument list & 1) ! Length of argument list END FUNCTION LCL_VALUE SUB SET_VALUE (Widget W, STRING RESOURCE, LONG V) ! ! Function to set the value of a resource in a widget. ! In this application, used for integer, widget and compound string ! values (all of which are longwords). Note that if multiple ! values are desired, XtSetValues can be used to set them ! all in one call. ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) DECLARE ARG ARG_LIST(1) ! ! Set up the argument list to say what we want to set ! ARG_LIST(0)::NAME_F = ADDRESS_OF_STRING (RESOURCE) ARG_LIST(0)::VALUE_F = V ! ! Set the resource value ! CALL XtSetValues (W, ! Widget to set resource of & ARG_LIST(), ! Argument list & 1) ! Length of argument list END SUB SUB SET_BOOLEAN (LONG WHICH, BYTE STATE) ! ! Subroutine to keep our toggle array consistent with the ! user interface toggle buttons ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" TOGGLE_ARRAY(WHICH) = STATE CALL XmToggleButtonSetState (WIDGET_ARRAY(WHICH), ! Toggle widget to set & STATE, ! State to set & FALSE) ! Don't notify us END SUB SUB UPDATE_DRINK_DISPLAY ! ! Subroutine to format and update the drink quantity widget ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) EXTERNAL SUB CONVERT_NUMBER (LONG, STRING, LONG) DECLARE LONG CSTRING ! Compound string DECLARE LONG FIRST_SIG ! First non-blank position DECLARE LONG BYTE_COUNT DECLARE LONG ISTATUS DECLARE STRING TEMP_STR ! String for formatting value TEMP_STR = " " CALL CONVERT_NUMBER (QUANTITIES(DRINKS), TEMP_STR, FIRST_SIG) ! ! Convert to compound string, set the widget label and then ! free the compound string. ! CSTRING = DXmCvtFCtoCS (ADDRESS_OF_STRING (TEMP_STR), BYTE_COUNT, ISTATUS) CALL SET_VALUE (WIDGET_ARRAY(DRINK_QUANTITY), XmNlabelString + "0"C, CSTRING) CALL XtFree(CSTRING) END SUB SUB RESET_VALUES ! ! Callback routine to reset the user interface and the ! application to a known state ! ! This code makes assumptions about the UIL. It should really ! record the state of the interface upon startup and reset to ! that state. OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" DECLARE LONG WHICH ! Loop index ! ! Reset the toggle buttons and our toggle array ! FOR WHICH = MIN_TOGGLE TO MAX_TOGGLE CALL SET_BOOLEAN (WHICH, FALSE) NEXT WHICH ! ! The radio box requires one button to be set, choose "medium" ! CALL SET_BOOLEAN (BURGER_MEDIUM, TRUE) ! ! Reset the burger quantity scale widget and global value ! CALL SET_VALUE (WIDGET_ARRAY(BURGER_QUANTITY), XmNvalue + "0"C, 0) QUANTITIES(BURGERS) = 0 ! ! Reset the fries quantity widget. We do not have a ! global for this; we read the widget whenever we need ! to know the quantity. ! CALL XmTextSetString (WIDGET_ARRAY(FRIES_QUANTITY), "0" + "0"C) ! ! Reset the drink quantity widget and global value. ! CALL SET_VALUE (WIDGET_ARRAY(DRINK_QUANTITY), XmNlabelString + "0"C, LATIN_ZERO) QUANTITIES(DRINKS) = 0 END SUB SUB CLEAR_ORDER ! ! Routine to clear the order display area in the main window ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER %INCLUDE "SYS$LIBRARY:DECW$MOTIF" %INCLUDE "BASIC$MOTIFBURGER_DEFS" EXTERNAL LONG FUNCTION ADDRESS_OF_STRING (STRING BY REF) DECLARE ARG ARG_LIST(1) DECLARE STRING Tmpstr1, Tmpstr2 Tmpstr1 = XmNitemCount + "0"C ARG_LIST(0)::NAME_F = ADDRESS_OF_STRING (Tmpstr1) ARG_LIST(0)::VALUE_F = 0 Tmpstr2 = XmNSelectedItemCount + "0"C ARG_LIST(1)::NAME_F = ADDRESS_OF_STRING (Tmpstr2) ARG_LIST(1)::VALUE_F = 0 CALL XtSetValues (WIDGET_ARRAY(TOTAL_ORDER), ARG_LIST(), 2) END SUB SUB CONVERT_NUMBER (LONG V, STRING DSTRING, LONG FIRST_SIG) ! ! Utility routine to convert an integer to a decimal ! string with trailing blank. The result is right-justified ! in the first eleven characters of STRING. FIRST_SIG is then ! assigned the position of the first non-blank character. A trailing ! NUL is then added ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER DECLARE LONG I DSTRING = DSTRING + STR$(V) + " " + "0"C ! ! Find the first non-blank. We know there will be one. ! SCAN_LOOP: FOR I = 1 TO LEN (DSTRING) EXIT SCAN_LOOP IF MID$ (DSTRING, I, 1) <> " " NEXT I FIRST_SIG = I END SUB FUNCTION LONG READ_NUMBER_FROM_ASCIZ (STRING ASCIZ_STRING BY REF) ! ! Utility routine to read an integer number from an ASCIZ string ! OPTION TYPE=EXPLICIT, SIZE=INTEGER LONG, CONSTANT TYPE=INTEGER DECLARE STRING TMPSTR DECLARE LONG RESULT WHEN ERROR IN TMPSTR = SEG$ (ASCIZ_STRING, 1, POS (ASCIZ_STRING, "0"C, 1)) RESULT = INTEGER (EDIT$ (TMPSTR, 4)) USE RESULT = 0 CONTINUE END WHEN END FUNCTION RESULT FUNCTION LONG ADDRESS_OF_STRING (STRING ARGSTR BY REF) ! ! Function used to fetch the address of a string variable. ! OPTION TYPE=EXPLICIT, INACTIVE=SETUP END FUNCTION (LOC (ARGSTR)) SUB S_ERROR (STRING MESSAGE) ! ! Routine to print an error message and terminate the program ! OPTION TYPE=EXPLICIT PRINT MESSAGE ON ERROR GOTO 0 END SUB