10	FUNCTION LONG EXT_MENU

	!======================================================================
  	!PROGRAM---------------------VERSION-------------------LANGUAGE--------
	!EXT_MENU     			2			BASIC
	!
	!DESCRIPTION-----------------------------------------------------------
	!Performs menu selection and port allocation for EXTERNAL
	!Menu displays facilities the current user is allowed to access.
	!When user selects a facility, selects and allocates a suitable port,
	!then returns port info via MENU_SELECTION_COM to calling routine.
	!
	!======================================================================

	%TITLE "EXTERNAL Menu Driver"
	%IDENT "EXT_MENU 88.10.12"
	%SBTTL "DOCUMENTATION SECTION"

	!**********************************************************************
	!			OPTIONS
	!**********************************************************************

	OPTION	TYPE = EXPLICIT			! Explicit declarations only

100	!**********************************************************************
	!			DOCUMENTATION SECTION
	!**********************************************************************
	!
	!======================================================================
	!			MODIFICATION HISTORY
	!======================================================================
	!VERSION--------AUTHOR------------------DATE------------APPROVAL-------
	!   1		Keith Walker		88.01.25	1723
	!   2		Keith Walker		88.10.12	1741
	!
	!======================================================================
	!			COMPILE/LINK/INSTALL INSTRUCTIONS
	!======================================================================
	!$BASIC EXT_MENU
	!$LINK/NOTRACE EXTERNAL,-
	!EXT_UNSOL_MBX_AST, EXT_READ_PORT_AST,-
	!EXT_PROC_BUF_AST, EXT_WRITE_TERM_AST,-
	!EXT_SCRIPT_INTERP, EXT_SCREEN_HDR,-
	!EXT_MENU, EXT_CONNECT_LOOP, CHKRDB
	!======================================================================

	!**********************************************************************
	!			FILES ACCESSED
	!**********************************************************************
	!     NAME	    MODE    CHANNEL		  DESCRIPTION
	!--------------	   ------   -------	-------------------------------
	!LF_MENU	    READ    MENU_FILE	menu file
	!LF_PORTS	    READ    PORTS_FILE	port selection file
	!   		
	!**********************************************************************

	%PAGE
	%SBTTL "DECLARATION SECTION"
