#
#*********  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 /"33,
           '='/
DATA VT100V /"33,
             '['/
 
IF (TTYPE == ADM3A) [
  CALL OUTCH(ADMV, 2)
  CALL OUTCH(IROW + "37,1)
  CALL OUTCH(ICOL + "37,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/"33,
            ';',
            "32/
DATA VTCLR/"33, '[', '2', 'J', 
  	   "33, '[', '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(REC96)				# WPW 9/19/80
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
CALL WTQIO(SFGMC,5,5,,,DPB)		# GET TERMINAL SPEED AND TYPE
REC96 = CHARS(2) == S9600		# TRUE IF 9600 BAUD
					# IF REC96 IS TRUE, SCREEN UPDATES
					# WILL OCCUR EVERY 1/2 SECOND; AT
					# SLOWER SPEEDS, EVERY 1 SECOND.
 
IF (CHARS(4) == TV100)
  TTYPE = VT100
ELSE
  TTYPE = ADM3A
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)
RETURN
END