C ESCAPE CHARACTER C C********* TERMINAL CONTROL ROUTINES ************** C C A TERMINAL WITH CURSOR POSITIONING AND CLEAR SCREEN IS REQUIRED C C MODIFY GTCHAR, TPOS, AND CLEAR FOR YOUR TERMINAL(S) 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) PARAMETER ADM3A = 1 PARAMETER VT100 = 2 DATA ADMV/27, '='/ DATA VT100V/27, '['/ IF (.NOT.(TTYPE .EQ. ADM3A)) GOTO 2000 CALL OUTCH(ADMV, 2) CALL OUTCH(IROW + 31, 1) CALL OUTCH(ICOL + 31, 1) GOTO 2010 2000 CONTINUE IF (.NOT.(TTYPE .EQ. VT100)) GOTO 2020 CALL OUTCH(VT100V, 2) CALL DECOUT(IROW) CALL OUTCH(';', 1) CALL DECOUT(ICOL) CALL OUTCH('H', 1) 2020 CONTINUE 2010 CONTINUE RETURN END C CLEAR - CLEAR SCREEN AND POSTION TO ROW 1, COLUMN 1 C WPW 9/19/80 SUBROUTINE CLEAR BYTE ADMCLR(3) BYTE VTCLR(7) COMMON/CURSOR/TTYPE INTEGER TTYPE PARAMETER ADM3A = 1 PARAMETER VT100 = 2 DATA ADMCLR/27, ';', 26/ DATA VTCLR/27, '[', '2', 'J', 27, '[', 'H'/ IF (.NOT.(TTYPE .EQ. ADM3A)) GOTO 2040 CALL OUTCH(ADMCLR, 3) GOTO 2050 2040 CONTINUE IF (.NOT.(TTYPE .EQ. VT100)) GOTO 2060 CALL OUTCH(VTCLR, 7) 2060 CONTINUE 2050 CONTINUE RETURN END C FLASH SCREEN SUBROUTINE FLASH(NRPT, IDUR, IUNITS) C FLASH SCREEN TO REVERSE VIDEO "NRPT" TIMES. C FLASH DURATION IS "IDUR" "IUNITS" LONG. C "IUNITS" = 1 FOR MILLISECONDS, 2 FOR SECONDS DO 2080 I = 1, NRPT CALL REVVID CALL FLUSH(0) CALL WAIT(IDUR, IUNITS) CALL NRMVID CALL FLUSH(0) CALL WAIT(IDUR, IUNITS) 2080 CONTINUE 2090 CONTINUE RETURN END C SET REVERSE VIDEO C GSW 3/82 SUBROUTINE REVVID BYTE VTREV(5) INTEGER TTYPE COMMON/CURSOR/TTYPE PARAMETER ADM3A = 1 PARAMETER VT100 = 2 DATA VTREV/27, '[', '?', '5', 'h'/ IF (.NOT.(TTYPE .EQ. VT100)) GOTO 2100 CALL OUTCH(VTREV, 5) 2100 CONTINUE RETURN END C SET NORMAL VIDEO C GSW 3/82 SUBROUTINE NRMVID BYTE VTNRM(5) INTEGER TTYPE COMMON/CURSOR/TTYPE PARAMETER ADM3A = 1 PARAMETER VT100 = 2 DATA VTNRM/27, '[', '?', '5', 'l'/ IF (.NOT.(TTYPE .EQ. VT100)) GOTO 2120 CALL OUTCH(VTNRM, 5) 2120 CONTINUE RETURN END C GTCHAR - GET TERMINAL CHARACTERISTICS: SPEED AND TYPE 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 TCXSP = "4 PARAMETER SFGMC = "2560 PARAMETER S2400 = "16 PARAMETER TCTTP = "10 PARAMETER TV100 = "15 PARAMETER SFSMC = "2440 PARAMETER TCFDX = "64, TCRAT = "7 PARAMETER ATTACH = "1400 BYTE SETBUF(4) DATA SETBUF/TCFDX, 1, TCRAT, 1/ DATA CHARS/TCXSP, 0, TCTTP, 0/ C OUTPUT CONVERSION ERROR CALL ERRSET(63, .TRUE., .FALSE., .TRUE., .FALSE., ) C INPUT CONVERSION ERROR CALL ERRSET(64, .TRUE., .FALSE., .TRUE., .FALSE., ) C ATTACH TERMINAL CALL WTQIO(ATTACH, 5, 5) C SET FULL DUPLEX & ENABLE TYPE-AHEAD CALL GETADR(DPB, SETBUF) DPB(2) = 4 CALL WTQIO(SFSMC, 5, 5, , , DPB) CALL GETADR(DPB, CHARS) DPB(2) = 4 C GET TERMINAL SPEED AND TYPE CALL WTQIO(SFGMC, 5, 5, , , DPB) C TRUE IF >2400 BAUD c QUIKUP = CHARS(2) .GT. S2400 QUIKUP = .true. C IF QUIKUP IS TRUE, SCREEN UPDATES C WILL OCCUR EVERY 1/2 SECOND; AT C SLOWER SPEEDS, EVERY 1 SECOND. c IF (.NOT.(CHARS(4) .EQ. TV100)) GOTO 2140 TTYPE = VT100 c GOTO 2150 c2140 CONTINUE c TTYPE = ADM3A c2150 CONTINUE RETURN END C ASCII "0" SUBROUTINE DECOUT(N) BYTE OT(6) CNN = N CIP = 6 CREPEAT [ C OT(IP) = MOD(NN,10)+DIG0 C NN = NN/10 C IP = IP-1 C ] UNTIL (NN == 0) CCALL OUTCH(OT(IP+1),6-IP) IF (.NOT.(N .LT. 10)) GOTO 2160 CALL OUTCH(N + 48, 1) GOTO 2170 2160 CONTINUE OT(1) = N/10 + 48 OT(2) = MOD(N, 10) + 48 CALL OUTCH(OT, 2) 2170 CONTINUE RETURN END