200	!======================================================================
	!			DECLARATION SECTION
	!======================================================================

	!**********************************************************************
	!			%INCLUDE FILE DECLARATIONS
	!**********************************************************************

	%INCLUDE "$PSLDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB"
	%INCLUDE "EXT_COMMON.BAS"

	!**********************************************************************
	!			CONSTANTS
	!**********************************************************************

	DECLARE WORD CONSTANT &
		L_MENU = 100, &
		L_PORTS = 20

	!**********************************************************************
	!			RECORDS
	!**********************************************************************

	!**********************************************************************
	!			MAPS
	!**********************************************************************

	!**********************************************************************
	!			COMMONS
	!**********************************************************************

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	DECLARE WORD &
		ACCEPT_MENU,		!whether or not to accept menu item &
		ANY_PORT_EXISTS,	!TRUE if any suitable port exists &
		PORT_EXISTS		!TRUE if specified port type exists

	DECLARE LONG &
		FUNC_STAT,		!status from function &
		I,			!miscellaneous counter &
		ITEM_COUNT,		!counter to parse lists &
		MENU_COL1,		!number of items in 1 column &
		MENU_COL2,		!number of items in 2 column &
		MENU_COUNT,		!number of items in menu &
		MENU_INDEX,		!pointer to menu item &
		PORT_COUNT,		!number of items in ports list &
		PORT_INDEX,		!pointer to port info &
		SCREEN_LINES		!number of screen lines used

	DECLARE STRING &
		ALT_NODES,		!names of nodes where ports are avail &
		AVAIL_CLASS,		!class available for selected facility &
		DEBUG_FLAG,		!debug symbol from DCL &
					!0: no debugging &
					!1: print script parsing info &
					!2: print scripts & labels &
					!3: print interpreted lines &
					!4: print INPUT parameters &
					!5: print condition flags &
		MENU_CODE,		!code from menu item &
		MENU_FMT,		!print using string &
		MENU_INPUT,		!input string from user &
		MENU_NAME,		!name of selected facility &
		MENU_RIGHTS,		!rights list for menu item &
		MODEM_TYPE_S,		!type of modem for selected facility &
		OPTION_STRING,		!info from ports or menu file &
		PORT_NAME_S,		!name of selected port &
		PREF_CLASS,		!class preferred for selected facility &
		TRY_ANOTHER		!user's input to try another class

	!**********************************************************************
	!			ARRAYS
	!**********************************************************************

	DIMENSION STRING &
		MENU(L_MENU, 2%),	!holds menu text &
			      		!0: code, 1: name, 2: class &
		PORTS(L_PORTS, 2%)	!holds port info:
				  	!0: port, 1: class, 2: modem

	!**********************************************************************
	!			FUNCTIONS
	!**********************************************************************

	DECLARE STRING FUNCTION &
		GET_SUB_STR

	!**********************************************************************
	!			EXTERNAL CONSTANTS
	!**********************************************************************

	EXTERNAL LONG CONSTANT &
		PSL$C_SUPER, &
		SS$_ABORT, &
		SS$_NORMAL, &
		SS$_DEVNOTALLOC

	!**********************************************************************
	!			EXTERNAL FUNCTIONS
	!**********************************************************************

	EXTERNAL WORD FUNCTION &
		CHKRDB		!checks if user holds spec. Rights ID 

	EXTERNAL LONG FUNCTION &
		SYS$ALLOC

	EXTERNAL LONG &
		PARSE_MENU

	!**********************************************************************
	!			EXTERNAL SUBPROGRAMS
	!**********************************************************************

	EXTERNAL SUB &
		LIB$DO_COMMAND, &
		LIB$GET_SYMBOL, &
		LIB$SET_SYMBOL

	%PAGE
	%SBTTL "INITIALIZATION SECTION"
300	!======================================================================
	!			INITIALIZATION SECTION
	!======================================================================

	ON ERROR GOTO ERROR_HANDLING

	!**********************************************************************
	!	    		PRINT USING FORMATS
	!**********************************************************************

	MENU_FMT = &
		CHR$(27) + "['m" + &
		"   'RRR - 'LLLLLLLLLLLLLLLLLLLLLLLLLLLLL" + &
		CHR$(27) + "['m" + &
		"   'RRR - 'LLLLLLLLLLLLLLLLLLLLLLLLLLLLL" + &
		CHR$(27) + "[0m"

	!**********************************************************************
	!			VARIABLES
	!**********************************************************************

	CALL LIB$GET_SYMBOL("NODE", NODE_NAME)
	CALL LIB$GET_SYMBOL("DEBUG", DEBUG_FLAG)
	FUNC_STAT = SS$_NORMAL
	ALT_NODES = ""

	%PAGE
	%SBTTL "MAIN LOGIC SECTION"
