C ESCAPE CHARACTER C C********* TERMINAL CONTROL ROUTINES ************** C C A TERMINAL WITH CURSOR POSITIONING AND CLEAR SCREEN IS REQUIRED C MODIFY GTCHAR, TPOS, AND CLEAR FOR YOUR TERMINAL(S) C C NOV 1981 STEPHEN DOVER CHANGED GTCHAR TO SUPPORT C VT52 AN ISC TERMINALS. C C**************************************************** C C BY WILLIAM WOOD, SEPTEMBER 1980 C C TPOS - PUT CHARS IN BUF TO POSITION CURSOR AT IROW, ICOL C WPW 9/19/80 SUBROUTINE TPOS(IROW, ICOL) COMMON/CURSOR/TTYPE INTEGER TTYPE BYTE ADMV(2), VT100V(2), ISCV PARAMETER ADM3A = 1 PARAMETER VT100 = 2 PARAMETER ISC = 3 DATA ADMV/27, '='/ ! LOAD CURSOR CONTROL DATA VT100V/27, 'Y'/ ! DIRECT CURSOR CONTROL DATA ISCV/3/ ! DIRECT CURSOR CONTROL IF (TTYPE .NE. ADM3A) GOTO 2000 CALL OUTCH(ADMV, 2) CALL OUTCH(IROW + 31, 1) CALL OUTCH(ICOL + 31, 1) GOTO 2050 2000 CONTINUE IF (TTYPE .NE. VT100) GOTO 2020 CALL OUTCH(VT100V, 2) CALL OUTCH(IROW+31,1) CALL OUTCH(ICOL+31,1) GOTO 2050 2020 CONTINUE IF(TTYPE .NE. ISC) GOTO 2030 CALL OUTCH(ISCV,1) CALL OUTCH(ICOL-1,1) CALL OUTCH(IROW,1) 2030 CONTINUE 2050 CONTINUE RETURN END C CLEAR - CLEAR SCREEN AND POSTION TO ROW 1, COLUMN 1 C WPW 9/19/80 SUBROUTINE CLEAR BYTE ADMCLR(3), VTCLR(4), ISCCLR, ISCCLN COMMON/CURSOR/TTYPE INTEGER TTYPE PARAMETER ADM3A = 1 PARAMETER VT100 = 2 PARAMETER ISC = 3 DATA ADMCLR/27, ';', 26/ ! CLEAR UNPROTECT TO SPACES AND SUBSTITUTE DATA VTCLR/27, 'H', 27, 'J'/ ! CURSOR HOME AND CLEAR TO END OF SCREEN DATA ISCCLR/12./ ! CURSOR HOME AND ERASE PAGE DATA ISCCLN/11./ ! CLEAR AN ISC LINE IF (TTYPE .NE. ADM3A) GOTO 2060 CALL OUTCH(ADMCLR, 3) GOTO 2090 2060 CONTINUE IF (TTYPE .NE. VT100) GOTO 2070 CALL OUTCH(VTCLR, 4) GOTO 2090 2070 CONTINUE IF(TTYPE .NE. ISC) GOTO 2080 CALL OUTCH(ISCCLR,1) 2080 CONTINUE 2090 CONTINUE RETURN C C CLEAR FROM CURSOR POSITION TO END OF SCREEN C ENTRY CLRLNS(IROW,ICOL) CALL TPOS(IROW,ICOL) IF(TTYPE .NE. ADM3A) GOTO 3040 CALL OUTCH(ADMCLR,2) GOTO 3080 3040 CONTINUE IF(TTYPE .NE. VT100) GOTO 3060 CALL OUTCH(VTCLR(3),2) GOTO 3080 3060 CONTINUE IF(TTYPE .NE. ISC) GOTO 3090 CALL OUTCH(ISCCLN,1) 3080 CONTINUE CALL OUTCH(0,0) 3090 CONTINUE RETURN END C ASCII "0" SUBROUTINE DECOUT(N) BYTE OT(6) IF (N .GE. 10) GOTO 2100 CALL OUTCH(N + 48, 1) GOTO 2110 2100 CONTINUE OT(1) = N/10 + 48 OT(2) = MOD(N, 10) + 48 CALL OUTCH(OT, 2) 2110 CONTINUE RETURN END C GTCHAR - GET TERMINAL CHARACTERISTICS: SPEED AND TYPE C C NOTE: IN ORDER FOR ADM3 AND ISC ( OR ANY UNKNOWN TERMINAL TYPE C TO BE USED) TO WORK, YOU MUST SET THE TERMINAL TYPE C IN SOME STARTUP FILE. C SET /TERM=TTNN:310 ; FOR ADM3A C SET /TERM=TTNN:311 ; FOR ISC C IF THESE NUMBERS CONFLICT WITH CURRENT SOFTWARE, ANY NUMBER CAN C BE USED BETWEEN 200-377 AS LONG AS THIS MODULE MATCHES YOUR C SETTINGS. C WPW 9/19/80 SUBROUTINE GTCHAR(QUIKUP) LOGICAL QUIKUP INTEGER DPB(6) BYTE CHARS(4) EQUIVALENCE(CHARS, IC) COMMON/CURSOR/TTYPE INTEGER TTYPE PARAMETER ADM3A = 1 PARAMETER VT100 = 2 PARAMETER ISC = 3 PARAMETER TCXSP = "4 PARAMETER SFGMC = "2560 PARAMETER S2400 = "16 PARAMETER TCTTP = "10 PARAMETER TV100 = "15 ! VT100 TERMINAL TYPE PARAMETER TVT52 = "11 ! VT52 TERMINAL TYPE PARAMETER TADM3 = -54 ! ADM3A TERMINAL TYPE (OCTAL 310) PARAMETER TISC = -55 ! ISC TERMINAL TYPE (OCTAL 311) DATA CHARS/TCXSP, 0, TCTTP, 0/ CALL ERRSET(63, .TRUE., .FALSE., .TRUE., .FALSE., ) ! OUTPUT CONVERSION CALL ERRSET(64, .TRUE., .FALSE., .TRUE., .FALSE., ) ! INPUT CONVERSION CALL ERRSET(68, .TRUE., .FALSE., .TRUE., .FALSE., ) ! VARIABLE FORMAT CALL GETADR(DPB, CHARS) DPB(2) = 4 CALL WTQIO(SFGMC, 1, 5, , , DPB) ! GET TERMINAL SPEED AND TYPE QUIKUP = CHARS(2) .GT. S2400 ! IF TRUE THEN GREATER THAN 2400 BAUD C IF QUIKUP IS TRUE, SCREEN UPDATES C WILL OCCUR EVERY 1/2 SECOND; AT C SLOWER SPEEDS, EVERY 1 SECOND. IF (CHARS(4) .NE. TV100 .AND. CHARS(4) .NE. TVT52) GOTO 2080 TTYPE = VT100 GOTO 4000 2080 CONTINUE IF (CHARS(4) .NE. TADM3) GOTO 2090 TTYPE = ADM3A GOTO 4000 2090 CONTINUE IF (CHARS(4) .NE. TISC) GOTO 4000 TTYPE = ISC 4000 CONTINUE RETURN END