10 FUNCTION LONG EXT_MENU !====================================================================== !PROGRAM---------------------VERSION-------------------LANGUAGE-------- !EXT_MENU 7 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 92.11.04" %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 ! 3 Keith Walker 88.11.29 E102_0_9 ! 4 Keith Walker 89.06.03 M102_0_46 ! 5 Grant Moffat 89.06.06 M102_0_47 ! 6 Keith Walker 89.06.12 M102_0_49 ! 7 Keith Walker 92.11.04 E102ISD_0_30 ! !====================================================================== ! COMPILE/LINK/INSTALL INSTRUCTIONS !====================================================================== !$BASIC EXT_MENU !$LINK 102900,- ! EXT_READ_PORT_AST, EXT_UNSOL_MBX_AST,- ! EXT_PROC_BUF_AST, EXT_WRITE_TERM_AST,- ! EXT_SCRIPT_INTERP, EXT_SCREEN_HDR,- ! EXT_MENU, EXT_CONNECT_LOOP, EXT_PARSE,- ! CHKRGHTS, EXT_FT_MENU, XMODEM !====================================================================== !********************************************************************** ! 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 "$TRMDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "$PSLDEF" %FROM %LIBRARY "SYS$LIBRARY:BASIC$STARLET.TLB" %INCLUDE "EXT_COMMON.BAS" !********************************************************************** ! CONSTANTS !********************************************************************** DECLARE WORD CONSTANT & L_PORTS = 40 !********************************************************************** ! RECORDS !********************************************************************** !********************************************************************** ! MAPS !********************************************************************** !********************************************************************** ! COMMONS !********************************************************************** !********************************************************************** ! VARIABLES !********************************************************************** DECLARE WORD & TERM_CODE, & 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 & TERM_MASK, & MENU_PTR, & ROW, & COL, & HALFWAY, & SCROLL_LINES, & CONNECT_EFN, !event flag for connect & FLAGS, !combined event flags & FUNC_STAT, !status from function & I, !miscellaneous counter & J, !miscellaneous counter & ITEM_COUNT, !counter to parse lists & JUNK, !function status & MENU_COL1, !number of items in 1 column & MENU_COL2, !number of items in 2 column & PID, !process id & PORT_COUNT, !number of items in ports list & PORT_INDEX, !pointer to port info & RIGHTS_ID, !rights identifier & SCREEN_LINES, !number of screen lines used & TIMER_EFN !event flag for timer & DECLARE QUAD & DELTA_TIME !time for timer DECLARE STRING & MENU_LINE, & ALT_NODES, !names of nodes where ports are avail & AVAIL_CLASS, !class available for selected facility & 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 & SERVED_PORT_S, !determine if port is on a server & TRY_ANOTHER !user's input to try another class !********************************************************************** ! ARRAYS !********************************************************************** DIMENSION STRING & PORTS(L_PORTS, 3%) !holds port info: !0: port, 1:served, 2: class, 3: modem !********************************************************************** ! FUNCTIONS !********************************************************************** DECLARE STRING FUNCTION & GET_SUB_STR !********************************************************************** ! EXTERNAL CONSTANTS !********************************************************************** EXTERNAL LONG CONSTANT & TRM$M_TM_CVTLOW, & SMG$M_CURSOR_OFF, & SMG$M_CURSOR_ON, & SMG$K_TRM_CTRLR, & SMG$K_TRM_CTRLU, & SMG$K_TRM_CTRLW, & SMG$K_TRM_CTRLZ, & SMG$K_TRM_F10, & SMG$K_TRM_PF2, & SMG$K_TRM_PF4, & SMG$K_TRM_PREV_SCREEN, & SMG$K_TRM_NEXT_SCREEN, & SMG$M_REVERSE, & SMG$M_BOLD, & SMG$M_UP, & SMG$M_DOWN, & IO$_TTY_PORT, & IO$M_LT_CONNECT, & JPI$_PID, & PSL$C_SUPER, & SS$_ABORT, & SS$_NORMAL, & SS$_DEVNOTALLOC, & SS$_WASCLR, & SS$_WASSET !********************************************************************** ! EXTERNAL FUNCTIONS !********************************************************************** EXTERNAL LONG FUNCTION & SMG$SET_CURSOR_MODE, & SMG$PUT_LINE, & SMG$READ_KEYSTROKE, & SMG$RING_BELL, & SMG$DELETE_PASTEBOARD, & SMG$DELETE_VIRTUAL_KEYBOARD, & SMG$SET_CURSOR_ABS, & SMG$SCROLL_VIEWPORT, & SMG$REPAINT_SCREEN, & SMG$REPAINT_LINE, & SMG$ERASE_DISPLAY, & SMG$READ_STRING, & SMG$CREATE_VIRTUAL_KEYBOARD, & SMG$SET_KEYPAD_MODE, & SMG$CREATE_PASTEBOARD, & SMG$CREATE_VIRTUAL_DISPLAY, & SMG$CREATE_VIEWPORT, & SMG$LABEL_BORDER, & SMG$PUT_CHARS, & SMG$PASTE_VIRTUAL_DISPLAY, & SMG$UNPASTE_VIRTUAL_DISPLAY, & SMG$CHANGE_VIRTUAL_DISPLAY, & SMG$SAVE_PHYSICAL_SCREEN, & SMG$RESTORE_PHYSICAL_SCREEN, & SYS$ALLOC, & SYS$ASCTOID, & SYS$BINTIM, & SYS$SETIMR, & SYS$QIO, & SYS$WFLOR, & SYS$CANTIM, & SYS$READEF, & SYS$DASSGN, & SYS$DALLOC, & LIB$BBSSI, & LIB$FREE_EF, & LIB$GET_EF, & LIB$ASN_WTH_MBX, & LIB$GETJPI, & CHKRGHTS !********************************************************************** ! 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) 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 IF FACILITY_CODE = "" THEN !we only do the menu stuff if the user didn't already specify a !facility code... !clean screen... PRINT CHR$(27); "[1;1H"; CHR$(27); "[2J" IF CONN_DISP = 0 THEN !Conn_Disp is 0 if this is the first time here... GOSUB READ_MENU !read and display the menu ELSE !we have already read the menu, so we just redisplay it... FUNC_STAT = SMG$RESTORE_PHYSICAL_SCREEN(PB_ID, CONN_DISP) END IF GOSUB SELECT_MENU_ITEM !ask for user's selection IF MENU_INDEX = 0% THEN !user wants out FUNC_STAT = SS$_ABORT GOTO END_OF_PROGRAM END IF !menu_index FUNC_STAT = SMG$SAVE_PHYSICAL_SCREEN(PB_ID, CONN_DISP) ELSE !user already selected a facility... GOSUB READ_MENU !read but don't display the menu MENU_INDEX = 1 WHILE TRM$(MENU(MENU_INDEX, 0%)) <> FACILITY_CODE AND & MENU_INDEX < MENU_COUNT MENU_INDEX = MENU_INDEX + 1 NEXT IF TRM$(MENU(MENU_INDEX, 0%)) <> FACILITY_CODE THEN PRINT PRINT PRINT PRINT TRM$(FACILITY_CODE); " is not available." FUNC_STAT = SS$_ABORT GOTO END_OF_PROGRAM END IF !menu END IF !facility_code 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 SERVED_PORT = SERVED_PORT_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 POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "FACILITY: "; MENU_CODE PRINT "PORT: "; PORT_NAME_S PRINT "SERVED: "; SERVED_PORT_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 = TRM$(MENU(MENU_INDEX, 0%)) MENU_NAME = TRM$(MENU(MENU_INDEX, 1%)) IF POS(DEBUG_FLAG, "7", 1) > 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 POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "Checking for "; PREF_CLASS; " port" END IF FOR PORT_INDEX = 1 TO PORT_COUNT IF PORTS(PORT_INDEX, 2%) = PREF_CLASS THEN PORT_EXISTS = TRUE ANY_PORT_EXISTS = TRUE IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "ALLOCAING PORT "; PORTS(PORT_INDEX, 0%) END IF !we have found a port: allocate it... FUNC_STAT = SYS$ALLOC(PORTS(PORT_INDEX, 0%),,, & PSL$C_SUPER BY VALUE, ) !make the port dev name available so the file transfer program ! can find it. CALL LIB$SET_SYMBOL('EXT_TERM',PORTS(PORT_INDEX, 0%)) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "ALLOCATING PORT "; PORTS(PORT_INDEX, 0%); ", STATUS: "; & FUNC_STAT END IF IF (FUNC_STAT AND 1%) = 0% THEN !we haven't got the port... GOTO PORT_NOT_ALLOC END IF FUNC_STAT = LIB$ASN_WTH_MBX(TRM$(PORTS(PORT_INDEX, 0%)), & MAX_MBX_SIZE, MAX_MBX_SIZE, PORT_CHAN, MBX_CHAN) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "ASSIGNING CHANNEL, STATUS: "; & FUNC_STAT SLEEP 3 END IF IF (FUNC_STAT AND 1%) = 0% THEN GOTO DEALLOC_PORT END IF !if port is on the server, connect it... IF PORTS(PORT_INDEX, 1%) = "Y" THEN IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "PORT IS ON THE SERVER" SLEEP 3 END IF !---------------------------------------------------------------- !CONNECT by itself is too simple. If someone has dialled in on !the modem we want, we might be able to allocate the port, but the !connect will hang. So, we have to set a timer to cancel the !connect in that case. !---------------------------------------------------------------- FUNC_STAT = LIB$GET_EF(CONNECT_EFN) FUNC_STAT = LIB$GET_EF(TIMER_EFN) FUNC_STAT = SYS$BINTIM("0 00:00:01.00", DELTA_TIME) FUNC_STAT = SYS$SETIMR(TIMER_EFN BY VALUE, DELTA_TIME BY REF, !astadr!, & !reqidt!, !flags!) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "TIMER SET, STATUS: "; FUNC_STAT SLEEP 3 END IF GOTO DEASSIGN_PORT IF (FUNC_STAT AND 1%) = 0% FUNC_STAT = SYS$QIO(CONNECT_EFN BY VALUE, PORT_CHAN BY VALUE, & (IO$_TTY_PORT OR IO$M_LT_CONNECT) BY VALUE, & !iosb!, & !astadr!, !astprm!, !p1!, !p2!, !p3!, !p4!, !p5!, !p6!) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "CONNECTION ATTEMPTED, STATUS: "; FUNC_STAT SLEEP 3 END IF GOTO DEASSIGN_PORT IF (FUNC_STAT AND 1%) = 0% FLAGS = 0% CALL LIB$BBSSI(CONNECT_EFN - 32%, FLAGS) CALL LIB$BBSSI(TIMER_EFN - 32%, FLAGS) FUNC_STAT = SYS$WFLOR(TIMER_EFN BY VALUE, FLAGS BY VALUE) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "FINISHED WAITING, STATUS: "; FUNC_STAT SLEEP 3 END IF GOTO DEASSIGN_PORT IF (FUNC_STAT AND 1%) = 0% FUNC_STAT = SYS$CANTIM(,) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "TIMER CANCELLED, STATUS: "; FUNC_STAT SLEEP 3 END IF GOTO DEASSIGN_PORT IF (FUNC_STAT AND 1%) = 0% FUNC_STAT = SYS$READEF(CONNECT_EFN BY VALUE, J BY REF) IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "EVENT FLAGS CHECKED, STATUS: "; FUNC_STAT SLEEP 3 END IF IF (FUNC_STAT AND 1%) = 0% THEN GOTO DEASSIGN_PORT IF (FUNC_STAT AND 1%) = 0% END IF IF FUNC_STAT = SS$_WASCLR THEN !...the CONNECT failed, or at least, it timed out GOTO DEASSIGN_PORT END IF IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "CONNECTION SUCCESSFUL" SLEEP 3 END IF ELSE IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "PORT IS NOT ON THE SERVER" SLEEP 3 END IF END IF !served port FUNC_STAT = LIB$FREE_EF(CONNECT_EFN) FUNC_STAT = LIB$FREE_EF(TIMER_EFN) GOTO PORT_ALLOCATED !everything worked DEASSIGN_PORT: FUNC_STAT = SYS$DASSGN(PORT_CHAN BY VALUE) FUNC_STAT = SYS$DASSGN(MBX_CHAN BY VALUE) FUNC_STAT = LIB$FREE_EF(CONNECT_EFN) FUNC_STAT = LIB$FREE_EF(TIMER_EFN) DEALLOC_PORT: FUNC_STAT = SYS$DALLOC(PORTS(PORT_INDEX, 0%),,,) PORT_NOT_ALLOC: IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "PORT NOT ALLOCATED" SLEEP 3 END IF END IF !port = pref_class 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%) SERVED_PORT_S = PORTS(PORT_INDEX, 1%) AVAIL_CLASS = PORTS(PORT_INDEX, 2%) MODEM_TYPE_S = PORTS(PORT_INDEX, 3%) FUNC_STAT = SS$_NORMAL PRINT CHR$(27); "[2J"; CHR$(27); "[24;1H"; PRINT "Line type "; AVAIL_CLASS; " allocated" IF POS(DEBUG_FLAG, "7", 1) > 0 THEN PRINT "Port "; PORT_NAME_S; " ("; MODEM_TYPE_S; ") allocated" END IF RETURN SELECT_MENU_ITEM: !********************************************************************** !get user to select a menu item !returns MENU_INDEX as menu item number !********************************************************************** MENU_INDEX = 0 IF TOP_LINE > 1 THEN FUNC_STAT = SMG$PUT_CHARS(EXIT_DISP, "^^ more ^^", 1%, 31%) END IF IF BOT_LINE < MAX_ROW +1 THEN FUNC_STAT = SMG$PUT_CHARS(EXIT_DISP, "vv more vv", 1%, 31%) END IF !get input... TERM_MASK = -1 FUNC_STAT = SMG$PUT_CHARS(ACTION_DISP, " ", 1%, 1%) FUNC_STAT = SMG$SET_CURSOR_ABS(ACTION_DISP, 1%, 1%) FUNC_STAT = SMG$READ_STRING(KB_ID, MENU_INPUT, , 10%, TRM$M_TM_CVTLOW, & , TERM_MASK BY DESC, , TERM_CODE, ACTION_DISP) FUNC_STAT = SMG$ERASE_DISPLAY(MSG_DISP) SELECT TERM_CODE CASE = SMG$K_TRM_CTRLR, SMG$K_TRM_CTRLU !^R, ^U FUNC_STAT = SMG$REPAINT_LINE(PB_ID, 1%, 1%) MENU_LINE = "" CASE = SMG$K_TRM_CTRLW !^W FUNC_STAT = SMG$REPAINT_SCREEN(PB_ID) MENU_LINE = "" CASE = SMG$K_TRM_F10, SMG$K_TRM_CTRLZ, SMG$K_TRM_PF4 !F10, ^Z, PF4 MENU_LINE = "EXIT" CASE = SMG$K_TRM_PF2 !PF2 MENU_LINE = "??" CASE = SMG$K_TRM_PREV_SCREEN !prev screen MENU_LINE = "PREV" CASE = SMG$K_TRM_NEXT_SCREEN !next screen MENU_LINE = "NEXT" CASE ELSE WHEN ERROR IN MENU_PTR = VAL%(MENU_INPUT) USE MENU_PTR = -1 END WHEN SELECT MENU_PTR CASE 1 TO MENU_COUNT !good selection MENU_LINE = "SELECTED" CASE ELSE !bad number or text or junk MENU_LINE = MENU_INPUT END SELECT END SELECT SELECT MENU_LINE CASE = "??" GOSUB LONG_HELP CASE = "?" FUNC_STAT = SMG$PUT_CHARS(MSG_DISP, HELP_LINE + SPACE$(80), 1%, 1%) CASE "NEXT" SCROLL_LINES = 19 IF SCROLL_LINES + BOT_LINE > MAX_ROW + 1 THEN SCROLL_LINES = MAX_ROW - BOT_LINE + 1 END IF FUNC_STAT = SMG$SCROLL_VIEWPORT(MENU_DISP, SMG$M_UP, SCROLL_LINES) TOP_LINE = TOP_LINE + SCROLL_LINES BOT_LINE = BOT_LINE + SCROLL_LINES CASE "PREV" SCROLL_LINES = 19 IF TOP_LINE - SCROLL_LINES < 1 THEN SCROLL_LINES = TOP_LINE - 1 END IF FUNC_STAT = SMG$SCROLL_VIEWPORT(MENU_DISP, SMG$M_DOWN, SCROLL_LINES) TOP_LINE = TOP_LINE - SCROLL_LINES BOT_LINE = BOT_LINE - SCROLL_LINES CASE "EXIT", "^" MENU_INDEX = 0 GOTO SELECT_MENU_EXIT CASE = "SELECTED" MENU_INDEX = MENU_PTR GOTO SELECT_MENU_EXIT CASE = "SPECIAL KEY", "" !do nothing CASE ELSE FUNC_STAT = SMG$RING_BELL(MSG_DISP) FUNC_STAT = SMG$PUT_CHARS(MSG_DISP, & "Unknown command: '" + MENU_LINE + "'. " + HELP_LINE + & SPACE$(80), & , 1%, 1%) END SELECT GOTO SELECT_MENU_ITEM 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; & SERVED_PORT_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%) = SERVED_PORT_S PORTS(PORT_INDEX, 2%) = AVAIL_CLASS PORTS(PORT_INDEX, 3%) = MODEM_TYPE_S !get the next line GOTO READ_PORTS_LINE END_OF_PORTS: CLOSE #PORTS_FILE PORT_COUNT = PORT_INDEX RETURN LONG_HELP: !********************************************************************** !displays long help text !********************************************************************** FUNC_STAT = SMG$SET_CURSOR_MODE(PB_ID, SMG$M_CURSOR_OFF) FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(HELP_DISP, PB_ID, 7%, 14%) FUNC_STAT = SMG$READ_KEYSTROKE(KB_ID, TERM_CODE) FUNC_STAT = SMG$UNPASTE_VIRTUAL_DISPLAY(HELP_DISP, PB_ID) FUNC_STAT = SMG$SET_CURSOR_MODE(PB_ID, SMG$M_CURSOR_ON) 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% JUNK = LIB$GETJPI(JPI$_PID, !pid!, !prcnam!, PID) 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?... JUNK = SYS$ASCTOID(OPTION_STRING, RIGHTS_ID, ) ACCEPT_MENU = CHKRGHTS(PID BY VALUE, RIGHTS_ID BY VALUE) GOTO ADD_TO_MENU IF ACCEPT_MENU = SS$_WASSET !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 IF FACILITY_CODE = "" THEN HALFWAY = (MENU_COUNT + 1)/ 2 MAX_ROW = 0 !build menu display... FOR MENU_INDEX = 1 TO MENU_COUNT IF MENU_INDEX > HALFWAY THEN ROW = MENU_INDEX - HALFWAY COL = 39 MAX_ROW = MAX(ROW, MAX_ROW) ELSE ROW = MENU_INDEX COL = 1 END IF FUNC_STAT = SMG$PUT_CHARS(MENU_DISP, FORMAT$(MENU_INDEX, "##."), ROW, COL) FUNC_STAT = SMG$PUT_CHARS(MENU_DISP, MENU(MENU_INDEX, 1), ROW, COL + 4%) NEXT MENU_INDEX IF MENU_COUNT >= 40 THEN HELP_LINE = "Enter: 1-" + NUM1$(MENU_COUNT) + " PrevScreen NextScreen ^ EXIT ? ??" ELSE HELP_LINE = "Enter: 1-" + NUM1$(MENU_COUNT) + " ^ EXIT ? ??" END IF !build header display... FUNC_STAT = SMG$PUT_CHARS(HDR_DISP, "Select: ", 1%, 1%) FUNC_STAT = SMG$PUT_CHARS(HDR_DISP, "102900", 1%, 74%) !exit selection... FUNC_STAT = SMG$PUT_CHARS(EXIT_DISP, "EXIT. Exit from External", 1%, 1%) !display screen... FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(HDR_DISP, PB_ID, 1%, 1%) FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(MENU_DISP, PB_ID, 3%, 2%) FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(EXIT_DISP, PB_ID, 22%, 40%) FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(MSG_DISP, PB_ID, 24%, 1%) FUNC_STAT = SMG$PASTE_VIRTUAL_DISPLAY(ACTION_DISP, PB_ID, 1%, 9%) TOP_LINE = 1 BOT_LINE = 20 !build help screen (we had to wait until now to find out how many !menu items we have)... IF MENU_COUNT >= 40 THEN I = 14 ELSE I = 12 END IF FUNC_STAT = SMG$CHANGE_VIRTUAL_DISPLAY(HELP_DISP, I, 55%) FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " The External Facilities menu lists all the external ") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " facilities you are authorized to access. Enter the ") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " number of the facility you wish to access.") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & "") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " Valid input:") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " 1-" + NUM1$(MENU_COUNT) + " Select a facility") IF MENU_COUNT >= 40 THEN FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " PrevScreen Scroll menu down") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " NextScreen Scroll menu up") END IF FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " ? Display short help") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " ?? Display this help screen") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " ^ Exit") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " EXIT Exit") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & "") FUNC_STAT = SMG$PUT_LINE(HELP_DISP, & " Press any key to continue") END IF 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