1000	!======================================================================
	!			MAIN LOGIC SECTION
	!======================================================================

	GOSUB READ_PORTS	!read ports info
	IF PORT_COUNT = 0% THEN
	  PRINT "There are no external communication lines on node "; &
	  	TRM$(NODE_NAME); "."
	  PRINT "Please log onto "; ALT_NODES; " and try again."
	  FUNC_STAT = SS$_ABORT
	  GOTO END_OF_PROGRAM
	END IF

	GOSUB DISPLAY_SCREEN	!clear screen
	GOSUB READ_MENU		!read and display the menu
	GOSUB SELECT_MENU_ITEM	!ask for user's selection
	IF MENU_INDEX = 99% THEN	!user wants out
	  FUNC_STAT = SS$_ABORT
	  GOTO END_OF_PROGRAM
	END IF

	GOSUB GET_FAC_INFO	!get info on selected facility
	GOSUB GET_PORT		!try to allocate a port
	IF FUNC_STAT = SS$_ABORT THEN
	  GOTO END_OF_PROGRAM
	END IF
	IF FUNC_STAT = SS$_DEVNOTALLOC THEN
	  IF ANY_PORT_EXISTS THEN
	    PRINT "All suitable communication lines on node "; &
		TRM$(NODE_NAME); " are busy."
	  ELSE
	    PRINT "There are no suitable communication lines on node "; &
		TRM$(NODE_NAME)
	  END IF
	  PRINT "Please log onto another node and try again."
	  GOTO END_OF_PROGRAM
	END IF

	!all OK: set results in common block...
	FACILITY_CODE = MENU_CODE
	PORT_NAME = PORT_NAME_S
	MODEM_CLASS = AVAIL_CLASS
	MODEM_TYPE = MODEM_TYPE_S
	FACILITY_NAME = MENU_NAME

	!...and define symbols...
	CALL LIB$SET_SYMBOL("FACILITY", MENU_CODE, 1%)
	CALL LIB$SET_SYMBOL("PORT", PORT_NAME_S, 1%)
	CALL LIB$SET_SYMBOL("CLASS", AVAIL_CLASS, 1%)
	CALL LIB$SET_SYMBOL("MODEM_TYPE", MODEM_TYPE_S, 1%)
	GOSUB RESET_SCROLL	!reset scrolling region...
	IF DEBUG_FLAG <> "0" THEN
	  PRINT "FACILITY: "; MENU_CODE
	  PRINT "PORT: "; PORT_NAME_S
	  PRINT "CLASS: "; AVAIL_CLASS
	  PRINT "MODEM_TYPE_S: "; MODEM_TYPE_S
	END IF
	FUNC_STAT = SS$_NORMAL
	GOTO END_OF_PROGRAM

	%PAGE
	%SBTTL "SUBROUTINE DEFINITION SECTION"
