*
*			DECforms Text Library Access
*
* 		         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_Textlib.
*
* This is a routine that extracts text modules out of a text or help library
* and returns it in a character array. Note that the key structure of a help
* library is not used and so only a single level help library should be 
* accessed by this PEU.
*
* It is designed to be called from a DECforms Form as a PEU or Procedural
* Escape Unit.
* In order to help scrolling on the screen, it also returns information 
* on the number of lines in the text module and how to detect when to stop 
* scrolling. This latter information will not be necessary once subscript 
* ranges are implemented and the form can deactivate lines that are past 
* the end of the text.
*
* There are two types of call according to the value of textlib_action:
*	"1" causes a text module to be read. if this is the first call
*	    or if the .tlb file name changes, then a new .tlb file is opened.
*	"2" close the library -- if you know you won't be needing it quickly
*
* Example IFDL follows:
*
*	Form Data
*		textlib_name		Character(30)
*		textlib_status		Longword Integer
*		textlib_action		Character(1) 
*		key_name		Character(30)
*		Group TXT_GRP           /* Base starts at 1 by default */
*    			Occurs 125
*    			TXT_LINE 	Character(65) 
*			End Group
*		TXT_GRP_MAX 		Longword Integer /* # lines returned */
*		Txt_Grp_Base		Longword Integer /* base of group */
*                       Value 1
*		Txt_Grp_Displays	Longword Integer /* # displays on panel */
*					value 10
*		Txt_grp_max_first	Longword Integer
*		Txt_grp_max_first_by_page Longword Integer
*
*/*
*   txt_grp_max_first gets the value that FIRST will be when the last element
*   is displayed on the last line of the display ie (max - (displays - 1))
*
*   txt_grp_max_first_by_page gets the value that FIRST will be when the last 
*   element is displayed on the last page and SCROLL BY PAGE is used.
*   ie (max - (rem - 1)) where rem = max/displays
**/
*   End Data
*	xxx Response
*		let textlib_action = "1"
*		call "textlib"
*		using 
*		     by reference textlib_action
*		     by reference textlib_name
*		     by reference key_name
*		     by reference PE_text_group
*		     by reference txt_grp_base
*		     by reference txt_grp_displays
*		     by reference txt_grp_max_first
*		     by reference txt_grp_max_first_by_page
*		     by reference textlib_status
*
*		if textlib_status <> 1
*		then 
*		    signal	          
*			Message "error number " textlib_status
*				" returned from access to text library"
*				textlib_name " using key " key_name
*		else position to field txt_grp.txt_line(0) on Text_Scroll_Panel
*		end if
*
* Summary of return values:
*	1  = success
*	2  = library setup failed (internal error)
* 	4  = library open failed; file not present or not text/help library
*	6  = key lookup failed; module not in library
*	8  = library close failed.
*	10 = action code not valid
*	12 = library text too long for group (>125 lines)
*
DATA DIVISION.
WORKING-STORAGE SECTION.
01 program-version pic x(7) value "1.01-00".
01 ret-status 		Pic s9(9) comp.
01 ss$_normal 		Pic S9(5) comp value external SS$_normal.
01 library-index 	Pic 9(9) comp value zero.
* function code is external lbr$C_Read:
01 function-code 	Pic 9(9) comp value 1. 
* library type is external lbr$C_typ_txt:
01 library-type 	Pic 9(9) comp value 4.  
01 rfa.
	03 rfa-1	Pic 9(9) comp value zero.
	03 rfa-2	Pic 9(9) comp value zero.
01 i          		Pic 9(4) comp value zero.
01 line-80.
	03 line-65    	Pic x(65).
	03 line-65-80 	Pic x(15).
01 last_library_name	Pic x(30).
01 page-count		Pic s9(9) comp.
01 rem-lines		Pic s9(9) comp.
*
LINKAGE SECTION.
01 action 		Pic x(1).
	88 read-action  value "1".
	88 close-action value "2".
01 library-name 	Pic x(30).
01 key-name 		Pic X(30).
01 topic.
	03 line-count 	Pic s9(9) comp.
	03 text-line 	Pic x(65) occurs 125.
01 nbr-of-displays	Pic s9(9) comp.
01 base-of-group	Pic s9(9) comp.
01 max-first		Pic s9(9) comp.
01 max-first-by-page 	Pic s9(9) comp.
01 textlib-status 	Pic s9(9) comp.

PROCEDURE DIVISION USING action, library-name,key-name,topic,
			 base-of-group,nbr-of-displays,max-first,
			 max-first-by-page,textlib-status.
start-here.

	Evaluate true

		when read-action	perform read-library 
					   thru read-library-exit
		when close-action	perform close-library
		when other 		perform no-action
		end-evaluate.

	exit program.

read-library.

	if library-index equal zero 
	or library-name not equal last-library-name
	then perform open-library.

	move spaces to topic.
	move zero to line-count, max-first, max-first-by-page.
	call "lbr$lookup_key"
		using by reference library-index,
		      by descriptor key-name,
		      by reference rfa
		giving ret-status.

	if ret-status is failure
	then move 6 to textlib-status
	     exit program
	end-if.


	move 1 to line-count.
	perform get-record until ret-status not equal ss$_normal.
	if textlib-status not equal 1 then go to read-library-exit.

* now calculate the max values for the first line on the display

* Line-count is 2 greater than it should be:
*	because 1) cobol groups start at 1 whereas IFDL group starts at 0
*		2) we add 1 to line-count after we put in the last line

	if line-count > 2 then subtract 2 from line-count

	if line-count < nbr-of-displays or line-count = nbr-of-displays 
	then move base-of-group to max-first, max-first-by-page
	else
	    divide line-count by nbr-of-displays 
	    giving page-count remainder rem-lines
	    compute max-first = (line-count - (nbr-of-displays - base-of-group) )
	    compute max-first-by-page = (line-count - (rem-lines - base-of-group) ).
	
read-library-exit.
	exit.

get-record.

	move spaces to line-80.
	
	call "lbr$get_record"
		using by reference library-index,
		      by descriptor line-80
		giving ret-status.

	if ret-status is success

	then move line-65 to text-line(line-count)
	     add 1 to line-count
	     if line-count > 125
	     then move 12 to textlib_status
	          exit program
		  end-if
	else move 1 to textlib-status
	end-if.

open-library.

*
* We don't include the library type, because that lets us open
* both .HLB's and .TLB's (even tho we don't use the help library
* key structure
*
	move zero to library-index.
	call "lbr$ini_control" 
		using by reference library-index,
		      by reference function-code,
		giving ret-status.
	
	if ret-status is failure
	then move 2 to textlib-status
	     exit program
	end-if.
	
	call "lbr$open"
		using by reference library-index,
		      by descriptor library-name
		giving ret-status.

	if ret-status is failure
	then move 4 to textlib-status
	     exit program

	end-if.

	move library-name to last-library-name.

close-library.

	call "lbr$close"
		using by reference library-index,
		giving ret-status.

 	move zero to library-index.
	if ret-status is failure
	then move 8 to textlib-status
	     exit program
	end-if.

no-action.

	move 10 to textlib-status.
	exit program.

END PROGRAM Forms$Demo_Textlib.