DEFINE(ESCAPE,27)				# ESCAPE CHARACTER
#
#*********  TERMINAL CONTROL ROUTINES  **************
#
#  A TERMINAL WITH CURSOR POSITIONING AND CLEAR SCREEN IS REQUIRED
#
#  MODIFY GTCHAR, TPOS, AND CLEAR FOR YOUR TERMINAL(S)
#
#****************************************************
#
#  BY WILLIAM WOOD, SEPTEMBER 1980
#
# TPOS - PUT CHARS IN BUF TO POSITION CURSOR AT IROW, ICOL
SUBROUTINE TPOS(IROW, ICOL)			# WPW 9/19/80
COMMON/CURSOR/ TTYPE
INTEGER TTYPE
BYTE ADMV(2), VT100V(2)
PARAMETER ADM3A = 1
PARAMETER VT100 = 2
DATA ADMV /ESCAPE,
           '='/
DATA VT100V /ESCAPE,
             '['/
 
IF (TTYPE == ADM3A) [
  CALL OUTCH(ADMV, 2)
  CALL OUTCH(IROW + 31,1)
  CALL OUTCH(ICOL + 31,1)
  ]
ELSE IF (TTYPE == VT100) [
  CALL OUTCH(VT100V, 2)
  CALL DECOUT(IROW)
  CALL OUTCH(';',1)
  CALL DECOUT(ICOL)
  CALL OUTCH('H',1)
  ]
RETURN
END
 
# CLEAR - CLEAR SCREEN AND POSTION TO ROW 1, COLUMN 1
SUBROUTINE CLEAR					# WPW 9/19/80
BYTE ADMCLR(3)
BYTE VTCLR(7)
COMMON/CURSOR/ TTYPE
INTEGER TTYPE
PARAMETER ADM3A = 1
PARAMETER VT100 = 2
DATA ADMCLR/ESCAPE,
            ';',
            26/
DATA VTCLR/ESCAPE, '[', '2', 'J', 
  	   ESCAPE, '[', 'H'/
 
IF (TTYPE == ADM3A)
  CALL OUTCH(ADMCLR,3)
ELSE IF (TTYPE == VT100)
  CALL OUTCH(VTCLR,7)
RETURN
END
 
# GTCHAR - GET TERMINAL CHARACTERISTICS: SPEED AND TYPE
SUBROUTINE GTCHAR(QUIKUP)				# WPW 9/19/80
							# VAXINATED 11/19/80
IMPLICIT INTEGER (A - Z)
LOGICAL QUIKUP
INTEGER*2 PRILEN
%
      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

CALL ERRSET(63,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)	# OUTPUT CONVERSION ERROR
CALL ERRSET(64,.TRUE.,.FALSE.,.TRUE.,.FALSE.,)	# INPUT CONVERSION ERROR
CALL IOINIT
 
CALL SYS$GETCHN(%VAL(ICHNL), PRILEN, PRIBUF, , )
I = ICHAR(PRIBUF(6:6))
IF (I == 96)
  TTYPE = VT100
ELSE
  TTYPE = ADM3A
 
#
# IF QUIKUP IS TRUE, SCREEN UPDATES
# WILL OCCUR EVERY 1/2 SECOND; AT
# SLOWER SPEEDS, EVERY 1 SECOND.
# QUICKUP SHOULD BE SET TRUE AT SPEEDS OVER 2400 BAUD.
#
%
	I = SYS$QIOW( , %VAL(ICHNL), %VAL(%LOC(IO$_SENSEMODE)), IOSB,
     *                , , INFO, %VAL(8), , , , )
%
#$ WRITE(5,(20I10))I, IOSB, %LOC(TT$C_BAUD_2400)
IF (IOSB(3) > %LOC(TT$C_BAUD_2400))
  QUIKUP = .TRUE.
ELSE
  QUIKUP = .FALSE.
RETURN
END

DEFINE(DIG0,48)					# ASCII "0"
SUBROUTINE DECOUT(N)
BYTE OT(6)

#NN = N
#IP = 6
#REPEAT [
#  OT(IP) = MOD(NN,10)+DIG0
#  NN = NN/10
#  IP = IP-1
#  ] UNTIL (NN == 0)
#CALL OUTCH(OT(IP+1),6-IP)
IF (N < 10)
  CALL OUTCH(N+DIG0,1)
ELSE [
  OT(1) = N/10+DIG0
  OT(2) = MOD(N,10)+DIG0
  CALL OUTCH(OT,2)
  ]
RETURN
END