15000	!======================================================================
	!			SUBROUTINE DEFINITION SECTION
	!======================================================================

 RESET_SCROLL:
	!**********************************************************************
	!clears VT100 scrolling region
	!**********************************************************************

	PRINT CHR$(27); "[1;24r"; CHR$(27); "[24;1H"
	RETURN

 GET_FAC_INFO:
 	!**********************************************************************
	!get info on selected facility
	!**********************************************************************

	MENU_CODE = MENU(MENU_INDEX, 0%)
	MENU_NAME = MENU(MENU_INDEX, 1%)
	IF DEBUG_FLAG <> "0" THEN
	  PRINT "FACILITY: "; MENU_CODE, MENU_NAME
	END IF
	RETURN

 GET_PORT:
 	!**********************************************************************
	!attempts to allocate a suitable port
	!returns FUNC_STAT
	!**********************************************************************

	PORT_EXISTS = FALSE
	ANY_PORT_EXISTS = FALSE
	I = 0%
	ITEM_COUNT = 0%

 GET_PORT_CLASS:
	ITEM_COUNT = ITEM_COUNT + 1%
	PREF_CLASS = GET_SUB_STR(MENU(MENU_INDEX, 2%), ITEM_COUNT)
	IF PREF_CLASS = "" THEN
	  GOTO NO_PORT_TYPE
	END IF

 FIND_A_PORT:
	!check for availability of port:
	PORT_EXISTS = FALSE
	IF DEBUG_FLAG <> "0" THEN
	  PRINT "Checking for "; PREF_CLASS; " port"
	END IF
	FOR PORT_INDEX = 1 TO PORT_COUNT
	  IF PORTS(PORT_INDEX, 1%) = PREF_CLASS THEN
	    PORT_EXISTS = TRUE
	    ANY_PORT_EXISTS = TRUE
	    !we have found a port: allocate it...
	    FUNC_STAT = SYS$ALLOC(PORTS(PORT_INDEX, 0%),,, &
		PSL$C_SUPER BY VALUE, )
	    IF (FUNC_STAT AND 1%) = 1% THEN
	      !we have got the port...                
	      GOTO PORT_ALLOCATED
	    END IF
	  END IF
	NEXT PORT_INDEX

 NO_PORT_TYPE:
	!couldn't find a port: try another class if specified...
	IF PORT_EXISTS THEN
	  PRINT
	  PRINT "All "; PREF_CLASS; " lines are busy."
	END IF
	IF GET_SUB_STR(MENU(MENU_INDEX, 2%), ITEM_COUNT + 1%) <> "" THEN
	  !we could try another type of port...
	  IF PORT_EXISTS THEN
	    INPUT "Do you wish to try another type of line"; TRY_ANOTHER
	    TRY_ANOTHER = EDIT$(SEG$(TRY_ANOTHER, 1, 1), 32)
	  ELSE
	    TRY_ANOTHER = "Y"
	  END IF
	  IF TRY_ANOTHER = "N" THEN
	    FUNC_STAT = SS$_ABORT
	    RETURN
	  ELSE
	    GOTO GET_PORT_CLASS
	  END IF	!try another
	END IF	!get_sub_str

	!no other classes: sorry
	FUNC_STAT = SS$_DEVNOTALLOC
	RETURN

 PORT_ALLOCATED:
	PORT_NAME_S = PORTS(PORT_INDEX, 0%)
	AVAIL_CLASS = PORTS(PORT_INDEX, 1%)
	MODEM_TYPE_S = PORTS(PORT_INDEX, 2%)
	FUNC_STAT = SS$_NORMAL
	PRINT CHR$(27); "[2J"; CHR$(27); "[24;1H";
	PRINT "Line type "; AVAIL_CLASS; " allocated"
	IF DEBUG_FLAG <> "0" THEN
	  PRINT "Port "; PORT_NAME_S; " ("; MODEM_TYPE_S; ") allocated"
	END IF
	RETURN

 SELECT_MENU_ITEM:
 	!**********************************************************************
	!get user to select a menu item
	!**********************************************************************

	PRINT
	WHEN ERROR IN
	  INPUT "       Enter number of selection"; MENU_INPUT
	USE
	  IF ERR = 11 THEN	!ctrl/z
	    MENU_INPUT = "EXIT"
	    CONTINUE
	  ELSE
	    EXIT HANDLER
	  END IF
	END WHEN

	WHEN ERROR IN
	  MENU_INDEX = VAL%(MENU_INPUT)
	USE
	  IF POS("EXIT", EDIT$(MENU_INPUT, 32%), 1%) = 1% THEN
	    MENU_INDEX = 99% 
	    CONTINUE
	  ELSE
	    MENU_INDEX = -1%
	    CONTINUE
	  END IF
	END WHEN

	GOTO SELECT_MENU_EXIT IF MENU_INDEX = 99%
	IF MENU_INDEX < 1 OR MENU_INDEX > MENU_COUNT THEN
	  PRINT "Enter a selection between 1 and "; NUM1$(MENU_COUNT); &
		", or EXIT."
	  GOTO SELECT_MENU_ITEM		!try again
	END IF

 SELECT_MENU_EXIT:
	RETURN

 READ_PORTS:
 	!**********************************************************************
	!read PORTS.DAT file
	!**********************************************************************

	OPEN "LF_PORTS" FOR INPUT AS FILE #PORTS_FILE, &
		ACCESS READ, ALLOW MODIFY
	PORT_COUNT = 0%
	PORT_INDEX = 0%

 READ_PORTS_LINE:
	!read a line from the menu...
	WHEN ERROR IN
    	  INPUT #PORTS_FILE; OPTION_STRING; PORT_NAME_S; &
		AVAIL_CLASS; MODEM_TYPE_S
	USE
	  RETRY IF ERR = 59	!not enough data
	  CONTINUE END_OF_PORTS
	END WHEN
	!ignore comments...
 	GOTO READ_PORTS_LINE IF SEG$(OPTION_STRING, 1%, 1%) = "!"

	IF OPTION_STRING <> TRM$(NODE_NAME) THEN
	  !line is for another node: ignore it, but first save its node name...
	  IF ALT_NODES = "" THEN
	    !this is the first node...
	    ALT_NODES = OPTION_STRING
	  ELSE
	    !this is not the first node...
	    IF POS(ALT_NODES, OPTION_STRING, 1%) = 0% THEN
	      !this node is not already on the list...
	      IF POS(ALT_NODES, "one of", 1%) = 0% THEN
	        !this is the second node...
	        ALT_NODES = "one of " + ALT_NODES
	      END IF
	      I = POS(ALT_NODES, " or ", 1%)
	      IF I > 0% THEN
	        !replace existing "or" with comma...
	        ALT_NODES = SEG$(ALT_NODES, 1%, I-1%) + ", " + &
			SEG$(ALT_NODES, I+4%, LEN(ALT_NODES))
	      END IF	!I > 0
	      ALT_NODES = ALT_NODES + " or " + OPTION_STRING
	    END IF	!pos(alt_nodes..)
	  END IF	!alt_nodes
	  GOTO READ_PORTS_LINE 
	END IF		!option_string

 ADD_TO_PORTS:
	!save the info...
	PORT_INDEX = PORT_INDEX + 1%
	PORTS(PORT_INDEX, 0%) = PORT_NAME_S
	PORTS(PORT_INDEX, 1%) = AVAIL_CLASS
	PORTS(PORT_INDEX, 2%) = MODEM_TYPE_S

	!get the next line
	GOTO READ_PORTS_LINE

 END_OF_PORTS:
	CLOSE #PORTS_FILE
	PORT_COUNT = PORT_INDEX
	RETURN

 DISPLAY_SCREEN:
      	!**********************************************************************
	!clears screen, displays header
      	!**********************************************************************

	PRINT CHR$(27); "[2J"; CHR$(27); "[0;0H"; CHR$(27); "[1m"; &
		"                   APMC EXTERNAL COMMUNICATIONS SYSTEM"; &
		CHR$(27); "[0m"
	PRINT
	PRINT "	                   Available options:"
	PRINT
	SCREEN_LINES = 4%

	RETURN

 READ_MENU:                                  
      	!**********************************************************************
	!reads the menu file, selects the facilities the user is allowed
	!to choose, and displays the choices
	!**********************************************************************

	OPEN "LF_MENU" FOR INPUT AS FILE #MENU_FILE, &
		ACCESS READ, ALLOW MODIFY
	MENU_COUNT = 0%
	MENU_INDEX = 0%

 READ_MENU_LINE:
	!read a line from the menu...
	WHEN ERROR IN
    	  INPUT #MENU_FILE; MENU(0%, 0%); MENU(0%, 1%); MENU(0%, 2%); MENU_RIGHTS
	USE
	  RETRY IF ERR = 59	!not enough data
	  CONTINUE END_OF_MENU
	END WHEN
	!ignore comments...
	GOTO READ_MENU_LINE IF SEG$(MENU(0%, 0%), 1%, 1%) = "!"

	MENU(0%, 2%) = EDIT$(MENU(0%, 2%), 2%)	!delete spaces and tabs
	MENU_RIGHTS = EDIT$(MENU_RIGHTS, 2%)	!delete spaces and tabs
	ITEM_COUNT = 0%

 READ_MENU_RIGHTS:
	!get a rights ident...
	ITEM_COUNT = ITEM_COUNT + 1%
	OPTION_STRING = GET_SUB_STR(MENU_RIGHTS, ITEM_COUNT)
	IF OPTION_STRING = "" THEN
	  !user can't select this item, so ignore it...
	  GOTO READ_MENU_LINE
	END IF

	!does the user hold this right?...
	ACCEPT_MENU = CHKRDB(OPTION_STRING)
	GOTO ADD_TO_MENU IF ACCEPT_MENU <> 0%	!user holds it
	!user doesn't hold it: are there any other rights specified?...
	GOTO READ_MENU_RIGHTS

 ADD_TO_MENU:
	MENU_INDEX = MENU_INDEX + 1%
	MENU(MENU_INDEX, 0%) = MENU(0%, 0%)
	MENU(MENU_INDEX, 1%) = MENU(0%, 1%)
	MENU(MENU_INDEX, 2%) = MENU(0%, 2%)
	GOTO READ_MENU_LINE

 END_OF_MENU:
	CLOSE #MENU_FILE

	MENU_COUNT = MENU_INDEX
	MENU_COL2 = INT(MENU_COUNT / 2%)
	MENU_COL1 = MENU_COUNT - MENU_COL2
	FOR MENU_INDEX = 1% TO MENU_COL2
	  PRINT USING MENU_FMT; "0"; NUM1$(MENU_INDEX); &
		MENU(MENU_INDEX, 1%); &
		"0"; NUM1$(MENU_INDEX + MENU_COL1); &
		MENU(MENU_INDEX + MENU_COL1, 1%)
	  SCREEN_LINES = SCREEN_LINES + 1%
	NEXT MENU_INDEX
	IF MENU_COL1 = MENU_COL2 THEN
	  PRINT USING MENU_FMT; "1"; "EXIT"; "Exit External System"; "0"
	ELSE
	  PRINT USING MENU_FMT; "0"; NUM1$(MENU_COL1); MENU(MENU_COL1, 1%); &
		"1"; "EXIT"; "Exit External System"
	END IF
	SCREEN_LINES = SCREEN_LINES + 1%
	!set scrolling region for user interaction...
	PRINT CHR$(27); "["; NUM1$(SCREEN_LINES+1%); ";24r";
	PRINT CHR$(27); "["; NUM1$(SCREEN_LINES+1%); ";1H";
	RETURN

	%PAGE
	%SBTTL "FUNCTION DEFINITION SECTION"
