*
*			DECforms Text Library Access Demo
*
* 		         COPYRIGHT (c) 1989 BY
* 	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
*
*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
*  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR  ANY  OTHER
*  COPIES  THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
*  TRANSFERRED.
*
*  THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE  WITHOUT  NOTICE
*  AND  SHOULD  NOT  BE  CONSTRUED  AS  A COMMITMENT BY DIGITAL EQUIPMENT
*  CORPORATION.
*
*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF  ITS
*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
*
IDENTIFICATION DIVISION.
PROGRAM-ID. forms$demo_Show_Textlib.
*
* This program is designed to demonstrate the scrolling of text using 
* a DECforms group and access to that text from a text library.
* It either calls the DECforms form "forms$demo_Show_textlib" 
* or uses accept/display.
* The latter was used during development and is left as a possible debugging
* tool. You must edit the source and re-compile to use the accept/display 
* version.
*
* The access to a text library is done via a called program that is named
* "Forms$Demo_Textlib" which is called by a Procedural Escape in the Form.
*
* To use this demo, just run the program.
*
* To re-create the demo, you need to do:
*     $ cobol forms$demo_show_textlib
*     $ forms tran forms$demo_show_textlib
*     $ forms extract object  forms$demo_show_textlib -
*		/obj=forms$demo_show_textlib_form
*     $ link forms$demo_show_textlib,forms$demo_show_textlib_form, -
*		forms$demo_textlib
* 
DATA DIVISION.
WORKING-STORAGE SECTION.
01 program-version pic x(7) value "2.00-00".
01 ret-status pic s9(9) comp.
01 action pic X.
01 file-name pic x(30) value "sys$help:forms$fde_help.hlb".
01 key-name pic X(30) value "MAIN_HELP".
01 topic.
	03 text-line pic x(65) occurs 125.
01 line-count pic 9(9) comp value zero.
01 i          pic 9(4) comp value zero.
01 display-count pic 9(4).
01 nbr-of-displays	Pic s9(9) comp.
01 max-first		Pic s9(9) comp.
01 max-first-by-page 	Pic s9(9) comp.
01 display-error pic 9(9).
*+
* The DECforms definitions
*-
COPY "sys$library:forms$cob_definitions.lib".
*+
* Information that is transferred between this program and DECforms
*-
01  session_id	    			PIC X(16)		GLOBAL.
01  form_file				PIC X(30) 	
					VALUE "FORMS$DEMO_SHOW_TEXTLIB".
01  form_name				PIC X(30) 	
					VALUE "SHOW_TEXTLIB_FORM".
01  device_name 			PIC X(9) 	VALUE "SYS$INPUT".
01  forms_status			PIC S9(9)  COMP		GLOBAL.
*
* the item 'binary_zero' is there to ensure that I can pass a binary zero
* to indicate an unused parameter in a Forms call
01 binary_zero		 	   PIC S9(5) COMP VALUE 0.
*

PROCEDURE DIVISION.
start-here.

	display "Text Library access program (version ", 
		 program-version, ") starting...".

* if you want to access textlibrary directly, uncomment the next line
* and comment out the use-form line.
*	perform get-text thru get-text-exit until key-name equal "X".

	perform use-form.

	display "ending...".

	stop run.

use-form.

    CALL "forms$enable" USING BY VALUE forms$ar_form_table
    			      BY DESCRIPTOR device_name		
    			      BY DESCRIPTOR session_id
			      BY DESCRIPTOR form_file
			      BY DESCRIPTOR form_name

			GIVING forms_status.
    CALL "check_forms_status" USING forms_status.

    CALL "forms$disable" USING BY DESCRIPTOR session_id
    	    		 GIVING forms_status.
    CALL "check_forms_status" USING forms_status.
    	

get-text.

	display "enter key name:"
	accept key-name.

	if key-name equal "X" then go to get-text-exit.
	move "1" to action.
	call "forms$demo_textlib"
	using 
	     by reference action
	     by reference file-name
	     by reference key-name
	     by reference topic
	     by reference line-count
	     by reference nbr-of-displays
	     by reference max-first
	     by reference max-first-by-page
	     by reference ret-status.

	if ret-status is failure
	then 
		move ret-status to display-error
		Display "error ", 
		        display-error, 
			" returned from access to text library"
		end-if.

	if line-count not equal 1 then display "here comes the text..."

	move 1 to i.
	perform display-text line-count times.
	move line-count to display-count.
	display "line count is ", display-count.

get-text-exit.
	exit.

display-text.

	display text-line(i)
	add 1 to i.


/
IDENTIFICATION DIVISION.
*              ******************
PROGRAM-ID.    check_forms_status COMMON.
*              ******************
*+
* If parameter is success, return; else print error message and stop.
*-

DATA DIVISION.
WORKING-STORAGE SECTION.
 
LINKAGE SECTION.
01  forms_status			PIC S9(9)  COMP.

PROCEDURE DIVISION USING forms_status.
0.
    IF forms_status IS FAILURE THEN
	CALL "LIB$SIGNAL" USING BY VALUE forms_status
    	STOP RUN
    END-IF.
END PROGRAM check_forms_status.

END PROGRAM Forms$Demo_Show_Textlib.

/
IDENTIFICATION DIVISION.
*              ******************
PROGRAM-ID.    FORMS$DEMO_ADD_LONGWORD.
*              ******************

DATA DIVISION.
WORKING-STORAGE SECTION.
 
LINKAGE SECTION.
01  p1	pic s9(9) comp.
01  p2	pic s9(9) comp.
01  p3	pic s9(9) comp.

PROCEDURE DIVISION USING p1 p2 p3.
0.
	Add p1 to p2 giving p3.

END PROGRAM FORMS$DEMO_ADD_LONGWORD.

/
IDENTIFICATION DIVISION.
*              ******************
PROGRAM-ID.    FORMS$DEMO_SUBTRACT_LONGWORD.
*              ******************

DATA DIVISION.
WORKING-STORAGE SECTION.
 
LINKAGE SECTION.
01  p1	pic s9(9) comp.
01  p2	pic s9(9) comp.
01  p3	pic s9(9) comp.

PROCEDURE DIVISION USING p1 p2 p3.
0.
	Subtract p2 from p1 giving p3.

END PROGRAM FORMS$DEMO_SUBTRACT_LONGWORD.