PROGRAM forms$sample_program_fortran C COPYRIGHT (c) 1986, 1987, 1988, 1989, 1993 BY C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED C ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY C OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY C TRANSFERRED. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE C AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT C CORPORATION. C C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. C PROGRAM DESCRIPTION: C C This is the Introductory Sample Application provided with the C DECforms V2.0 product. C C AUTHOR: C C Digital Equipment Corporation C C CREATION DATE: Oct-1986 C C Modified: Aug-1993 C C C ------ Instructions ------ C C If your system manager copied the Sample from the DECforms kit onto your C system, you can run the DECforms Sample Checking Application by doing the C following: C C $ RUN FORMS$EXAMPLES:FORMS$SAMPLE_PROGRAM_FORTRAN C C C The DECforms INTRODUCTORY Sample Checking Application in the FORTRAN C language consists of two files: C C FORMS$SAMPLE_PROGRAM_FORTRAN The application itself C FORMS$SAMPLE_FORM.IFDL The IFDL source form C C C Both files are copied from the DECforms kit to the FORMS$EXAMPLES C directory. Putting the files in FORMS$EXAMPLES is an installation option; C talk to your system manager if they aren't there. C C A working version of the application can be created in your own directory C from these sources by doing the following: C C $! Set the default to your own directory: C $ SET DEFAULT yourdirectory C $ C $! Copy all the sources files from FORMS$EXAMPLES to your own directory: C $ COPY FORMS$EXAMPLES:FORMS$SAMPLE_PROGRAM_FORTRAN.FOR, - C FORMS$SAMPLE_FORM.IFDL [] C C $! Compile the FORTRAN source: C $ FORTRAN FORMS$SAMPLE_PROGRAM_FORTRAN.FOR C $ C $! Translate the IFDL source form: C $ FORMS TRANSLATE FORMS$SAMPLE_FORM.IFDL C $ C $! Extract an object module which contains only the form's call table C vectors from the binary form: C $ FORMS EXTRACT OBJECT /NOFORM_LOAD FORMS$SAMPLE_FORM.FORM C $ C $! Link the FORTRAN and the Form objects: C $ LINK FORMS$SAMPLE_PROGRAM_FORTRAN.OBJ, FORMS$SAMPLE_FORM.OBJ C ! C ! note that FORMS$AR_FORM_TABLE must be specified in the FORMS$ENABLE call C ! due to the use of an escape routine C C $! Define logical for the device to be used: C $ DEFINE FORMS$DEFAULT_DEVICE SYS$INPUT ! if using a char cell terminal C OR C $ DEFINE FORMS$DEFAULT_DEVICE DECW$DISPLAY ! if using a Motif workstation C ( you may also have to $ SET DISPLAY /CREATE /NODE=nodename) C C You can then run the executable in your own directory by simply typing: C $ RUN FORMS$SAMPLE_PROGRAM_FORTRAN C C C $! If creating DDIF output, use a command similar to the following to C produce a PostScript file for high quality printed results: C $ CONVERT/DOCUMENT ddif_form.doc ddif_form.ps /FORMAT=PS C $ C $! You can effectively test the appearance of a DDIF form by using the C VIEW command. For example, C $ VIEW ddif_form.doc /FORMAT=DDIF /INTERFACE=DECWINDOWS C C C Note that the program expects the form file to be in the FORMS$EXAMPLES C directory or in the current directory. By copying the files to your local C directory, you can change the form if you wish and retranslate it. C C C Beginning of FORTRAN main program IMPLICIT NONE INCLUDE 'forms_sample_common.f' C A session_id must be used on every call to the FORMS$... subroutines. C Forms_status is returned from every call to the FORMS$... subroutines. CHARACTER*16 session_id INTEGER forms_status, 1 count/1/ C The OPERATOR_CHOICE record is implemented as the menu_choice variable, C a very simple record message. INTEGER*2 menu_choice C The GET_DEPOSIT record message is used only by a RECEIVE to get deposit C information from the operator. STRUCTURE /get_deposit/ INTEGER deposit_amount ! passed as pennies CHARACTER*35 deposit_memo END STRUCTURE RECORD /get_deposit/ get_deposit C The DESCRIPTOR is used to pass records between form and application C (send_message and receive_message params) C C Note that there is another way of generating descriptors -- see the C file FORMS$CHECKING_FORTRAN.FOR for a discussion of an alternate method. STRUCTURE /descriptor/ INTEGER*2 reclen BYTE type /DSC$K_DTYPE_T/ ! string type BYTE class /DSC$K_CLASS_S/ ! static string INTEGER*4 address END STRUCTURE RECORD /descriptor/ descriptor1, descriptor2 C Print startup message on console PRINT *, 'FORTRAN DECforms Sample Program starting.' C Initialize the DECforms form & check for errors forms_status = forms$enable( forms$ar_form_table, ! Vector address 1 'forms$default_device', ! Device name 2 session_id, ! return from forms$ 3 forms$sample_form, ! Name of form file 4 ! The following trailing pars can be omitted 5 , ! Name of form 6 , ! Receive ctl msg 7 , ! Receive ctl ct 8 , ! Send ctl ct 9 , ! Timeout 1 , ! Parent request id 2 ) ! Request options item list CALL check_forms_status( forms_status ) forms_status = forms$enable( forms$ar_form_table, ! Vector address 1 'ddif_form.doc', ! Device name 2 ddif_session_id, ! return from forms$ 3 forms$sample_form, ! Name of form file 4 ! The following trailing pars can be omitted 5 , ! Name of form 6 , ! Receive ctl msg 7 , ! Receive ctl ct 8 , ! Send ctl ct 9 , ! Timeout 1 , ! Parent request id 2 ) ! Request options item list CALL check_forms_status( forms_status ) C Initialize the descriptor with ACCOUNT structure info descriptor1.reclen = sizeof(account) descriptor1.address = %loc(account) C Tell the form all the account information: C The account record. C The balance and the next check number. forms_status = forms$send( session_id, ! session id 1 'account', ! form record 2 count, ! number of records sent 3 ,, ! receive ctl text msg/cnt 4 ,, ! send ctl text msg/cnt 5 , ! timeout 6 , ! parent request id 7 , ! request options item list 8 descriptor1, ! info sent to form 9 ) ! shadow rec CALL check_forms_status( forms_status ) C Do major program loop, until operator requests exit. menu_choice = 0 DO WHILE (menu_choice .NE. 1) C Initialize both descriptors with UPDATE and MENU_CHOICE info descriptor1.reclen = sizeof(update) ! word + longword descriptor1.address = %loc(update) ! address of update descriptor2.reclen = sizeof(menu_choice) ! word descriptor2.address = %loc(menu_choice)! address of menu_choice C Send the current state of the dynamic account information and C request the return of an option of what to do next: 1, 2, or 3. C Note that the form will validate and return only those values. forms_status = forms$transceive( session_id, ! session id 1 'update', ! rec id - send 2 %ref(count), ! rec cnt - send 3 'operator_choice', ! rec id - recv 4 %ref(count), ! rec cnt - recv 5 ,, ! receive ctl txt 6 ,, ! send ctl txt 7 , ! timeout 8 , ! parent req id 9 , ! request options item list 1 descriptor1, ! send record 2 , ! send shadow 3 descriptor2, ! recv record 4 ) ! recv shadow CALL check_forms_status( forms_status ) IF (menu_choice .EQ. 2) THEN C Initialize descriptor with GET_CHECK info descriptor1.reclen = sizeof(get_check) descriptor1.address = %loc(get_check) C Write a check. C Ask the operator for the check information and update account C balance and the check number. C Note that validation in the form guarantees that the amount C of the check is always greater than zero and that the C balance can cover the check. forms_status = forms$receive( session_id, ! session id 1 'get_check', ! form record 2 %ref(count), ! # of records sent 3 ,, ! receive ctl text 4 ,, ! send ctl text 5 , ! timeout 6 , ! parent request id 7 , ! request options item list 8 descriptor1, ! info sent to form 9 ) ! shadow record CALL check_forms_status( forms_status ) C Update the account balance and check number update.balance = update.balance - get_check.check_amount update.check_number = update.check_number + 1 ELSEIF (menu_choice .EQ. 3) THEN C Initialize descriptor with GET_DEPOSIT info descriptor1.reclen = sizeof(get_deposit) descriptor1.address = %loc(get_deposit) C Make a deposit C Ask the operator for the deposit information and update C the account balance. forms_status = forms$receive( session_id, ! session id 1 'get_deposit', ! form record 2 %ref(count), ! nbr records sent 3 ,, ! receive ctl text 4 ,, ! send ctl text 5 , ! timeout 6 , ! parent req id 7 , ! request options item list 8 descriptor1, ! info sent 9 ) ! shadow record CALL check_forms_status( forms_status ) update.balance = update.balance + get_deposit.deposit_amount ENDIF ENDDO C Clean up, Print ending message on console, leave. forms_status = forms$disable( ddif_session_id ) CALL check_forms_status( forms_status ) forms_status = forms$disable( session_id ) CALL check_forms_status( forms_status ) PRINT *, 'FORTRAN DECforms Sample Program ending.' END SUBROUTINE check_forms_status( forms_status ) C Check the parameter for success. If not success, print the error and stop. INTEGER forms_status IF (.NOT. forms_status) THEN CALL LIB$SIGNAL( %VAL(forms_status) ) STOP ENDIF END SUBROUTINE print_check( payto, amount, memo ) C Send the check data to a DDIF file. INCLUDE 'forms_sample_common.f' CHARACTER*35 payto INTEGER amount CHARACTER*35 memo INTEGER forms_status, 1 count/1/ STRUCTURE /descriptor/ INTEGER*2 reclen BYTE type /DSC$K_DTYPE_T/ ! string type BYTE class /DSC$K_CLASS_S/ ! static string INTEGER*4 address END STRUCTURE RECORD /descriptor/ descriptor1 C Initialize the descriptor with ACCOUNT structure info descriptor1.reclen = sizeof(account) descriptor1.address = %loc(account) C Send the static account information to be printed C (i.e., the account record). forms_status = forms$send( ddif_session_id, ! session id 1 'account', ! form record 2 count, ! number of records sent 3 ,, ! receive ctl text msg/cnt 4 ,, ! send ctl text msg/cnt 5 , ! timeout 6 , ! parent request id 7 , ! request options item list 8 descriptor1, ! info sent to form 9 ) ! shadow rec CALL check_forms_status( forms_status ) C Initialize the descriptor with the current check number descriptor1.reclen = sizeof(update) descriptor1.address = %loc(update) C Send the dynamic account information to be printed C (i.e., check number). forms_status = forms$send( ddif_session_id, ! session id 1 'update', ! form record 2 count, ! number of records sent 3 ,, ! receive ctl text msg/cnt 4 ,, ! send ctl text msg/cnt 5 , ! timeout 6 , ! parent request id 7 , ! request options item list 8 descriptor1, ! info sent to form 9 ) ! shadow rec CALL check_forms_status( forms_status ) C Fill in current values for GET_CHECK structure get_check.check_payto = payto get_check.check_amount = amount get_check.check_memo = memo C Initialize the descriptor with GET_CHECK structure info descriptor1.reclen = sizeof(get_check) descriptor1.address = %loc(get_check) C Send the check-specific information to be printed C (i.e., check amount, to whom, and possibly memo). forms_status = forms$send( ddif_session_id, ! session id 1 'get_check', ! form record 2 count, ! number of records sent 3 ,, ! receive ctl text msg/cnt 4 ,, ! send ctl text msg/cnt 5 , ! timeout 6 , ! parent request id 7 , ! request options item list 8 descriptor1, ! info sent to form 9 ) ! shadow rec CALL check_forms_status( forms_status ) END