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 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 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., ) CALL GETADR(DPB, CHARS) DPB(2) = 4 C GET TERMINAL SPEED AND TYPE CALL WTQIO(SFGMC, 5, 5, , , DPB) C TRUE IF >2400 BAUD QUIKUP = CHARS(2) .GT. S2400 C IF QUIKUP IS TRUE, SCREEN UPDATES C WILL OCCUR EVERY 1/2 SECOND; AT C SLOWER SPEEDS, EVERY 1 SECOND. IF (.NOT.(CHARS(4) .EQ. TV100)) GOTO 2080 TTYPE = VT100 GOTO 2090 2080 CONTINUE TTYPE = ADM3A 2090 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 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