10  %TITLE "<LOV>"
    %SBTTL "List of Values"
    %IDENT "V01.00"
    !
    !			    COPYRIGHT (c) 1988 BY
    !		Bert Roseberry, U. S. Coast Guard, Washington, D.C.
    !
    !		Bert Roseberry	      or      Bert Roseberry
    !		Commandant (G-APS-3)	      P. O. Box 175
    !		2100 Second St., S.W.	      Manassas, VA  22110
    !		Washington, DC 20593	      (703) 368-4350
    !		(202) 267-2624
    !
    ! THIS SOFTWARE IS FURNISHED FREE AND MAY BE USED AND COPIED ONLY 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 THE U.S. COAST GUARD.
    !
    ! THE U.S. COAST GUARD ASSUMES NO RESPONSIBILITY FOR THE USE OR RELI-
    ! ABILITY OF ITS SOFTWARE.
    !
    !++
    !
    ! FACILITY:
    !
    !	LOV.BAS
    !
    ! ABSTRACT:
    !
    !	This is the function that allows a user to choose from a list of 
    !	values stored in a data file
    !
    ! ENVIRONMENT:
    !
    !	VAX-11 user mode.
    !
    ! AUTHOR: Bert Roseberry, CREATION DATE: 7 Sep 1988
    !
    ! MODIFIED BY:
    !
    !	Bert Roseberry, 	07-SEP-88: VERSION 01.00
    ! 00 - Original version of module.					BAR
    !
    !--
    %SBTTL "Full description"
 
    FUNCTION INTEGER LOV 						&
    (STRING IN_STR, STRING OUT_STR, STRING BORDER_STR, 			&
     LONG LN_DOWN, LONG LN_OVER, LONG STR_WIDTH, LONG STR_DEPTH,	&
	             LONG SCRN_CLR_BEF, LONG SCRN_CLR_AFT) 
 
    !++
    !
    ! FUNCTIONAL DESCRIPTION:
    !
    !	Use SMG functions to act as a "pop up" list of values
    !   	Format:
    !			LOV(s1,s2,s3,l1,l2,l3,l4,l5,l6)
    !	where:
    !		s1 - name of file containing the LOVs
    !		s2 - string selected
    !		s3 - string for the LOV border
    !		l1 - number of lines from top of screen
    !		l2 - number of columns from left side of screen
    !		l3 - width of string to display
    !		l4 - number of strings to display
    !		l5 - 1 to save screen, 0 to clear screen when starting
    !		l6 - 1 to save screen, 0 to clear screen when done
    !
    !
    ! FORMAL PARAMETERS:
    !
    !	<name>.<access type><data type>.<arg mech><arg form>
    !	    <access type> is m, r, or w for modify, read, or write.
    !	    <datatype> is b, d, g, h, l, p, s, t, or w
    !	    <arg mech> is d, r, or v for BY DESC, BY REF, or BY VALUE.
    !	    <arg form> is <null> or a for scalar or array.
    !
    !
    ! IMPLICIT INPUTS:
    !
    !	None
    !
    ! IMPLICIT OUTPUTS:
    !
    !	None
    !
    ! FUNCTION VALUE:
    !
    !
    ! SIDE EFFECTS:
    !
    !--
    %SBTTL "Declarations"
    !
    ! ENVIRONMENT SPECIFICATION:
    !
    !
    ! INCLUDE FILES:
    !
    %INCLUDE "$SMGDEF" %FROM %LIBRARY "SYS$SHARE:BASIC$STARLET.TLB"
    !
    ! EQUATED SYMBOLS:
    !
    !	DECLARE <datatype> CONSTANT					&
    !	<name> = <value>,		 <Description>			&
    !	<name> = <value>		 <Description>

	DECLARE LONG CONSTANT						&
	max_str_width = 160,						&
    !				Max width of LOV			&
	max_str_num = 250						&
    !				Max number of LOV elements

    !
    ! LOCAL STORAGE:
    !
    !	 RECORD <name>			 <Description>
    !	<record declaration>
    !	END RECORD
 
        RECORD full_lov_rec
            STRING  str  = max_str_width
        END RECORD full_lov_rec

     !   RECORD full_composed_rec
     !       STRING  st2  = str_width
     !   END RECORD full_composed_rec


    DECLARE								&
	LONG								&
	    stat,							&
    !				Holds return from function calls	&
	    num_lines,							&
    !				Number of lines				&
	    mmid,							&
    !				Display id				&
	    pbid,							&
    !				Pasteboard id				&
	    kbid,	 						&
    !				Keyboard id				&
	    lchr,							&
    !				Character from keyboard			&
	    row,							&
    !				Used for rows				&
	    col,		 					&
    !				Used for columns			&
	    disp_down,		 					&
    !				Amount records are positioned down     	&
	    disp_right,       	 					&
    !				Amount records are positioned right	&
	    i,								&
    !				Counter of sorts			&
	    j,								&
    !				Counter of sorts			&
	    num_recs,		       					&
    !				Number of records in file      		&
	    rec_width,	       						&
    !				Record width of largest record	       	&
	STRING								&
	    comp_str,							&
    !				Composed string for displaying		&
    !	FULL_COMPOSED_REC	       					&
    !	    fcr,       		   					&
    !    			Composed record for displaying  	&
	FULL_LOV_REC							&
	    flr(max_str_num)	   					&
    !    			Array to hold LOV             		&

    !
    ! GLOBAL STORAGE:
    !
    !COMMON (<name>)			 <Description>			&
    !	<datatype>							&
    !	    <name>,			 <Description>			&
    !	    <name>,			 <Description>			&
    !	<datatype>							&
    !	    <name>,			 <Description>			&
    !	    <name>			 <Description>
 
    !MAP (<name>)			 <Description>			&
    !	<datatype>							&
    !	    <name>,			 <Description>			&
    !	    <name>,			 <Description>			&
    !	<datatype>							&
    !	    <name>,			 <Description>			&
    !	    <name>			 <Description>
 
    !
    ! EXTERNAL REFERENCES:
    !
 
    !EXTERNAL <datatype> CONSTANT					&
    !	<name>				 <Description>
 
    EXTERNAL INTEGER	CONSTANT					&
	SS$_NORMAL,							&
    !			      normal return from sys call		&
	SMG$_WRONUMARG,							&
    !				another SMG error			&
	SMG$_INVDIS_ID
				

    !EXTERNAL <datatype>						&
    !	<name>				 <Description>
    !EXTERNAL <datatype> FUNCTION					&
    !	<name>				 <Function description> 	&
    !	   (<datatype> BY <mech>,	 <Argument description> 	&
    !	    <datatype> BY <mech>)	 <Argument description>
 
    EXTERNAL INTEGER	FUNCTION					&
	SMG$CREATE_PASTEBOARD,						&
    !					Create a pasteboard		&
	SMG$CREATE_VIRTUAL_DISPLAY,					&
    !					Create a virtual display	&
	SMG$PASTE_VIRTUAL_DISPLAY,					&
    !					Paste up a virtual display	&
	SMG$READ_KEYSTROKE,						&
    !					Read each keystroke		&
	SMG$LABEL_BORDER,						&
    !					Label border			&
	SMG$PUT_CHARS,							&
    !					Put up characters		&
	SMG$PUT_LINE,							&
    !					Put up an entire line		&
	SMG$SET_CURSOR_ABS,						&
    !					Set up an absolute position	&
	SMG$SET_CURSOR_REL,						&
    !					Set up a relative position	&
	SMG$HOME_CURSOR,						&
    !					Set up cursor home		&
	SMG$CREATE_VIRTUAL_KEYBOARD,					&
    !					Set up a virtual keyboard	&
	SMG$DELETE_VIRTUAL_KEYBOARD,					&
    !					Delete a virtual keyboard	&
	SMG$DELETE_PASTEBOARD,						&
    !					Delete a pasteboard		&
	SMG$BEGIN_DISPLAY_UPDATE,					&
    !					Begin display update		&
	SMG$END_DISPLAY_UPDATE						&
    !					End display update

 
    !EXTERNAL SUB							&
    !	<name>				 <Function description> 	&
    !	   (<datatype> BY <mech>,	 <Argument description> 	&
    !	    <datatype> BY <mech>)	 <Argument description>
 
    !
    ! INTERNAL REFERENCES:
    !
 
    !DECLARE <datatype> FUNCTION					&
    !	<name>				 <Function description> 	&
    !	   (<datatype>, 		 <Argument description> 	&
    !	    <datatype>) 		 <Argument description>
 
	%SBTTL "Environment initialization"
 
	!+
	!   Set up global error handler
	!-
 
	%SBTTL "Set up paste and key boards"
 
