IDENTIFICATION DIVISION. PROGRAM-ID. SCREENCTL. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT IN-FILE ASSIGN TO "". DATA DIVISION. FILE SECTION. FD IN-FILE VALUE OF ID IS INPUT-FILE-NAME FILE STATUS IS FILE-STAT RECORD CONTAINS 1 TO 500 CHARACTERS. 01 IN-REC PIC X(500). WORKING-STORAGE SECTION. 77 HRS-TO-WAIT PIC 99. 77 MINS-TO-WAIT PIC 9999. 77 CUR-TYME PIC 9999. 77 WAIT-TYME PIC 9999. 77 DIFFERENCE PIC 9999. 77 TIME-CNT PIC 9. 01 WS-TIME. 02 HR PIC 99. 02 MM PIC 99. 02 PIC 9(4). 01 CONVERT-TIME. 02 C-HOURS PIC 99. 02 PIC X. 02 C-MINUTES PIC 99. 02 SEC-HTH PIC X(6). 77 LOC-SYM PIC 9(9) COMP VALUE 1. 77 EFN PIC 9(9) COMP VALUE 1. * -10000000 is equal to 1 second 77 DAYTIM PIC S9(18) COMP VALUE -10000000. 77 ASTADR PIC 9(9) COMP VALUE 0. 77 PARAMETER PIC 9(9) COMP VALUE 0. 77 TT-CHANNEL PIC 9(5) COMP. 77 BUFF-LEN PIC 9(5) COMP VALUE 500. 77 IOSB PIC 9(4) COMP. 77 IO-READVBLK PIC 9(9) COMP VALUE 49. 77 PASTEBOARD PIC 9(9) COMP. 77 Q-MARKS PIC 999. 77 DONT-CLEAR-SCREEN PIC 9(9) COMP VALUE 1. 77 PB-ROWS PIC S9(9) COMP. 77 PB-COLS PIC S9(9) COMP. 77 DELAY COMP-1 VALUE 4.5. 77 COL PIC 999. 77 I PIC 999. 77 J PIC 999. 77 NUM PIC 999. 77 IMARG PIC 999. 77 IMARG2 PIC 999. 77 DUMMY-COUNT PIC 999. 77 FCOUNT PIC 999. 77 P1COUNT PIC 999. 77 P2COUNT PIC 999. 77 P3COUNT PIC 999. 77 P4COUNT PIC 999. 77 P5COUNT PIC 999. 77 P6COUNT PIC 999. 77 P7COUNT PIC 999. 77 P8COUNT PIC 999. 77 P9COUNT PIC 999. 77 P10COUNT PIC 999. 77 P11COUNT PIC 999. 77 P12COUNT PIC 999. 77 MSG-COUNT PIC S9999. 77 GLO-SYM PIC 9(5) COMP. 77 SYM-LNGTH PIC 9(5) COMP. 77 IMAGE-LNGTH PIC S9(4) COMP. 77 LOCA PIC 9(9) COMP. 77 LOCB PIC 9(9) COMP. 77 LOCC PIC 9(9) COMP. 77 LOCD PIC 9(9) COMP. 77 LOCE PIC 9(9) COMP. 77 STRT PIC 9(9) COMP. 77 STR PIC 9(9) COMP. 77 P2 PIC 999. 77 P3 PIC 999. 77 P4 PIC 999. 77 P5 PIC 999. 77 P6 PIC 999. 77 INPUT-TYPE PIC 9 VALUE 0. 88 FILE-INPUT VALUE 1. 88 MULTI-FUNCTIONS VALUE 2. 88 JOB-STREAM VALUE 3. 01 LOGICAL-EQU PIC X(100). 01 FILE-STAT PIC XX. 88 NOT-FOUND VALUE "97" "35". 01 TIMEOUT PIC X(12) VALUE "SCREENCTL_TO". 01 TT-CONSOLE PIC X(10) VALUE "SYS$OUTPUT". 01 INPUT-FILE-NAME PIC X(100). 01 SYM-FUNCTION PIC X(21) VALUE "$SCREEN$CTL". 01. 02 GRAPHIC PIC X(135) VALUE ALL "q". 02 COL-BLOCK PIC X(132) VALUE "3542376347494854525731585945605662506541010502091133031006085516442120 - "04151925222738295153436646281713241826394036301423611232073464". 02 COLUMS REDEFINES COL-BLOCK PIC 99 OCCURS 66 TIMES. 02 P1 PIC 999. 02 P1A REDEFINES P1 PIC XXX. 02 FUNCTION-TBL. 03 PIC X(243) VALUE " BBOX BEEP BIG BBIG BOX BPOS - "CL*EAR FPOS HLINE LPOS POS RPOS SCROLL - "SQUEEZE TOP UNSQUEEZEUNDERLINEVLINE WHITE BLACK - "PAUSE BOTTOM BRIGHT GPOS BOLD BRPOS ". 03 PIC X(135) VALUE "BLINK LINE WINDOW GETPF GETAR PDINQ GETFUNC - "SPOS SCRAM UNBOX CURSOR MORE - "JUST*IFY ". 03 PIC X(9) VALUE "!!!!!!!!". 01 SYM-NAME PIC X(9). 01 IMAGE-NAME PIC X(100). 01 PF-KEY. 02 PIC X. 02 PIC XXXX. 88 PF1 VALUE "P". 88 PF2 VALUE "Q". 88 PF3 VALUE "R". 88 PF4 VALUE "S". 88 UPP VALUE "A". 88 DN VALUE "B". 88 RT VALUE "C". 88 LT VALUE "D". 88 F-FIND VALUE "1~". 88 F-INSE VALUE "2~". 88 F-REMO VALUE "3~". 88 F-SELE VALUE "4~". 88 F-PREV VALUE "5~". 88 F-NEXT VALUE "6~". 88 F7 VALUE "18~". 88 F8 VALUE "19~". 88 F9 VALUE "20~". 88 F10 VALUE "21~". 88 F11 VALUE "23~". 88 F12 VALUE "24~". 88 F13 VALUE "25~". 88 F14 VALUE "26~". 88 F-HELP VALUE "28~". 88 F-DO VALUE "29~". 88 F17 VALUE "31~". 88 F18 VALUE "32~". 88 F19 VALUE "33~". 88 F20 VALUE "34~". 88 KP0 VALUE "p". 88 KP1 VALUE "q". 88 KP2 VALUE "r". 88 KP3 VALUE "s". 88 KP4 VALUE "t". 88 KP5 VALUE "u". 88 KP6 VALUE "v". 88 KP7 VALUE "w". 88 KP8 VALUE "x". 88 KP9 VALUE "y". 88 KP-PER VALUE "n". 88 KP-COM VALUE "l". 88 KP-ENT VALUE "M". 88 KP-DSH VALUE "m". 01 PAUSE-TIME. 02 HOURS-TO-WAIT PIC 99. 02 PIC X. 02 MINUTES-TO-WAIT PIC 99. 01 PAR1 PIC X(134). 01 PAR2 PIC X(134). 01 PAR3 PIC X(134). 01 PAR4 PIC X(134). 01 PAR5 PIC X(134). 01 PAR6 PIC X(134). 01 PAR7 PIC X(134). 01 PAR8 PIC X(134). 01 PAR9 PIC X(134). 01 PAR10 PIC X(134). 01 PAR11 PIC X(134). 01 PAR12 PIC X(134). 01 WS-INPUT. 02 WS1 PIC X. * v ^I 88 WS1-BLANK VALUE " " " ". 02 PIC X(499). 01 WS-FUNCTIONS PIC X(500). 01 MSG-LINE PIC X(135). 01 DUMMY PIC X(150). 01 FUNCTION PIC X(9). 88 CURSOR-TO-BE-OFF VALUE "BBOX" "BOX" "BOTTOM" "HLINE" "CLEAR" "SPOS" "WINDOW" "SCRAM" "VLINE" "CL*EAR". 88 POSITION-CURSOR VALUE "POS" "RPOS" "BPOS" "FPOS" "UNDERLINE" "SPOS" "BRPOS" "GPOS" "BOLD" "BLINK". PROCEDURE DIVISION. DECLARATIVES. I-O-PROBLEM SECTION. USE AFTER STANDARD ERROR PROCEDURE ON IN-FILE. 0. IF NOT-FOUND CONTINUE. IF NOT NOT-FOUND STOP RUN. END DECLARATIVES. EXECUTE-FUNCTIONS SECTION. * Get Address of TIMEOUT routine for transfer after time is up. 0. CALL "COB$CALL" USING BY DESCRIPTOR TIMEOUT GIVING ASTADR. * Assign I/O channel to SYS$OUTPUT for input FOR "PDINQ" OPTION CALL "SYS$ASSIGN" USING BY DESCRIPTOR TT-CONSOLE BY REFERENCE TT-CHANNEL BY VALUE 0 0. MOVE TT-CHANNEL TO PARAMETER. *Get Command Line CALL "LIB$GET_FOREIGN" USING BY DESCRIPTOR WS-INPUT VALUE 0,0. *if nothing on command line check on default file input. IF WS1 = " " GO TO CHECK-DEFAULT-FILE. *Check for Multi Functions MOVE 1 TO STRT. MOVE WS-INPUT TO WS-FUNCTIONS. CALL "LIB$MATCHC" USING BY DESCRIPTOR "\" WS-FUNCTIONS GIVING LOCB. IF LOCB > 0 MOVE 2 TO INPUT-TYPE. *Check for job stream input IF WS-INPUT = "SYS$INPUT" MOVE 3 TO INPUT-TYPE. Get-Command. IF JOB-STREAM ACCEPT WS-INPUT AT END MOVE 0 TO INPUT-TYPE GO TO FINI-PROGRAM END-ACCEPT IF WS1-BLANK PERFORM UNTIL NOT WS1-BLANK MOVE WS-INPUT(2:499) TO WS-INPUT END-PERFORM END-IF IF WS1 = "!" OR "*" GO TO GET-COMMAND END-IF IF WS1 = "$" CALL "LIB$DO_COMMAND" USING BY DESCRIPTOR WS-INPUT STOP RUN END-IF PERFORM UNSTRING-PARAMETERS GO TO DO-COMMAND. IF MULTI-FUNCTIONS *A test for "\" not being last character on command line and no more functions IF STRT = 0 GO TO GETOUT END-IF PERFORM GET-MULTI-FUNCTION. PERFORM UNSTRING-PARAMETERS. IF FCOUNT > 0 GO TO DO-COMMAND. *If Multi Functions were on one line and last has been done Exit Image IF FCOUNT = 0 AND MULTI-FUNCTIONS MOVE 0 TO INPUT-TYPE GO TO FINI-PROGRAM. *No Command on line -Check for File input. Check-Default-File. MOVE "SCREEN$CTL.INPUT" TO INPUT-FILE-NAME. Start-File-Input. OPEN INPUT IN-FILE. IF NOT-FOUND AND INPUT-FILE-NAME = "SCREEN$CTL.INPUT" CALL "SCREENCTL_HELP" STOP RUN. IF NOT-FOUND AND INPUT-FILE-NAME NOT = "SCREEN$CTL.INPUT" STOP RUN. MOVE 1 TO INPUT-TYPE. Get-File-Command. READ IN-FILE INTO WS-INPUT AT END CLOSE IN-FILE, STOP RUN. IF WS1 = "!" OR "*" GO TO GET-FILE-COMMAND. PERFORM UNSTRING-PARAMETERS. IF FCOUNT = 0 GO TO GET-FILE-COMMAND. Do-Command. INSPECT FUNCTION CONVERTING "abcdefghijklmnopqrstuvwxyz" TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ". IF WS-INPUT = "EXIT" MOVE 0 TO INPUT-TYPE GO TO FINI-PROGRAM. IF FUNCTION = "HELP" CALL "SCREENCTL_HELP",STOP RUN. IF FUNCTION = "CREATE" CALL "CLI$GET_VALUE" USING BY DESCRIPTOR "$LINE" IMAGE-NAME GIVING IMAGE-LNGTH CALL "LIB$MATCHC" USING BY DESCRIPTOR "SCREENCTL" IMAGE-NAME GIVING LOCC CALL "LIB$SET_LOGICAL" USING BY DESCRIPTOR "SCREEN$CTL" IMAGE-NAME(5:LOCC + 4) "LNM$JOB" MOVE 2 TO GLO-SYM PERFORM VARYING J FROM 1 BY 1 UNTIL SYM-NAME(1:1) = "!" MOVE FUNCTION-TBL(J * 9 + 1:9) TO SYM-NAME SYM-FUNCTION(13:9) CALL "LIB$LOCC" USING BY DESCRIPTOR " " SYM-NAME GIVING LOCC IF LOCC = 0 MOVE 10 TO LOCC END-IF IF SYM-NAME(1:1) NOT = "!" CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR SYM-NAME(1:LOCC - 1) SYM-FUNCTION(1:11 + LOCC) BY REFERENCE GLO-SYM END-IF END-PERFORM STOP RUN. CALL "SMG$CREATE_PASTEBOARD" USING BY REFERENCE PASTEBOARD BY DESCRIPTOR "SYS$OUTPUT" BY REFERENCE PB-ROWS PB-COLS DONT-CLEAR-SCREEN. *Functions without parameters IF FUNCTION = "TOP" DISPLAY "7" GO TO FINI-PROGRAM. IF FUNCTION = "WHITE" DISPLAY "7[?5h" GO TO FINI-PROGRAM. IF FUNCTION = "BLACK" DISPLAY "7[?5l" GO TO FINI-PROGRAM. IF FUNCTION = "BRIGHT" DISPLAY "77" GO TO FINI-PROGRAM. IF FUNCTION = "UNSQUEEZE" DISPLAY "7" GO TO FINI-PROGRAM. IF FUNCTION = "CLED" DISPLAY "7[8" GO TO FINI-PROGRAM. *Setup numeric parameters MOVE 0 TO P1 P2 P3 P4 P5 P6 I J. MOVE 1 TO GLO-SYM. IF PAR1(1:P1COUNT) NUMERIC MOVE PAR1(1:P1COUNT) TO P1. IF PAR2(1:P2COUNT) NUMERIC MOVE PAR2(1:P2COUNT) TO P2. IF PAR3(1:P3COUNT) NUMERIC MOVE PAR3(1:P3COUNT) TO P3. IF PAR4(1:P4COUNT) NUMERIC MOVE PAR4(1:P4COUNT) TO P4. IF PAR5(1:P5COUNT) NUMERIC MOVE PAR5(1:P5COUNT) TO P5. IF PAR6(1:P6COUNT) NUMERIC MOVE PAR6(1:P6COUNT) TO P6. IF JOB-STREAM IF P1 = 0 AND P2 > 0 MOVE P2 TO P1 MOVE P3 TO P2 MOVE P4 TO P3 END-IF IF P2 = 0 AND P3 > 0 MOVE P3 TO P2 MOVE P4 TO P3 MOVE P5 TO P4. *I/O from common area IF FUNCTION = "GETCMN" CALL "LIB$GET_COMMON" USING BY DESCRIPTOR WS-INPUT *Check for /GLOBAL option CALL "LIB$MATCHC" USING BY DESCRIPTOR "/GLOBAL" WS-INPUT GIVING LOCC IF LOCC > 0 MOVE 2 TO GLO-SYM END-IF CALL "LIB$MATCHC" USING BY DESCRIPTOR " " WS-INPUT GIVING LOCC CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR PAR1(1:P1COUNT) WS-INPUT(1:LOCC - 1) BY REFERENCE GLO-SYM DISPLAY "7" GO TO FINI-PROGRAM. IF FUNCTION = "PUTCMN" PERFORM GET-MSG-LINE CALL "LIB$PUT_COMMON" USING BY DESCRIPTOR MSG-LINE(1:MSG-COUNT) DISPLAY "7" GO TO FINI-PROGRAM. *Turn Cursor "OFF" for Selected Functions IF CURSOR-TO-BE-OFF DISPLAY "7[?25l8". IF FUNCTION(1:3) = "LED" AND FUNCTION(4:1) NUMERIC MOVE FUNCTION(4:1) TO P1 MOVE "LED" TO FUNCTION. IF FUNCTION = "LED" IF P1 = 5 DISPLAY "78" END-IF DISPLAY "7[" P1 "q8" IF P2 > 0 DISPLAY "7[" P2 "q8" END-IF IF P3 > 0 DISPLAY "7[" P3 "q8" END-IF IF P4 > 0 DISPLAY "7[" P4 "q8" END-IF GO TO FINI-PROGRAM. IF FUNCTION = "PAUSE" DISPLAY "7" PERFORM WAIT-PAUSE GO TO FINI-PROGRAM. IF FUNCTION = "CL*EAR" OR "CLEAR" OR "CL" PERFORM CLEAR-SCREEN-AREA THRU CLEAR-EXIT GO TO FINI-PROGRAM. *Set scrolling region IF FUNCTION = "SCROLL" *Scroll p1 thru p2 IF P1 > 0 AND P2 > 0 DISPLAY "[" P1 ";" P2 "r[" P1 ";1H 7" MOVE PAR3 TO PAR1 END-IF *Scroll center p1 lines of screen IF P1 > 0 AND P2 = 0 COMPUTE P5 = ((24 - P1) / 2 ) ADD P5 P1 GIVING P6 DISPLAY "[" P5 ";" P6 "r[" P5 ";1H7" MOVE PAR2 TO PAR1 END-IF *Set JUMP & SMOOTH Scroll IF PAR1(1:1) = "J" OR PAR1(2:1) = "J" DISPLAY "7[?4l" GO TO FINI-PROGRAM END-IF IF PAR1(1:1) = "S" OR PAR1(2:1) = "S" DISPLAY "7[?4h" END-IF GO TO FINI-PROGRAM. IF FUNCTION = "LPOS" OR "LINE" IF P1COUNT > 0 DISPLAY "[" P1 ";1f7" ELSE DISPLAY "E7" END-IF IF PAR2(1:1) = "C" DISPLAY "[" P1 ";1H7" END-IF GO TO FINI-PROGRAM. IF FUNCTION = "SQUEEZE" PERFORM SQUEEZE,GO TO FINI-PROGRAM. IF FUNCTION = "BEEP" IF P1 = 0 MOVE 1 TO P1 END-IF IF P1 > 10 MOVE 10 TO P1 END-IF MOVE ALL "" TO GRAPHIC DISPLAY "7" GRAPHIC(1:P1) GO TO FINI-PROGRAM. IF FUNCTION = "BBIG" DISPLAY "7" NO ADVANCING PERFORM DISPLAY-BIG DISPLAY "87" GO TO FINI-PROGRAM. IF FUNCTION = "BIG" OR "SCRAM" PERFORM DISPLAY-BIG GO TO FINI-PROGRAM. IF POSITION-CURSOR PERFORM POS-CURSOR GO TO FINI-PROGRAM. IF FUNCTION = "WINDOW" PERFORM DRAW-BOX CALL "LIB$SPAWN" USING BY DESCRIPTOR "SET TERM/NOWRAP" *If a numeric value in P5 is > 0 draw the one Horizontal line IF P5 > 0 PERFORM DRAW-OPTIONAL-HORIZONTAL-LINE END-IF *If P5 = 0 and anything other then ! in PAR5 Draw multiple vertical lines IF P5COUNT > 0 AND PAR5(1:1) NOT = "0" AND PAR5(1:1) NOT = "!" MOVE 1 TO STR LOCA PERFORM UNTIL LOCA = 0 CALL "LIB$MATCHC" USING BY DESCRIPTOR "," PAR5 GIVING LOCA IF LOCA > 0 MOVE "*" TO PAR5(LOCA:1) MOVE PAR5(STR:LOCA - STR) TO P5 PERFORM DRAW-OPTIONAL-HORIZONTAL-LINE ADD 1 LOCA GIVING STR ELSE MOVE PAR5(STR:P5COUNT - STR + 1) TO P5 PERFORM DRAW-OPTIONAL-HORIZONTAL-LINE END-IF END-PERFORM END-IF MOVE 0 TO STR *If a numeric value in P6 is > 0 draw the one Vertical line IF P6 > 0 PERFORM DRAW-OPTIONAL-VERTICAL-LINE END-IF *If P6 = 0 and anything other then ! in PAR6 Draw multiple Horizontal lines IF P6COUNT > 0 AND PAR6(1:1) NOT = "0" AND PAR6(1:1) NOT = "!" MOVE 1 TO STR LOCA PERFORM UNTIL LOCA = 0 CALL "LIB$MATCHC" USING BY DESCRIPTOR "," PAR6 GIVING LOCA IF LOCA > 0 MOVE "*" TO PAR6(LOCA:1) MOVE PAR6(STR:LOCA - STR) TO P6 PERFORM DRAW-OPTIONAL-VERTICAL-LINE ADD 1 LOCA GIVING STR ELSE MOVE PAR6(STR:P6COUNT - STR + 1) TO P6 PERFORM DRAW-OPTIONAL-VERTICAL-LINE END-IF END-PERFORM END-IF GO TO FINI-PROGRAM. IF FUNCTION = "CURSOR" *Turn cursor ON or OFF IF PAR1(1:2) = "ON" DISPLAY "7[?25hM",GO TO FINI-PROGRAM END-IF IF PAR1(1:3) = "OFF" DISPLAY "7[?25lM",GO TO FINI-PROGRAM END-IF *Move cursor and display PERFORM GET-MSG-LINE INSPECT PAR1 CONVERTING "UDFB" TO "ABCD" MOVE MSG-LINE(1:MSG-COUNT) TO MSG-LINE(2:MSG-COUNT) MOVE PAR1(1:1) TO MSG-LINE(1:1) DISPLAY "[" P2 MSG-LINE(1:MSG-COUNT + 1) " 78" GO TO FINI-PROGRAM. IF FUNCTION = "BOX" OR "BBOX" OR "UNBOX" PERFORM DRAW-BOX IF P5 > 0 MOVE PAR5(1:P5COUNT) TO P1 MOVE PAR6(1:P6COUNT) TO P2 MOVE PAR7(1:P7COUNT) TO P3 MOVE PAR8(1:P8COUNT) TO P4 PERFORM DRAW-BOX END-IF IF P9COUNT > 0 MOVE PAR9(1:P9COUNT) TO P1 MOVE PAR10(1:P10COUNT) TO P2 MOVE PAR11(1:P11COUNT) TO P3 MOVE PAR12(1:P12COUNT) TO P4 PERFORM DRAW-BOX END-IF IF FUNCTION = "BBOX" DISPLAY "" END-IF GO TO FINI-PROGRAM. IF FUNCTION = "VLINE" PERFORM DRAW-V-LINE GO TO FINI-PROGRAM. IF FUNCTION = "BOTTOM" OR "HLINE" MOVE ALL "o" TO GRAPHIC IF FUNCTION = "HLINE" AND P4COUNT = 1 INSPECT PAR4 CONVERTING "13579" TO "opqrs" PERFORM VARYING P4 FROM 1 BY 1 UNTIL P4 = 140 MOVE PAR4 TO GRAPHIC(P4:1) END-PERFORM END-IF IF FUNCTION = "BOTTOM" DISPLAY "7(0" GRAPHIC(1:PB-COLS - 1) "(B8" END-IF IF FUNCTION = "HLINE" DISPLAY "7[" P1 ";" P2 "H(0" GRAPHIC(1:P3) "(B8" END-IF GO TO FINI-PROGRAM. IF FUNCTION(1:4) = "JUST" PERFORM GET-MSG-LINE IF PAR2(1:1) = "L" DISPLAY "7[" P1 ";1f" MSG-LINE(1:MSG-COUNT) END-IF IF PAR2(1:1) = "R" COMPUTE P2 = PB-COLS - MSG-COUNT + 1 DISPLAY "7[" P1 ";" P2 "H" MSG-LINE(1:MSG-COUNT) END-IF *Not "Left" or "Right" then it must be "Center" IF PAR2(1:1) NOT = "L" AND NOT = "R" COMPUTE P2 = (PB-COLS - MSG-COUNT) / 2 + 1 DISPLAY "7[" P1 ";" P2 "H" MSG-LINE(1:MSG-COUNT) END-IF IF PAR2(1:1) NOT = "L" CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR "LAST_COL" P2(1:3) BY REFERENCE GLO-SYM END-IF GO TO FINI-PROGRAM. IF FUNCTION = "PDINQ" MOVE 0 TO MSG-COUNT CALL "LIB$MATCHC" USING BY DESCRIPTOR """" WS-INPUT GIVING LOCA IF LOCA > 0 PERFORM GET-MSG-LINE END-IF PERFORM POS-DISP-INQUIRE GO TO FINI-PROGRAM. *Accept Input Functions CALL "SYS$TRNLOG" USING BY DESCRIPTOR "SYS$INPUT" BY VALUE 9 BY DESCRIPTOR LOGICAL-EQU BY VALUE 0 0 0. CALL "LIB$SET_LOGICAL" USING BY DESCRIPTOR "SYS$INPUT" "SYS$COMMAND". IF FUNCTION = "MORE" DISPLAY "Press to Continue...7" NO ADVANCING ACCEPT PAR12 NO ECHO AT END MOVE 0 TO NUM END-ACCEPT DISPLAY "8". IF FUNCTION = "GETPF" OR "GETAR" OR "GETFUNC" MOVE "|" TO PAR4 IF FUNCTION = "GETPF" PERFORM GET-A-KEY UNTIL PAR4(1:1) = 1 OR 2 OR 3 OR 4 END-IF IF FUNCTION = "GETAR" PERFORM GET-A-KEY UNTIL PAR4(1:1) = "U" OR "D" OR "R" OR "L" END-IF IF FUNCTION = "GETFUNC" DISPLAY "=" NO ADVANCING PERFORM GET-A-KEY UNTIL PAR4(1:1) NOT = "|" DISPLAY ">" NO ADVANCING END-IF. CALL "LIB$MATCHC" USING BY DESCRIPTOR " " LOGICAL-EQU GIVING LOCC. CALL "LIB$SET_LOGICAL" USING BY DESCRIPTOR "SYS$INPUT" LOGICAL-EQU(1:LOCC - 1). *At this point command-line extract is not a valid function. *If already in input from file mode or multi command mode display error,continue IF FILE-INPUT OR MULTI-FUNCTIONS OR JOB-STREAM GO TO FINI-PROGRAM. *File input name given on command line, extract it and start input CALL "LIB$MATCHC" USING BY DESCRIPTOR " " WS-INPUT GIVING LOCC. MOVE WS-INPUT(1:LOCC - 1) TO INPUT-FILE-NAME. GO TO START-FILE-INPUT. Fini-Program. *Trun Cursor "ON" After Being turned off for selected functions IF CURSOR-TO-BE-OFF OR MULTI-FUNCTIONS DISPLAY "8[?25h". DISPLAY "8". IF FILE-INPUT GO TO GET-FILE-COMMAND. IF MULTI-FUNCTIONS OR JOB-STREAM GO TO GET-COMMAND. Getout. STOP RUN. ** * Routines Called Via "PERFORM" Statements. ** Get-A-Key. IF P1 > 0 DISPLAY "7[" P1 ";" P2 "H" NO ADVANCING ELSE DISPLAY "7" NO ADVANCING. ACCEPT CONTROL KEY IN PF-KEY. IF PF1 MOVE "1" TO PAR4. IF PF2 MOVE "2" TO PAR4. IF PF3 MOVE "3" TO PAR4. IF PF4 MOVE "4" TO PAR4. IF UPP MOVE "U" TO PAR4. IF DN MOVE "D" TO PAR4. IF LT MOVE "L" TO PAR4. IF RT MOVE "R" TO PAR4. IF F7 MOVE "F7" TO PAR4. IF F8 MOVE "F7" TO PAR4. IF F9 MOVE "F7" TO PAR4. IF F10 MOVE "F10" TO PAR4. IF F11 MOVE "F11" TO PAR4. IF F12 MOVE "F12" TO PAR4. IF F13 MOVE "F13" TO PAR4. IF F14 MOVE "F14" TO PAR4. IF F17 MOVE "F17" TO PAR4. IF F18 MOVE "F18" TO PAR4. IF F19 MOVE "F19" TO PAR4. IF F20 MOVE "F20" TO PAR4. IF F-DO MOVE "DO" TO PAR4. IF F-HELP MOVE "HELP" TO PAR4. IF F-FIND MOVE "FIND" TO PAR4. IF F-INSE MOVE "INSERT" TO PAR4. IF F-REMO MOVE "REMOVE" TO PAR4. IF F-SELE MOVE "SELECT" TO PAR4. IF F-PREV MOVE "PREV" TO PAR4. IF F-NEXT MOVE "NEXT" TO PAR4. IF KP0 MOVE "0" TO PAR4. IF KP1 MOVE "1" TO PAR4. IF KP2 MOVE "2" TO PAR4. IF KP3 MOVE "3" TO PAR4. IF KP4 MOVE "4" TO PAR4. IF KP5 MOVE "5" TO PAR4. IF KP6 MOVE "6" TO PAR4. IF KP7 MOVE "7" TO PAR4. IF KP8 MOVE "8" TO PAR4. IF KP9 MOVE "9" TO PAR4. IF KP-PER MOVE "PERIOD" TO PAR4. IF KP-COM MOVE "COMMA" TO PAR4. IF KP-ENT MOVE "ENTER" TO PAR4. IF KP-DSH MOVE "DASH" TO PAR4. IF PAR4(1:1) = "|" GO TO GET-A-KEY. IF PAR1(1:P1COUNT) NOT NUMERIC MOVE P1COUNT TO P3COUNT MOVE PAR1(1:P1COUNT) TO PAR3(1:P1COUNT). CALL "LIB$MATCHC" USING BY DESCRIPTOR " " PAR4 GIVING LOCC. CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR PAR3(1:P3COUNT) PAR4(1:LOCC - 1) BY REFERENCE GLO-SYM. Wait-Pause. *Check for "/UNTIL=" option IF PAR1(1:7) = "/UNTIL=" MOVE PAR1(8:5) TO CONVERT-TIME ACCEPT WS-TIME FROM TIME END-ACCEPT COMPUTE WAIT-TYME = C-HOURS * 60 + C-MINUTES COMPUTE CUR-TYME = HR * 60 + MM IF CUR-TYME < WAIT-TYME SUBTRACT CUR-TYME FROM WAIT-TYME GIVING MINS-TO-WAIT ELSE COMPUTE MINS-TO-WAIT = 1440 - CUR-TYME + WAIT-TYME END-IF DIVIDE 60 INTO MINS-TO-WAIT GIVING HRS-TO-WAIT MULTIPLY HRS-TO-WAIT BY 60 GIVING DIFFERENCE SUBTRACT DIFFERENCE FROM MINS-TO-WAIT GIVING MINS-TO-WAIT MOVE HRS-TO-WAIT TO PAR1 MOVE ":" TO PAR1(3:1) MOVE MINS-TO-WAIT(3:2) TO PAR1(4:2) MOVE 5 TO P1COUNT. IF PAR1(1:P1COUNT) NUMERIC MOVE PAR1(1:P1COUNT) TO DELAY. IF P1COUNT = 5 AND PAR1(3:1) = ":" MOVE PAR1(1:5) TO PAUSE-TIME COMPUTE DELAY = HOURS-TO-WAIT * 60 * 60 + MINUTES-TO-WAIT * 60. CALL "LIB$WAIT" USING BY REFERENCE DELAY. Draw-Box. MOVE ALL "q" TO GRAPHIC. IF FUNCTION = "UNBOX" MOVE ALL "_" TO GRAPHIC. IF FUNCTION = "BBOX" DISPLAY "" NO ADVANCING. DISPLAY "7(0[" P1 ";" P2 "Hl" GRAPHIC(1:P3). IF FUNCTION = "UNBOX" DISPLAY "[" P1 ";" P2 "H_". COMPUTE IMARG = P2 + P3 + 1. DISPLAY "[" P1 ";" IMARG "Hk". IF FUNCTION = "UNBOX" DISPLAY "[" P1 ";" IMARG "H_". MOVE P2 TO IMARG2. COMPUTE NUM = P1 + P4 - 1. PERFORM UNTIL P1 > NUM ADD 1 TO P1 DISPLAY "[" P1 ";" IMARG2 "Hx[" P1 ";" IMARG "Hx" IF FUNCTION = "UNBOX" DISPLAY "[" P1 ";" IMARG2 "H_[" P1 ";" IMARG "H_" END-IF END-PERFORM. ADD 1 TO P1. MOVE IMARG2 TO P2. COMPUTE NUM = P2 + 1 + P3. IF P3 = 80 SUBTRACT 1 FROM P3. DISPLAY "[" P1 ";" P2 "Hm" GRAPHIC(1:P3) "[" P1 ";" NUM "Hj". IF FUNCTION = "UNBOX" DISPLAY "[" P1 ";" P2 "H_" GRAPHIC(1:P3) "[" P1 ";" NUM "H_". DISPLAY "(B8". Draw-Optional-Horizontal-Line. DISPLAY "7(0[" P5 ";" P2 "Ht" GRAPHIC(1:P3) "u". DISPLAY "(B8". Draw-Optional-Vertical-Line. MOVE PAR1(1:P1COUNT) TO P1. DISPLAY "7(0[" P1 ";" P6 "Hw". ADD P1 P4 GIVING NUM. PERFORM UNTIL P1 > NUM ADD 1 TO P1 *STR = 0 when routine is executed with 1 value in PAR6 *STR > 0 when routine is executed with more than 1 value in PAR6 IF STR = 0 *If P1 = P5 display the "Crossing Lines" else display Vertical line IF P1 = P5 DISPLAY "[" P1 ";" P6 "Hn" ELSE DISPLAY "[" P1 ";" P6 "Hx" END-IF ELSE *STR > 0 at this point *Search PAR5 for current value of P1, if found crossing line displayed MOVE 1 TO I MOVE 3 TO J IF P1A(1:1) = "0" ADD 1 TO I SUBTRACT 1 FROM J IF P1A(2:1) = "0" ADD 1 TO I SUBTRACT 1 FROM J END-IF END-IF CALL "LIB$MATCHC" USING BY DESCRIPTOR P1A(I:J) PAR5 GIVING LOCB IF LOCB = 0 DISPLAY "[" P1 ";" P6 "Hx" END-IF IF LOCB = 1 AND PAR5(LOCB + J:1) NOT NUMERIC DISPLAY "[" P1 ";" P6 "Hn" ELSE IF LOCB > 1 AND PAR5(LOCB - 1:1) NOT NUMERIC AND PAR5(LOCB + J:1) NOT NUMERIC DISPLAY "[" P1 ";" P6 "Hn" ELSE DISPLAY "[" P1 ";" P6 "Hx" END-IF END-IF END-IF END-PERFORM. *Bottom of vertical line DISPLAY "[" P1 ";" P6 "Hv". DISPLAY "(B8". Display-Big. IF P2 = 0 MOVE PAR3 TO PAR4, MOVE P3COUNT TO P4COUNT, MOVE P3 TO P4 MOVE PAR2 TO PAR3, MOVE P2COUNT TO P3COUNT, MOVE P2 TO P3. PERFORM GET-MSG-LINE. *Center Display text if column position not given. IF P2 = 0 COMPUTE P2 = (PB-COLS / 2 - MSG-COUNT) / 2 + 1. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/CLEAR" WS-INPUT GIVING LOCA. IF LOCA = 0 DISPLAY "7[" P1 ";" P2 "H#6#3D#4M" ELSE DISPLAY "7[" P1 ";" P2 "H#6#3D - "#4M". IF FUNCTION(1:5) = "SCRAM" DIVIDE 2 INTO PB-COLS GIVING PB-COLS PERFORM VARYING J FROM 1 BY 1 UNTIL J > 66 MOVE COLUMS (J) TO NUM COMPUTE COL = NUM + P2 - 1 IF COL NOT > PB-COLS DISPLAY "[" P1 ";" COL "H" MSG-LINE(NUM:1) "[" P1 ";" COL "HD" MSG-LINE(NUM:1) "8" END-IF END-PERFORM. IF FUNCTION NOT = "SCRAM" CALL "LIB$MATCHC" USING BY DESCRIPTOR "/STEP" WS-INPUT GIVING LOCA IF LOCA = 0 DISPLAY "[" P1 ";" P2 "H" MSG-LINE(1:MSG-COUNT) "[" P1 ";" P2 "HD" MSG-LINE(1:MSG-COUNT) "D8" ELSE DISPLAY "[?25l[" P1 ";" P2 "H" MSG-LINE(1:1) DISPLAY "[?25l[" P1 ";" P2 "HD" MSG-LINE(1:1) PERFORM VARYING I FROM 2 BY 1 UNTIL I > MSG-COUNT SUBTRACT 1 FROM I GIVING J DISPLAY "[" P1 ";" P2 "H[" J "C" MSG-LINE(I:1) "[" P1 ";" P2 "HD" "[" J "C" MSG-LINE(I:1) "D8" END-PERFORM. Pos-Cursor. PERFORM GET-MSG-LINE. IF FUNCTION = "FPOS" OR "BLINK" DISPLAY "7". IF FUNCTION = "UNDERLINE" DISPLAY "7". IF FUNCTION = "RPOS" DISPLAY "7". IF FUNCTION = "BPOS" DISPLAY "7". IF FUNCTION = "SPOS" OR "GPOS" DISPLAY "7(0". IF FUNCTION = "BRPOS" OR "BOLD" DISPLAY "7". IF FUNCTION = "POS" DISPLAY "7". CALL "LIB$MATCHC" USING BY DESCRIPTOR "/CLEAR" WS-INPUT GIVING LOCA. IF LOCA > 0 DISPLAY "[" P1 ";" P2 "H#5". CALL "LIB$MATCHC" USING BY DESCRIPTOR "/WIDE" WS-INPUT GIVING LOCA. IF LOCA > 0 DISPLAY "[" P1 ";" P2 "H#6". CALL "LIB$MATCHC" USING BY DESCRIPTOR "/DOUBLE" WS-INPUT GIVING LOCA. IF LOCA > 0 PERFORM DOUBLE-SPACE-STRING. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/STEP" WS-INPUT GIVING LOCA. IF LOCA = 0 DISPLAY "[" P1 ";" P2 "H" MSG-LINE(1:MSG-COUNT) ELSE DISPLAY "[?25l[" P1 ";" P2 "H" MSG-LINE(1:1) PERFORM VARYING I FROM 2 BY 1 UNTIL I > MSG-COUNT SUBTRACT 1 FROM I GIVING J DISPLAY "[" P1 ";" P2 "H[" J "C" MSG-LINE(I:1) END-PERFORM. DISPLAY "8(B[?25h". Double-Space-String. MOVE MSG-LINE TO DUMMY. MOVE SPACES TO MSG-LINE. PERFORM VARYING I FROM 1 BY 1 UNTIL I > MSG-COUNT COMPUTE J = I - 1 + I MOVE DUMMY(I:1) TO MSG-LINE(J:1) END-PERFORM. COMPUTE MSG-COUNT = MSG-COUNT * 2 - 1. Clear-Screen-Area. IF PAR1(1:1) = "/" MOVE PAR1(2:P1COUNT - 1) TO PAR1(1:P1COUNT - 1) MOVE " " TO PAR1(P1COUNT:1). *Cleaar entire screen IF P1COUNT = 0 OR (PAR1(1:1) = "S" AND PAR1(1:6) NOT = "SCROLL") DISPLAY "[?6l7" GO TO CLEAR-EXIT. *Clear scrolling region ONLY IF PAR1(1:6) = "SCROLL" DISPLAY "7[?6h7[?6l8" GO TO CLEAR-EXIT. *Clear entire screen and keep cursor position IF PAR1(1:1) = "H" DISPLAY "7" GO TO CLEAR-EXIT. *Clear one line given IF PAR1(1:1) = "L" DISPLAY "7[" P2 ";1f" GO TO CLEAR-EXIT. *Clear Bottom of screen IF PAR1(1:1) = "B" * from current cursor position IF P2 = 0 DISPLAY "78" * from line given ELSE DISPLAY "7[" P2 ";1f" END-IF GO TO CLEAR-EXIT. *Clear Top part of screen IF PAR1(1:1) = "T" * from current cursor position IF P2 = 0 DISPLAY "78" * from line given ELSE DISPLAY "7[" P2 ";133f" END-IF GO TO CLEAR-EXIT. *Clear lines P1 thru P2 IF P1 > 0 AND P2 > 0 DISPLAY "7" PERFORM VARYING NUM FROM P1 BY 1 UNTIL NUM > P2 DISPLAY "[" NUM ";1f8" END-PERFORM GO TO CLEAR-EXIT. *Bad option given with "CLEAR" command, Clear whole screen & home cursor DISPLAY "7". Clear-Exit. EXIT. Draw-V-Line. DISPLAY "7(0". COMPUTE NUM = P1 + P3 - 1. PERFORM UNTIL P1 > NUM DISPLAY "[" P1 ";" P2 "Hx" ADD 1 TO P1 END-PERFORM. DISPLAY "(B8". Squeeze. MOVE ALL "=" TO GRAPHIC. MOVE 1 TO IMARG2. IF P2COUNT > 0 AND PAR2(1:1) NOT NUMERIC INSPECT GRAPHIC CONVERTING "=" TO PAR2(1:1). IF P3COUNT > 0 INSPECT GRAPHIC CONVERTING "=" TO PAR3(1:1). COMPUTE IMARG = ((24 - P1) / 2) - 1. IF PAR2(1:1) NUMERIC COMPUTE IMARG = P1 - 1 COMPUTE IMARG2 = P2 + 1. DISPLAY "[" IMARG ";1H" GRAPHIC(1:PB-COLS). IF P2 = 0 COMPUTE IMARG2 = IMARG + P1 + 1. DISPLAY "[" IMARG2 ";1H" GRAPHIC(1:PB-COLS). COMPUTE IMARG = ((24 - P1) / 2). COMPUTE IMARG2 = IMARG + P1 - 1. IF PAR2(1:1) NUMERIC MOVE PAR1(1:P1COUNT) TO IMARG MOVE PAR2(1:P2COUNT) TO IMARG2. DISPLAY "[" IMARG ";" IMARG2 "r[" IMARG ";1H7". Unstring-Parameters. UNSTRING WS-INPUT DELIMITED BY " " INTO FUNCTION COUNT FCOUNT PAR1 COUNT P1COUNT PAR2 COUNT P2COUNT PAR3 COUNT P3COUNT PAR4 COUNT P4COUNT PAR5 COUNT P5COUNT PAR6 COUNT P6COUNT PAR7 COUNT P7COUNT PAR8 COUNT P8COUNT PAR9 COUNT P9COUNT PAR10 COUNT P10COUNT PAR11 COUNT P11COUNT PAR12 COUNT P12COUNT. Get-Multi-Function. CALL "LIB$MATCHC" USING BY DESCRIPTOR "\" WS-FUNCTIONS GIVING LOCB. MOVE SPACES TO WS-INPUT. IF LOCB > 0 MOVE "*" TO WS-FUNCTIONS(LOCB:1) IF WS-FUNCTIONS(STRT:1) = " " ADD 1 TO STRT END-IF MOVE WS-FUNCTIONS(STRT:LOCB - STRT) TO WS-INPUT ADD LOCB 1 GIVING STRT. IF LOCB = 0 IF WS-FUNCTIONS(STRT:1) = " " ADD 1 TO STRT END-IF MOVE WS-FUNCTIONS(STRT:500 - STRT) TO WS-INPUT MOVE 0 TO STRT. Get-Msg-Line. *Return string inside the Double quotes or characters from PAR3 & PAR4 MOVE 0 TO Q-MARKS. INSPECT WS-INPUT TALLYING Q-MARKS FOR ALL """". * vSpecial insert 255 INSPECT WS-INPUT CONVERTING """" TO "ÿ". MOVE 1 TO LOCC. PERFORM UNTIL LOCC = 0 CALL "LIB$MATCHC" USING BY DESCRIPTOR "ÿÿÿ" WS-INPUT GIVING LOCC IF LOCC > 0 ADD 1 TO LOCC MOVE """" TO WS-INPUT(LOCC:1) END-IF IF LOCC > 0 PERFORM VARYING I FROM LOCC BY 1 UNTIL I > 498 MOVE WS-INPUT(I + 2:1) TO WS-INPUT(I + 1:1) END-PERFORM END-IF END-PERFORM. MOVE 1 TO LOCC. PERFORM UNTIL LOCC = 0 CALL "LIB$MATCHC" USING BY DESCRIPTOR "ÿÿ" WS-INPUT GIVING LOCC IF LOCC > 0 MOVE """" TO WS-INPUT(LOCC:1) END-IF IF LOCC > 0 PERFORM VARYING I FROM LOCC BY 1 UNTIL I > 498 MOVE WS-INPUT(I + 2:1) TO WS-INPUT(I + 1:1) END-PERFORM END-IF END-PERFORM. UNSTRING WS-INPUT DELIMITED BY "ÿ" INTO DUMMY COUNT DUMMY-COUNT MSG-LINE COUNT MSG-COUNT. IF Q-MARKS < 2 MOVE P3COUNT TO MSG-COUNT MOVE PAR3(1:P3COUNT) TO MSG-LINE IF P4COUNT > 0 AND PAR4(1:1) NOT = "/" MOVE PAR4(1:P4COUNT) TO MSG-LINE(P3COUNT + 2:P4COUNT) ADD 1 P3COUNT P4COUNT GIVING MSG-COUNT. Pos-Disp-Inquire. CALL "LIB$DELETE_SYMBOL" USING BY DESCRIPTOR "SCREENCTL$TO" BY REFERENCE LOC-SYM. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/CLEAR" WS-INPUT GIVING LOCA. IF P1 = 0 MOVE PAR1(1:P1COUNT) TO PAR3(1:P1COUNT), MOVE P1COUNT TO P3COUNT *Cursor will be positioned only if P1 is > zero ELSE IF LOCA > 0 DISPLAY "[" P1 ";" P2 "H#5" END-IF DISPLAY "[" P1 ";" P2 "H" NO ADVANCING. IF MSG-COUNT > 0 DISPLAY MSG-LINE(1:MSG-COUNT) "7" NO ADVANCING ELSE DISPLAY "7" NO ADVANCING. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/MARK" WS-INPUT GIVING LOCE. IF LOCE > 0 DISPLAY "(0a(B" NO ADVANCING. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/TIME" WS-INPUT GIVING LOCA. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/SIZE=" WS-INPUT GIVING LOCB. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/TIME=" WS-INPUT GIVING LOCC. CALL "LIB$MATCHC" USING BY DESCRIPTOR "/NOE" WS-INPUT GIVING LOCD. *Default 10 minutes used if "/TIME" option used AND no value was given IF LOCC = 0 AND LOCA > 0 MULTIPLY 600 BY DAYTIM. *Compute Timeout period from "/TIME=mm:ss" IF LOCC > 0 MOVE WS-INPUT(LOCC + 6:2) TO P1 MOVE WS-INPUT(LOCC + 9:2) TO P2 COMPUTE DAYTIM = (P1 * 60 + P2) * DAYTIM. *Check for "/SIZE=" option IF LOCB > 0 MOVE 0 TO I IF WS-INPUT(LOCB + 6:1) NUMERIC MOVE 1 TO I END-IF IF WS-INPUT(LOCB + 7:1) NUMERIC ADD 1 TO I IF WS-INPUT(LOCB + 8:1) NUMERIC ADD 1 TO I END-IF END-IF IF I > 0 MOVE WS-INPUT(LOCB + 6:I) TO BUFF-LEN. *Set Timmer Only if "/TIME" was given IF LOCA > 0 CALL "SYS$SETIMR" USING BY VALUE EFN BY REFERENCE DAYTIM BY VALUE ASTADR BY REFERENCE PARAMETER *Set timeout symbol to NO as default, Timeout routine will set to Yes CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR "SCREENCTL$TO" "NO" BY REFERENCE LOC-SYM. IF LOCD > 0 CALL "LIB$SPAWN" USING BY DESCRIPTOR "SET TERM/NOECHO". CALL "SYS$QIOW" USING BY VALUE 10 TT-CHANNEL BY VALUE IO-READVBLK BY REFERENCE IOSB BY VALUE 0 0 BY REFERENCE PAR12 BY VALUE BUFF-LEN 0 0 0 0. *Remove mark if was all that was entered IF LOCE > 0 AND PAR12(1:1) = " " DISPLAY "8 ". *Cancel Timer CALL "SYS$CANTIM" USING BY VALUE 0 0. *Turn echo on if "/NOECHO" was used IF LOCD > 0 DISPLAY " " CALL "LIB$SPAWN" USING BY DESCRIPTOR "SET TERM/ECHO". IF LOCB > 0 MOVE BUFF-LEN TO NUM ELSE CALL "LIB$MATCHC" USING BY DESCRIPTOR " " PAR12 GIVING LOCC MOVE LOCC TO NUM SUBTRACT 1 FROM NUM * v Special Insert 26 IF LOCC = 0 AND PAR12(1:1) NOT = "" MOVE 1 TO NUM MOVE "" TO PAR12(1:1) END-IF END-IF. * v Special Insert 26 IF PAR12(1:1) = "" MOVE 2 TO NUM * v is (^ and Z) MOVE "^Z" TO PAR12. *Check for /UPPER option CALL "LIB$MATCHC" USING BY DESCRIPTOR "/UPPER" WS-INPUT GIVING LOCC. IF LOCC > 0 INSPECT PAR12 CONVERTING "abcdefghijklmnopqrstuvwxyz" to "ABCDEFGHIJKLMNOPQRSTUVWXYZ". *Check for /GLOBAL option CALL "LIB$MATCHC" USING BY DESCRIPTOR "/GLOBAL" WS-INPUT GIVING LOCC. IF LOCC > 0 MOVE 2 TO GLO-SYM. *Set symbol to response from user CALL "LIB$SET_SYMBOL" USING BY DESCRIPTOR PAR3(1:P3COUNT) PAR12(1:NUM) BY REFERENCE GLO-SYM.