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)
C VAXINATED 11/19/80
      IMPLICIT INTEGER(A - Z)
      LOGICAL QUIKUP
      INTEGER*2PRILEN
      CHARACTER*100 PRIBUF
      BYTE INFO(8), IOSB(8)
      COMMON/IOBUFR/ICHNL
      COMMON/CURSOR/TTYPE
      INTEGER TTYPE
      EXTERNAL IO$_SENSEMODE, TT$C_BAUD_2400
      PARAMETER ADM3A = 1
      PARAMETER VT100 = 2
C OUTPUT CONVERSION ERROR
      CALL ERRSET(63, .TRUE., .FALSE., .TRUE., .FALSE., )
C INPUT CONVERSION ERROR
      CALL ERRSET(64, .TRUE., .FALSE., .TRUE., .FALSE., )
      CALL IOINIT
      CALL SYS$GETCHN(%VAL(ICHNL), PRILEN, PRIBUF, , )
      I = ICHAR(PRIBUF(6:6))
      IF (.NOT.(I .EQ. 96)) GOTO 2080
        TTYPE = VT100
        GOTO 2090
2080   CONTINUE
        TTYPE = ADM3A
C
C IF QUIKUP IS TRUE, SCREEN UPDATES
C WILL OCCUR EVERY 1/2 SECOND; AT
C SLOWER SPEEDS, EVERY 1 SECOND.
C QUICKUP SHOULD BE SET TRUE AT SPEEDS OVER 2400 BAUD.
C
2090  CONTINUE
	I = SYS$QIOW( , %VAL(ICHNL), %VAL(%LOC(IO$_SENSEMODE)), IOSB,
     *                , , INFO, %VAL(8), , , , )
C$ WRITE(5,(20I10))I, IOSB, %LOC(TT$C_BAUD_2400)
      IF (.NOT.(IOSB(3) .GT. %LOC(TT$C_BAUD_2400))) GOTO 2100
        QUIKUP = .TRUE.
        GOTO 2110
2100   CONTINUE
        QUIKUP = .FALSE.
2110  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 2120
        CALL OUTCH(N + 48, 1)
        GOTO 2130
2120   CONTINUE
        OT(1) = N/10 + 48
        OT(2) = MOD(N, 10) + 48
        CALL OUTCH(OT, 2)
2130  CONTINUE
      RETURN
      END