1000	VALIDATE_ANSWERS:

	!+
	!	Check the lines down
	!-

	IF ln_down > 21 THEN
	   ln_down = 21
	END IF

	!+
	!	Check the lines over
	!-

	IF ln_over > 78 THEN
	   ln_over = 78
	END IF

	!+
	!	Check the string width
	!-

	IF (str_width + ln_over) > 78 THEN
	   str_width = (78 - ln_over)
	END IF

	!+
	!	Check the string depth
	!-

	IF (str_depth + ln_down) > 21 THEN
	   str_depth = (21 - ln_down)
	END IF

	!+
	!	Set up screens to clear 
	!
	!	  For: PASTING  
	!	  User enters 1  we want to save.  We display 1
	!
	!	  For: DELETING
	!	  User enters 1  we want to save.  We display 0
	!-

	IF scrn_clr_bef <> 1 THEN
	   scrn_clr_bef =  0 ELSE
	   scrn_clr_bef =  1
	END IF

	IF scrn_clr_aft <> 1 THEN
	   scrn_clr_aft =  1 ELSE
	   scrn_clr_aft =  0
	END IF

	!+
	!	First set up the pasteboard
	!-

	stat = SMG$CREATE_PASTEBOARD(pbid,"SYS$OUTPUT:",row,col,scrn_clr_bef)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from CREATE_PASTEBOARD"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	stat = SMG$CREATE_VIRTUAL_KEYBOARD(kbid,"SYS$INPUT")

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from CREATE_KEYBOARD"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	%SBTTL "Create virtual display"
 