20000	!======================================================================
	!		       	FUNCTION DEFINITION SECTION
	!======================================================================

	!**********************************************************************
	!given a string which is composed of substrings separated by "+" signs,
	!and an integer, returns the specified substring
	!**********************************************************************

	DEF STRING GET_SUB_STR(STRING GSS_INPUT, WORD GSS_COUNT)

	DECLARE WORD &
		GSS_P1, GSS_P2, GSS_INDEX

	GSS_P1 = 1%
	GSS_P2 = POS(GSS_INPUT, "+", 1%)
	GSS_P2 = LEN(GSS_INPUT) + 1% IF GSS_P2 = 0%
	GSS_INDEX = 1%

 GSS_CHECK:
	IF GSS_COUNT = GSS_INDEX THEN
	  !we have the requested substring...
	  GET_SUB_STR = SEG$(GSS_INPUT, GSS_P1, GSS_P2 - 1%)
	  EXIT DEF
	END IF

	IF GSS_P2 >= LEN(GSS_INPUT) THEN
	  !there are not enough substrings...
	  GET_SUB_STR = ""
	  EXIT DEF
	END IF

	GSS_P1 = GSS_P2 + 1%
	GSS_P2 = POS(GSS_INPUT, "+", GSS_P1)
	GSS_P2 = LEN(GSS_INPUT) + 1% IF GSS_P2 = 0%
	GSS_INDEX = GSS_INDEX + 1%
	GOTO GSS_CHECK

	END DEF

	%PAGE                                                                  
	%SBTTL "ERROR HANDLING SECTION"
25000	!======================================================================
	!			ERROR HANDLING SECTION
	!======================================================================

 ERROR_HANDLING:
	GOSUB RESET_SCROLL	!reset scrolling region...
	ON ERROR GOTO 0
                                                                               
	!======================================================================
	!			END OF PROGRAM
	!======================================================================

 END_OF_PROGRAM:
 	GOSUB RESET_SCROLL	!reset scrolling region...
	EXIT FUNCTION FUNC_STAT

29999	END FUNCTION