PROGRAM forms$sample_program_api

C 	         COPYRIGHT (c) 1991 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 sample application provided with the
C		DECforms V2.0 product.
C
C      AUTHORS:
C
C		Digital Equipment Corporation
C
C      CREATION DATE: 	 06-Nov-1991
C

C
C ------ Instructions ------
C
C If your system manager installed 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_API
C
C
C The DECforms INTRODUCTORY Sample Checking Application in the FORTRAN
C language consists of two files:
C
C	FORMS$SAMPLE_PROGRAM_API		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_API.FOR, -
C   			    FORMS$SAMPLE_FORM.IFDL  []
C   $
C   $! Compile the FORTRAN source:
C   $ 	FORTRAN FORMS$SAMPLE_PROGRAM_API.FOR
C   $
C   $! Translate the IFDL source form:
C   $ 	FORMS TRANSLATE FORMS$SAMPLE_FORM.IFDL
C   $
C   $! Link the FORTRAN object
C   $	LINK FORMS$SAMPLE_PROGRAM_API.OBJ, -
C                  SYS$INPUT/OPTIONS   <CR>
C		   SYS$LIBRARY:FORMS$PORTABLE_API/SHARE     <CTRL/Z>
C
C By default, the sample application will use the character cell layout.  If
C you would like to use the motif layout, the DECwindows display device must
C be set and the following logical must be defined:
C
C   $ DEFINE FORMS$DEFAULT_DEVICE DECW$DISPLAY
C
C If you would like to use the DDIF layout, this logical (FORMS$DEFAULT_DEVICE)
C must be defined as a file specification.  For example:
C
C   $ DEFINE FORMS$DEFAULT_DEVICE SYS$LOGIN:SAMPLE_CHECK.DOC
C
C This output file (DDIF) can then be viewed by the CDA DDIF viewer (the VIEW 
C command) or can be converted to Postscript (for printing) using the CDA 
C Postscript Converter (the CONVERT/DOCUMENT command).
C
C You can then run the executable in your own directory by simply typing:
C
C   $ RUN FORMS$SAMPLE_PROGRAM_API
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

 	IMPLICIT NONE

C
C Define constants
C 

	CHARACTER*(*)   forms$sample_form
	PARAMETER       (forms$sample_form =
	1		 'FORMS$EXAMPLES:forms$sample_form')
	
!********************************************************
! Declare the request routines				*
!********************************************************

	INCLUDE 'sys$library:formsdef.f'

C SESSION_ID is used to identify the form used on every call to the
C FORMS$... subroutines. FORMS_STATUS is returned from every call on
C the FORMS$... routines.

	CHARACTER*16 session_id
	INTEGER forms_status

C The ACCOUNT record is sent to the form at the beginning of the program
C to set the form data so it can appear on the check and deposit slip.

	STRUCTURE /account/
		INTEGER 	account_number 	/1594/
		CHARACTER*39	mail_name	/'Harold Q. Stevenson'/
		CHARACTER*30    street		/'134 North Elm Street'/
		CHARACTER*30	mail_csz	/'Elk Grove, MA 99943'/
	END STRUCTURE

	RECORD /account/ account

C The UPDATE record keeps the variable account information. It
C is sent to the form at the beginning of each exchange.

	STRUCTURE /update/
	       	INTEGER*2	check_number	/15/
	       	INTEGER		balance		/13251/ ! passed as pennies
	END STRUCTURE

	RECORD /update/ update

C The OPERATOR_CHOICE record is implemented as the menu_choice variable,
C a very simple record message.

	STRUCTURE /OPERATOR_CHOICE/
	    INTEGER*2	menu_choice 
	END STRUCTURE

	RECORD /operator_choice/ operator_choice

C The GET_CHECK record message is used only by a RECEIVE to get check
C information from the operator.

	STRUCTURE /get_check/
	       	INTEGER		check_amount	! passed as pennies
	       	CHARACTER*35	check_payto
	       	CHARACTER*35	check_memo
	END STRUCTURE

	RECORD /get_check/ get_check

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	standard structure that points to data record
	record/Forms_Record_Data/account_record_descr
	record/Forms_Record_Data/update_record_descr
	record/Forms_Record_Data/operator_choice_descr
	record/Forms_Record_Data/get_check_record_descr
	record/Forms_Record_Data/get_deposit_record_descr

C	structure must contain the length and address of the record
C	being sent to or received from DECforms
	account_record_descr.data_length = sizeof(account)
	account_record_descr.data_record = %loc(account)
	account_record_descr.shadow_record = 0 
	account_record_descr.shadow_length = 0

	update_record_descr.data_length = sizeof(update)
	update_record_descr.data_record = %loc(update)
	update_record_descr.shadow_record = 0 
	update_record_descr.shadow_length = 0

	operator_choice_descr.data_length = sizeof(operator_choice)
	operator_choice_descr.data_record = %loc(operator_choice)
	operator_choice_descr.shadow_record = 0 
	operator_choice_descr.shadow_length = 0

	get_check_record_descr.data_length = sizeof(get_check)
	get_check_record_descr.data_record = %loc(get_check)
	get_check_record_descr.shadow_record = 0 
	get_check_record_descr.shadow_length = 0

	get_deposit_record_descr.data_length = sizeof(get_deposit)
	get_deposit_record_descr.data_record = %loc(get_deposit)
	get_deposit_record_descr.shadow_record = 0 
	get_deposit_record_descr.shadow_length = 0
	

C Print startup message on console

	PRINT *, 'FORTRAN DECforms Sample Program starting.'

C Initialize the DECforms form & check for errors

	forms_status = forms_enable_for(session_id,	    ! session id
	1     				,		    ! device name
	2				forms$sample_form,  ! name of form file
	3				,)		    ! request options
		CALL check_forms_status( forms_status )


C Tell the form all the account information:
C	The account record.
C 	The balance and the next check number.

	forms_status = forms_send_for(session_id,	    ! session id
	1			    'account',		    ! form record
	2			    account_record_descr,
	3			    )		 
	CALL check_forms_status( forms_status )

C Do major program loop, until operator requests exit.

	operator_choice.menu_choice = 0
	DO WHILE (operator_choice.menu_choice .NE. 1)

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_for(session_id,		! session id
	1				    'update',		! rec id - send
	1				    update_record_descr,
	1				    'operator_choice',	! rec id - recv
	1				    operator_choice_descr,
	1				    )
	    CALL check_forms_status( forms_status )

	    IF (operator_choice.menu_choice .EQ. 2) THEN

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_for(session_id,	! session id
	1					'get_check',	! form record
	2					get_check_record_descr,
	3					)
		CALL check_forms_status( forms_status )

		update.balance = update.balance - get_check.check_amount
		update.check_number = update.check_number + 1

	    ELSEIF (operator_choice.menu_choice .EQ. 3) THEN

C		Make a deposit
C		Ask the operator for the deposit information and update
C		the account balance.

	        forms_status = forms_receive_for(session_id,	! session id
	1					'get_deposit',	! form record
	2					get_deposit_record_descr,
	3					)
		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_for(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 (forms_status .NE. 0) THEN
	    CALL LIB$SIGNAL( %VAL(forms_status) )
	    STOP
	ENDIF

	END