2000	CREATE_VIRTUAL_DISPLAY:

	!+
	!	Now create the one virtual display
	!-

	stat = SMG$CREATE_VIRTUAL_DISPLAY(str_depth,str_width,mmid,,,)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from CREATE_VIRTUAL_DISPLAY"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Now label all the borders
	!-

	stat = SMG$LABEL_BORDER(mmid,border_str)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from LABEL_BORDER"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Create the proper offset (allow for border)
	!-

	ln_down = ln_down + 2

	!+
	!	Paste up the Choice Menu
	!-

	stat = SMG$PASTE_VIRTUAL_DISPLAY(mmid,pbid,ln_down,ln_over)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from PASTE_VIRTUAL_DISPLAY"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	row = 1

	col = 1

	i = 0

	%SBTTL "Load up the array"
 
3000	LOAD_ARRAY:

	!+
	!	Open the datafile and load the array up 
	!-

	!+
        !	Specify file errors
        !-

	WHEN ERROR IN

	!+
        ! 	Open input file.
        !-

        OPEN in_str FOR INPUT AS FILE #1%, 				&
		SEQUENTIAL VARIABLE, 					&
            	RECORDSIZE  32767%,	 				&
		RECORDTYPE ANY,						&
		ACCESS READ,						&
		ALLOW MODIFY

	WHILE 1%

	    GET #1%, REGARDLESS

	    i = i + 1

            MOVE FROM #1%, flr(i)::str = RECOUNT

	    IF rec_width < RECOUNT THEN
	       rec_width = RECOUNT
	    END IF

	NEXT

	USE

	SELECT ERR

	   CASE = 11%
	      CLOSE #1%

	   CASE ELSE
	      print "Error Number"; err

	END SELECT

	END WHEN

	!+
	!	Record width cannot be less that string width supplied
	!	Record width cannot be more than max string width
	!	Number of records cannot be more than max number of strings
	!-

	IF rec_width < str_width THEN
	   rec_width = str_width
	END IF

	IF rec_width > max_str_width THEN
	   rec_width = max_str_width
	END IF

	IF i > max_str_num THEN
	   num_recs = max_str_num ELSE
	   num_recs = i
	END IF

	!+
	!	Initialize DISP_DOWN, DISP_RIGHT, ROW, and COL
	!-

	row = 1
	col = 1
	disp_down  = 0
	disp_right = 0

	%SBTTL "Read each keystroke"
 
