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/"33, '='/
      DATA VT100V/"33, '['/
      IF (.NOT.(TTYPE .EQ. ADM3A)) GOTO 2000
        CALL OUTCH(ADMV, 2)
        CALL OUTCH(IROW + "37, 1)
        CALL OUTCH(ICOL + "37, 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/"33, ';', "32/
      DATA VTCLR/"33, '[', '2', 'J', "33, '[', '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(REC96)
      LOGICAL REC96
      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 S9600 = "22
      PARAMETER TCTTP = "10
      PARAMETER TV100 = "15
      DATA CHARS/TCXSP, 0, TCTTP, 0/
      CALL GETADR(DPB, CHARS)
      DPB(2) = 4
C GET TERMINAL SPEED AND TYPE
      CALL WTQIO(SFGMC, 5, 5, , , DPB)
C TRUE IF 9600 BAUD
      REC96 = CHARS(2) .EQ. S9600
C IF REC96 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)
      NN = N
      IP = 6
2100  CONTINUE
        OT(IP) = MOD(NN, 10) + 48
        NN = NN/10
        IP = IP - 1
2110    IF (.NOT.(NN .EQ. 0)) GOTO 2100
2120  CONTINUE
      CALL OUTCH(OT(IP + 1), 6 - IP)
      RETURN
      END