C FILE= VTLIB.RAT CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT. C C C FILE=VTDEFIN.RAT DEFINES FOR VTLIB C C CThis package of subroutines provides easy control of the vidio functions C of a VT52 or VT100. CIt also is a good example of how RATFOR provides elegant and readable C solutions to programming problems. CThe main program must include VTDEFIN.RAT to define the symbolic constants C for the control functions, and CVTLIB.RAT to define the common block, C which passes the logical unit number to the subroutine that does all the C output, VTSEND. Note that in an overlaid program, VTSEND must be in the C root. The mainline must also specify whether the terminal is a VT52 or VT100 C unless the first call is VTSET(ANSIMODE) OR VTSET (NONANSI), which sets C VTYPE as well as sending an escape sequence to set the terminal as specified. CMost functions can be done just by calling VTSET with the C symbolic for the desired function as a parameter, eg CALL VTSET(HOME) C moves the cursor to the home position and CALL VTSET(ALTKP) puts the C terminal in alternate keypad mode. CRoutines named VT1xxx do functions available only on the VT100, if VTYPE is C not set to VT100, these routines do nothing. C VTSET handles all mode control for both VT52 and VT100. VTFUNC handles only C VT52 functions but is included for compatibility with older versions. C Other routines do the same functions for both terminals. CStudy the VT100 manual carefully, many of the functions are not at all C straightforward or obvious, but VTTEST.RAT should help. CTo minimize the amount of IO, VTSEND buffers all control codes until C its buffer is full or until it is told to flush the buffer. It does C QIO write-alls so the terminal handler does not interfere by inserting C and by converting tabs to blanks. C C C$ VTCLRL - ERASE (CLEAR) ALL OR PART OF LINE ON VT52 OR VT100. C VT52 DOES ONLY "ERASE TO END" FUNCTION. C VT100 ALSO DOES "TOP TO CURSOR" AND "ALL". C SUBROUTINE VTCLRL ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C CALL VTSEND ( 27 ) IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20000 CALL VTSEND ( 91 ) CALL VTSEND ( MODE ) 20000 CONTINUE CALL VTSEND ( 75 ) CALL VTSEND ( 0 ) C RETURN END C C$ VTCLRS - ERASE (CLEAR) ALL OR PART OF VT52 OR VT100 SCREEN. C VT52 DOES ONLY "ERASE TO END" FUNCTION. VT100 ALSO DOES "TOP TO CURSOR" AND "ALL". C SUBROUTINE VTCLRS ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C CALL VTSEND ( 27 ) IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20002 CALL VTSEND ( 91 ) CALL VTSEND ( MODE ) 20002 CONTINUE CALL VTSEND ( 74 ) CALL VTSEND ( 0 ) C RETURN END C C C$ VTCURS - SUBROUTINE TO DO RELATIVE CURSOR MOVEMENTS C PARAMETERS ARE RELATIVE LINES OR COLS TO MOVE. C NEGATIVE FOR UP OR LEFT; POSITIVE FOR DOWN OR RIGHT C SUBROUTINE VTCURS ( LINES, COLS ) C INTEGER LINES, COLS, I, J, SITOC LOGICAL * 1 BUF ( 4 ) C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 99 )) GOTO 20004 IF (.NOT.( LINES .NE. 0 )) GOTO 20006 DO 20008 I = 1, IABS ( LINES ) CALL VTSEND ( 27 ) IF (.NOT.( LINES .GT. 0 )) GOTO 20010 CALL VTSEND ( 66 ) GOTO 20011 20010 CONTINUE CALL VTSEND ( 65 ) 20011 CONTINUE 20008 CONTINUE 20009 CONTINUE 20006 CONTINUE IF (.NOT.( COLS .NE. 0 )) GOTO 20012 DO 20014 I = 1, IABS ( COLS ) CALL VTSEND ( 27 ) IF (.NOT.( COLS .GT. 0 )) GOTO 20016 CALL VTSEND ( 67 ) GOTO 20017 20016 CONTINUE CALL VTSEND ( 68 ) 20017 CONTINUE 20014 CONTINUE 20015 CONTINUE 20012 CONTINUE C GOTO 20005 20004 CONTINUE IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20018 IF (.NOT.( LINES .NE. 0 )) GOTO 20020 CALL VTSEND ( 27 ) CALL VTSEND ( 91 ) I = SITOC ( IABS ( LINES ), BUF, 3 ) J = 1 20022 IF (.NOT.( J .LE. I)) GOTO 20024 CALL VTSEND ( BUF ( J ) ) 20023 J = J + 1 GOTO 20022 20024 CONTINUE IF (.NOT.( LINES .GT. 0 )) GOTO 20025 CALL VTSEND ( 66 ) GOTO 20026 20025 CONTINUE CALL VTSEND ( 65 ) 20026 CONTINUE 20020 CONTINUE IF (.NOT.( COLS .NE. 0 )) GOTO 20027 CALL VTSEND ( 27 ) CALL VTSEND ( 91 ) I = SITOC ( IABS ( COLS ), BUF, 3 ) J = 1 20029 IF (.NOT.( J .LE. I)) GOTO 20031 CALL VTSEND ( BUF ( J ) ) 20030 J = J + 1 GOTO 20029 20031 CONTINUE IF (.NOT.( COLS .GT. 0 )) GOTO 20032 CALL VTSEND ( 67 ) GOTO 20033 20032 CONTINUE CALL VTSEND ( 68 ) 20033 CONTINUE 20027 CONTINUE 20018 CONTINUE 20005 CONTINUE CALL VTSEND ( 0 ) C RETURN END C C$ VTDCA - SUBROUTINE TO DO DIRECT CURSOR ADDRESSING ON VT52 OR VT100. C PARAMETERS ARE THE ABSOLUTE POSITION ON THE SCREEN WHERE YOU WANT C CURSOR. THIS RELIES ON THE CRT TO HANDLE OFF-SCREEN ORDERS. C SUBROUTINE VTDCA ( LINE, COL ) C INTEGER LINE, COL, I, J, SITOC LOGICAL * 1 BUF ( 4 ) C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C CALL VTSEND ( 27 ) IF (.NOT.( VTYPE .EQ. - 99 )) GOTO 20034 CALL VTSEND ( 89 ) CALL VTSEND ( 31 + LINE ) CALL VTSEND ( 31 + COL ) GOTO 20035 20034 CONTINUE IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20036 CALL VTSEND ( 91 ) I = SITOC ( LINE, BUF, 3 ) J = 1 20038 IF (.NOT.( J .LE. I)) GOTO 20040 CALL VTSEND ( BUF ( J ) ) 20039 J = J + 1 GOTO 20038 20040 CONTINUE CALL VTSEND ( 59 ) I = SITOC ( COL, BUF, 3 ) J = 1 20041 IF (.NOT.( J .LE. I)) GOTO 20043 CALL VTSEND ( BUF ( J ) ) 20042 J = J + 1 GOTO 20041 20043 CONTINUE CALL VTSEND ( 72 ) 20036 CONTINUE 20035 CONTINUE CALL VTSEND ( 0 ) RETURN END C C$ VTFUNC - SUBROUTINE TO EXECUTE ESCAPE SEQUENCE FUNCTIONS ON VT52 C# INCLUDED FOR COMPATIBILITY WITH OLDER PROGRAMS ONLY. C# NEW PROGRAMS SHOULD USE 'VTSET' INSTEAD. C C WORKS FOR THE FOLLOWING VT52 FUNCTIONS: C HOLD, NOHOLD HOLD SCREEN MODE C ALTKP, NOALTKP ALTERNATE KEYPAD MODE C ERASEL, ERASES ERASE FROM HERE TO END OF LINE, SCREEN C HOME MOVE CURSOR TO UPPER LEFTHAND CORNOR C GRAPH, NOGRAPH GRAPHICS MODE C UP, DOWN MOVE CURSOR UP OR DOWN 1 LINE C RIGHT, LEFT MOVE CURSOR RIGHT OR LEFT 1 COLUMN C### NOTE: THESE VALUES ARE NOT DEFINED IN THE CURRENT VTDEF.RAT !!!! C SUBROUTINE VTFUNC ( FUNC ) C LOGICAL * 1 FUNC C CALL VTSEND ( 27 ) CALL VTSEND ( FUNC ) CALL VTSEND ( 0 ) C RETURN END C C$ VTLABL - SUBROUTINE TO WRITE VERTICALLY ON THE SCREEN. C CURSOR MUST FIRST BE MOVED TO STARTING POSITION ON SCREEN. C 'OUTBUF' MUST BE A STRING TERMINATED WITH AN 'EOS'. C SUBROUTINE VTLABL ( OUTBUF ) C LOGICAL * 1 OUTBUF ( 1 ) C I = 1 20044 IF (.NOT.( OUTBUF ( I ) .NE. 0)) GOTO 20046 CALL VTSEND ( OUTBUF ( I ) ) CALL VTCURS ( 1, - 1 ) 20045 I = I + 1 GOTO 20044 20046 CONTINUE RETURN END C C$ VTSEND - SUBROUTINE TO BUFFER AND SEND CHARACTERS TO THE TERMINAL. C NOTE THAT BOTH CVTLIB AND THIS ROUTINE (BECAUSE OF 'LAST') MUST C BE IN ROOT. IF DESIRED, THE QIO CALL CAN BE REPLACED WITH A WRITE. C SUBROUTINE VTSEND ( CHAR ) C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C LOGICAL * 1 CHAR, BUFR ( 30 ) INTEGER IB ( 6 ) DATA LAST / 0 / DATA IB / 6 * 0 / C IF (.NOT.( CHAR .NE. 0 )) GOTO 20047 LAST = LAST + 1 BUFR ( LAST ) = CHAR 20047 CONTINUE IF (.NOT.( LAST .GE. 30 .OR. CHAR .EQ. 0 )) GOTO 20049 C# WRITE (VTLUN,1) (BUFR(N),N=1,LAST) ; 1 FORMAT ($,"+",30A1) CALL GETADR ( IB ( 1 ), BUFR ) IB ( 2 ) = LAST CALL QIO ( 264, VTLUN, 1,,, IB, IDS ) CALL WAITFR ( 1 ) LAST = 0 C 20049 CONTINUE RETURN END C C$ VTSET - SUBROUTINE TO SET AND RESET TERMINAL MODES. C SUBROUTINE VTSET ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C CALL VTSEND ( 27 ) IF (.NOT.( MODE .EQ. 61 .OR. MODE .EQ. 62 )) GOTO 20051 CALL VTSEND ( MODE ) GOTO 20052 20051 CONTINUE IF (.NOT.( MODE .EQ. 60 )) GOTO 20053 CALL VTSEND ( 60 ) VTYPE = - 98 CALL VTSEND ( 27 ) CALL VTSEND ( 41 ) CALL VTSEND ( 48 ) GOTO 20054 20053 CONTINUE IF (.NOT.( MODE .EQ. 50 )) GOTO 20055 CALL VTSEND ( 91 ) CALL VTSEND ( 63 ) CALL VTSEND ( 50 ) CALL VTSEND ( 108 ) VTYPE = - 99 GOTO 20056 20055 CONTINUE IF (.NOT.( VTYPE .EQ. - 99 )) GOTO 20057 IF (.NOT.( MODE .EQ. - 104 )) GOTO 20059 CALL VTSEND ( 10 ) GOTO 20060 20059 CONTINUE IF (.NOT.( MODE .EQ. - 103 )) GOTO 20061 CALL VTSEND ( 73 ) GOTO 20062 20061 CONTINUE CALL VTSEND ( MODE ) 20062 CONTINUE 20060 CONTINUE GOTO 20058 20057 CONTINUE IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20063 IF (.NOT.( MODE .EQ. 72 )) GOTO 20065 CALL VTDCA ( 1, 1 ) GOTO 20066 20065 CONTINUE IF (.NOT.( MODE .EQ. 70 )) GOTO 20067 CALL VTSEND ( 14 ) GOTO 20068 20067 CONTINUE IF (.NOT.( MODE .EQ. 71 )) GOTO 20069 CALL VTSEND ( 15 ) GOTO 20070 20069 CONTINUE IF (.NOT.( MODE .EQ. - 100 )) GOTO 20071 CALL VTSEND ( 55 ) GOTO 20072 20071 CONTINUE IF (.NOT.( MODE .EQ. - 101 )) GOTO 20073 CALL VTSEND ( 56 ) GOTO 20074 20073 CONTINUE IF (.NOT.( MODE .EQ. - 102 )) GOTO 20075 CALL VTSEND ( 99 ) GOTO 20076 20075 CONTINUE IF (.NOT.( MODE .EQ. - 104 )) GOTO 20077 CALL VTSEND ( 68 ) GOTO 20078 20077 CONTINUE IF (.NOT.( MODE .EQ. - 103 )) GOTO 20079 CALL VTSEND ( 77 ) GOTO 20080 20079 CONTINUE CALL VTSEND ( 91 ) CALL VTSEND ( 63 ) CALL VTSEND ( IABS ( MODE ) ) IF (.NOT.( MODE .GT. 0 )) GOTO 20081 CALL VTSEND ( 104 ) GOTO 20082 20081 CONTINUE CALL VTSEND ( 108 ) 20082 CONTINUE 20080 CONTINUE 20078 CONTINUE 20076 CONTINUE 20074 CONTINUE 20072 CONTINUE 20070 CONTINUE 20068 CONTINUE 20066 CONTINUE C 20063 CONTINUE 20058 CONTINUE 20056 CONTINUE 20054 CONTINUE 20052 CONTINUE CALL VTSEND ( 0 ) RETURN END C C$ VT1ATT - SET VT100 CHARACTER VIDIO ATTRIBUTES C (WORKS CORRECTLY ONLY IF ADVANCED VIDIO OPTION IS INSTALLED) C SUBROUTINE VT1ATT ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20083 CALL VTSEND ( 27 ) CALL VTSEND ( 91 ) CALL VTSEND ( MODE ) CALL VTSEND ( 109 ) CALL VTSEND ( 0 ) 20083 CONTINUE RETURN END C C$ VT1LED - CONTROL VT100 KEYBOARD LIGHTS. C SUBROUTINE VT1LED ( LIGHT ) C INTEGER LIGHT C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20085 CALL VTSEND ( 27 ) CALL VTSEND ( 91 ) CALL VTSEND ( LIGHT ) CALL VTSEND ( 113 ) CALL VTSEND ( 0 ) 20085 CONTINUE RETURN END C C$ VT1SIZ - CONTROL THE HEIGTH/WIDTH OF CURRENT LINE ON VT100. C SUBROUTINE VT1SIZ ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20087 CALL VTSEND ( 27 ) CALL VTSEND ( 35 ) CALL VTSEND ( MODE ) CALL VTSEND ( 0 ) 20087 CONTINUE RETURN END C C$ VT1SR - SPECIFY SIZE OF VT100 SCROLLING REGION. C SUBROUTINE VT1SR ( TOP, BOT ) C INTEGER TOP, BOT, SITOC, I, J LOGICAL * 1 BUF ( 4 ) C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 98 .AND. BOT .GT. TOP )) GOTO 20089 CALL VTSEND ( 27 ) CALL VTSEND ( 91 ) I = SITOC ( TOP, BUF, 3 ) J = 1 20091 IF (.NOT.( J .LE. I)) GOTO 20093 CALL VTSEND ( BUF ( J ) ) 20092 J = J + 1 GOTO 20091 20093 CONTINUE CALL VTSEND ( 59 ) I = SITOC ( BOT, BUF, 3 ) J = 1 20094 IF (.NOT.( J .LE. I)) GOTO 20096 CALL VTSEND ( BUF ( J ) ) 20095 J = J + 1 GOTO 20094 20096 CONTINUE CALL VTSEND ( 114 ) CALL VTSEND ( 0 ) 20089 CONTINUE RETURN END C C$ VT1TAB - SET/CLEAR TAB STOPS ON VT100. C SUBROUTINE VT1TAB ( MODE ) C INTEGER MODE C C FILE= CVTLIB.RAT FOR USE WITH VTLIB ROUTINES COMMON / CVTLIB / VTYPE, VTLUN INTEGER VTYPE INTEGER VTLUN C IF (.NOT.( VTYPE .EQ. - 98 )) GOTO 20097 CALL VTSEND ( 27 ) IF (.NOT.( MODE .EQ. 72 )) GOTO 20099 CALL VTSEND ( MODE ) GOTO 20100 20099 CONTINUE CALL VTSEND ( 91 ) CALL VTSEND ( MODE ) CALL VTSEND ( 103 ) 20100 CONTINUE CALL VTSEND ( 0 ) 20097 CONTINUE RETURN END