4000	READ_AND_WRITE:

	!+
	!	Start a loop while the terminator is not hit 
	!-

	WHILE lchr <> 270

	stat = SMG$BEGIN_DISPLAY_UPDATE(mmid)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from BEGIN_DISPLAY_UPDATE"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Now set cursor position
	!-

	stat = SMG$HOME_CURSOR(mmid)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from HOME_CURSOR"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	FOR i = 1 TO str_depth

	   j = i + disp_down

	   IF j > num_recs THEN
	      comp_str = SPACE$(str_width) ELSE
	      comp_str = SEG$(flr(j)::str,1+disp_right,str_width+disp_right)
	   END IF

	   IF i = row THEN
	      stat = SMG$PUT_LINE(mmid,comp_str,,SMG$M_REVERSE,,,)  ELSE
	      stat = SMG$PUT_LINE(mmid,comp_str,,,,,)
	   END IF

	   IF (stat AND 1%) <> ss$_normal THEN
	      PRINT "Error from PUT_LINE"
	      CALL LIB$STOP (stat BY VALUE)
	   END IF

	NEXT i

	stat = SMG$END_DISPLAY_UPDATE(mmid)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from END_DISPLAY_UPDATE"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Now set cursor position
	!-

	stat = SMG$HOME_CURSOR(mmid)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from HOME_CURSOR"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	i = row - 1
	j = col - 1

	stat = SMG$SET_CURSOR_REL(mmid,i,j)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from SET_CURSOR_REL"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Now read keystrokes
	!-

	stat = SMG$READ_KEYSTROKE(kbid,lchr,,)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from READ_KEYSTROKE"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	SELECT lchr

	!+
	!	Up Arrow
	!-

	CASE 274

		row = row - 1

		IF row = 0 AND disp_down > 0 THEN
		   disp_down = disp_down - 1
		   row = 1
		END IF

		IF row = 0 AND disp_down = 0 THEN
		   row = 1
		END IF


	!+
	!	Down Arrow
	!-

	CASE 275

		row = row + 1

		IF row > num_recs AND num_rec <= str_depth THEN
		   row = num_recs
		END IF

		IF row > str_depth AND (num_recs - disp_down) > str_depth THEN
		   disp_down = disp_down + 1
		   row = str_depth
		END IF

		IF row > str_depth AND (num_recs - disp_down) = str_depth THEN
		   row = str_depth
		END IF

	!+
	!	Left Arrow
	!-

	CASE 276

		col = col - 1

		IF col = 0 AND disp_right > 0 THEN
		   disp_right = disp_right - 1
		   col = 1
		END IF

		IF col = 0 AND disp_right = 0 THEN
		   col = 1
		END IF

	!+
	!	Right Arrow
	!-

	CASE 277 

		col = col + 1

		IF col > str_width AND str_width = rec_width THEN
		   col = str_width
		END IF

		IF col > str_width AND (rec_width - disp_right) > str_width THEN
		   disp_right = disp_right + 1
		   col = str_width
		END IF

		IF col > str_width AND (rec_width - disp_right) = str_width THEN
		   col = str_width
		END IF


	END SELECT

	NEXT

 	%SBTTL "Clean up and return"

5000	CLEANUP_PART:

	!+
	!	Delete things created
	!-

	stat = SMG$DELETE_VIRTUAL_KEYBOARD(kbid)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from DELETE_VIRTUAL_KEYBOARD"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	stat = SMG$DELETE_PASTEBOARD(pbid,scrn_clr_aft)

	IF (stat AND 1%) <> ss$_normal THEN
	   PRINT "Error from DELETE_VIRTUAL_KEYBOARD"
	   CALL LIB$STOP (stat BY VALUE)
	END IF

	!+
	!	Paste back in the output line
	!-

	out_str = SEG$(flr(row + disp_down)::str,1,rec_width)

 	%SBTTL "Exit and return"

32000	EXIT_PART:
 
	!+
	!	Exit module
	!-
 
32767	FUNCTIONEND 1%