| Thanks for the quick reply. Here's the Fortran program --
PROGRAM TEST_DISPLAY
IMPLICIT NONE
INCLUDE 'SYS$LIBRARY:DECW$DWTDEF.FOR/NOLIST'
PARAMETER CLASS_NAME='caTRIN'
PARAMETER NULL=CHAR(0)
C FUNCTIONS
! INTEGER*4 XT$INITIALIZE,
! + DWT$OPEN_HIERARCHY,
! + DWT$FETCH_INTERFACE_MODULE
C VARIABLES
INTEGER*4 APPLICATION_WIDGET,
+ HIERARCHY_ID,
+ MAIN_WINDOW_WIDGET,
+ IERR,
+ URLIST,
+ NUM_URLIST,
+ ARGCOUNT,
+ ARGLIST
BYTE NAME(10)
CHARACTER*1 DUMMY
CHARACTER*10 FILE_NAME/'CATRIN.UID'/
CHARACTER*32 DIRECTORY/'SYS$SYSDEVICE:[CREIGHAN.CATRIN]'/
RECORD/DWT$IDBOS_OPARAM/ANCILLARY_STRUCTURE
EQUIVALENCE (NAME(1),FILE_NAME)
C---------------------------------------------------------------
5 FORMAT(1H,'XT INITIALIZE FAILED')
10 FORMAT(1H,'OPEN ERROR='Z)
15 FORMAT(1H,'FETCH ERROR='Z)
20 FORMAT(A)
CALL DWT$INITIALIZE_DRM
APPLICATION_WIDGET=XT$INITIALIZE(NULL,CLASS_NAME,URLIST,
+ NUM_URLIST,ARGCOUNT,ARGLIST)
IF(APPLICATION_WIDGET.EQ.0)THEN
WRITE(6,5)
GOTO 9999
ENDIF
ANCILLARY_STRUCTURE.DWT$L_IDBOS_VERSION=
+ DWT$C_IDBOS_OPEN_PARAM_VERSION
ANCILLARY_STRUCTURE.DWT$A_IDBOS_DEFAULT_FNAME=%LOC(DIRECTORY)
IERR=DWT$OPEN_HIERARCHY(1,%LOC(FILE_NAME),NULL,HEIRARCY_ID)
IF(.NOT.IERR)THEN
WRITE(6,10)IERR
GOTO 9999
ENDIF
IERR=DWT$FETCH_INTERFACE_MODULE(HEIRARCHY_ID,'CATRIN',
+ APPLICATION_WIDGET,
+ MAIN_WINDOW_WIDGET)
IF(.NOT.IERR)THEN
WRITE(6,15)IERR
GOTO 9999
ENDIF
CALL XT$REALIZE_WIDGET(APPLICATION_WIDGET)
CALL XT$MANAGE_CHILDREN(MAIN_WINDOW_WIDGET,1)
READ(5,20)DUMMY
9999 CONTINUE
CALL EXIT
END
---------------------------------------------------------------------------
Thanks for your help...
Therese
|
| Your %LOC(FILE_NAME) effectively passes a pointer to the string itself,
whereas what the routine wants is a pointer to a descriptor. You have to
construct the descriptor yourself.
Also, by commenting out the INTEGER*4 declaration of the routine, you
effectively declare it as REAL*4, which will cause your return status to
look very wierd.
Here's my HELLOWORLD.FOR so you can see how it should be done.
Steve
! HELLOWORLD.FOR
!
! FORTRAN version of HelloWorld example.
!
PROGRAM HELLOWORLD
INCLUDE 'SYS$LIBRARY:DECW$DWTDEF'
INCLUDE '($DSCDEF)'
! Declare the two widget IDs
!
INTEGER*4 TOPLEVEL, HELLOWORLD_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 = 'HELLOWORLD.UID')
! 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 DRM
!
RECORD /DWT$DRMREG_ARG/ CALLBACK_ARGLIST(0:0)
! 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
! 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)
CALLBACK_ARGLIST(0).DWT$A_DRMR_NAME = %LOC(CALLBACK_NAME)
CALLBACK_ARGLIST(0).DWT$L_DRMR_VALUE =
1 %LOC(HELLOWORLD_BUTTON_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 = XT$INITIALIZE (
1 'Hi', ! NAME
2 'helloworldclass', ! CLASS
3 %VAL(0), ! URLIST (omitted)
4 0, ! URCOUNT
5 ARGC, ! ARGCOUNT
6 %VAL(0)) ! ARGVALUE
! Make sure the top-level widget allows resize so the
! button always fits.
!
CALL DWT$VMS_SET_ARG (
1 DWT$C_TRUE,
2 ARG_LIST,
3 0,
4 DWT$C_NALLOW_SHELL_RESIZE)
CALL XT$SET_VALUES (
1 TOPLEVEL,
2 ARG_LIST,
3 1)
! 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 (
1 CALLBACK_ARGLIST,1)
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 'helloworld_main', ! INDEX
3 TOPLEVEL, ! PARENT
4 HELLOWORLD_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 (HELLOWORLD_MAIN)
! Realize the toplevel widget. This will cause the entire
! "managed" widget hierarchy to be displayed.
!
CALL XT$REALIZE_WIDGET (TOPLEVEL)
! Loop and process events
!
CALL XT$MAIN_LOOP
! 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, REASON)
INCLUDE 'SYS$LIBRARY:DECW$DWTDEF'
INTEGER*4 WIDGET, TAG, REASON ! Only WIDGET is used
RECORD /DWT$ARG/ ARG_LIST(0:0)
! Compound string identifier for label
!
INTEGER*4 CSTRING, CS_STATUS
! Variable in which to record state
!
LOGICAL PUSHED /.FALSE./
SAVE PUSHED ! Ensure that it is static
IF (PUSHED) THEN
STOP
ELSE
! Create a compound string for the label
!
CALL DWT$LATIN1_STRING ('Goodbye'//CHAR(13)//'World!',
1 CSTRING)
! Set up the argument list and modify the label
!
CALL DWT$VMS_SET_ARG (
1 CSTRING,
2 ARG_LIST,
3 0,
4 DWT$C_NLABEL)
CALL XT$SET_VALUES (WIDGET,ARG_LIST,1)
! Indicate that the button has been pressed
!
PUSHED = .TRUE.
END IF
RETURN
END
|