C..   CRTLIB.FTN     BOHDEN K. CMAYLO    NOV 1981
C..
C..  ROUTINES FOR CRT* AND ESCSEQ
C..
	SUBROUTINE CRTINI
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
	BYTE ESC,CR,LF,TAB,ARRAY
	DOUBLE PRECISION TYPE,TYPES(10)
	EQUIVALENCE (TYPE,ARRAY)
	DATA NTYPES,TYPES/5,'VT52','HP','TV9','VT100',
     1 6*'OTHER'/
	DATA IPR,ESC,CR,LF,TAB/5,"33,"15,"12,"11/
C..
	DATA IN,INREAD,INWRIT,INATT,INESC
     1 /'TI',"1000,"400,"1400,"20/
C..
C..	SET UP UNIT AND ATTACHMENT
C..
	CALL ASNLUN(IPR,IN,0,IDS)
	CALL WTQIO(INATT,IPR,6,50,IST,IR,IDS)
	CALL GETADR(IR,ARRAY)
C..
C..	GET WHAT TYPE
C..
	LOOP=0
33	LOOP=LOOP+1
	CALL PROMPT(' ENTER TERMINAL TYPE =',IQ,ARRAY)
	IF(IQ.LT.0) GO TO 91
C..
	CALL CAPS(ARRAY,IQ)
	DO 1 I=1,NTYPES
	IF(TYPE.EQ.TYPES(I)) GO TO 2
1	CONTINUE
	IF(LOOP.NE.1) GO TO 32
	TYPE 31,(TYPES(II),II=1,NTYPES)
31	FORMAT('0*** NOTE *** VALID TYPES ARE:',10(/1X,A8))
	GO TO 33
32	I=NTYPES
2	INTERM=I
	CALL CRTCLR(0)
	CALL CRTWRT(20,1,'*** TERMINAL TYPE IS         ***.')
	TYPES(I+1)=' ***..'
	CALL CRTWRT(20,22,TYPES(I))
C..	SET VT100 SAME AS VT52
	IF(I.EQ.4) INTERM=1
C..	RESET OTHER 
	IF(I.EQ.NTYPES) INTERM=NTYPES-1
	RETURN
91	TYPE 191
191	FORMAT('0*** END OF FILE READ *** STOP ***')
	CALL EXIT
	END
	SUBROUTINE CRTCLR(INX)
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
	BYTE ESC,CR,LF,TAB,ARRAY
C..
C..	POSITION AT PLACE TO CLEAR
C..
	CALL CRTPOS(INX,0)
C..
C..	CLEAR SCREEN
C..
	GO TO (21,21,23,24,25)INTERM
C..	VT52, HP
21	CONTINUE
	CALL ESCSEQ(1,ARRAY,IR(2))
	GO TO 20
C..	TV9
23	CONTINUE
	CALL ESCSEQ(2,ARRAY,IR(2))
	GO TO 20
24	CONTINUE
25	CONTINUE
	RETURN
20	CONTINUE
	CALL WTQIO(INWRIT,IPR,6,50,IST,IR,IDS)
	RETURN
	END
	SUBROUTINE CRTPOS(INXX,INYY)
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
C..
	BYTE ESC,CR,LF,TAB,ARRAY
C..
C..	GO TO CORRECT ESCAPE SEQUENCE BUILDING
C..
	INTYPE=0
	INX=INXX
	INY=INYY
	IF(INX.LT.0) INX=-INX
	IF(INY.LT.0) INY=-INY
	GO TO (11,12,13,14,15)INTERM
C..	VT52
11	CALL ESCSEQ(3,ARRAY,INTYPE)
130	ARRAY(3)="40+INX
	ARRAY(4)="40+INY
	GO TO 10
C..	HP
12	CONTINUE
	CALL ESCSEQ(4,ARRAY,INTYPE)
	ARRAY(4)=INX/10+"60
	ARRAY(5)=INX-(INX/10)*10+"60
	ARRAY(7)=INY/10+"60
	ARRAY(8)=INY-(INY/10)*10+"60
	GO TO 10
C..	TV9
13	CALL ESCSEQ(7,ARRAY,INTYPE)
	GO TO 130
14	CONTINUE
15	CONTINUE
	RETURN
C..
C..	WRITE OUT ON TERMINAL
C..
10	CONTINUE
	IR(2)=INTYPE
	CALL WTQIO(INWRIT,IPR,6,50,IST,IR,IDS)
	RETURN
	END
	SUBROUTINE CRTWRT(INX,INY,STRING)
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
C..
	BYTE STRING(1)
C..
	BYTE ESC,CR,LF,TAB,ARRAY
C..	GET LENGTH OF STRING
C..
	DO 9 LL=1,132
	IF(STRING(LL).EQ.'?'.OR.STRING(LL).EQ.'=') GO TO 99
	IF(STRING(LL).EQ.0) GO TO 99
	IF(STRING(LL).EQ.'.'.AND.STRING(LL+1).EQ.'.') GO TO 99
9	CONTINUE
	LL=133
99	IF(STRING(LL).EQ.0) LL=LL-1
C..
C..	GO TO CORRECT ESCAPE SEQUENCE BUILDING
C..
	INTYPE=0
	CALL CRTPOS(INX,INY)
	GO TO (11,11,13,14,15)INTERM
C..	VT52
11	CALL ESCSEQ(5,ARRAY,INTYPE)
	GO TO 10
C..	TV9
13	CONTINUE
	CALL ESCSEQ(6,ARRAY,INTYPE)
	GO TO 10
14	CONTINUE
15	CONTINUE
	IF(LL.NE.0) INTYPE=1
	ARRAY(1)=LF
C..
C..	TRANSFER DATA PLUS WRITE OUT ON TERMINAL
C..
10	CONTINUE
	IF(LL.NE.0) CALL BYTEDO(ARRAY(INTYPE+1),ARRAY(INTYPE+LL),STRING)
	LL=INTYPE+LL+1
	ARRAY(LL)=CR
	IR(2)=LL
	CALL WTQIO(INWRIT,IPR,6,50,IST,IR,IDS)
	RETURN
	END
	SUBROUTINE CRTRED(INCHAR,INLEN,IACT,ISPEC)
C..
C..	SPECIAL CONDITIONS
C..
C..	ISPEC=-1=EOF
C..	ISPEC= 0=NO DATA 
C..	ISPEC= 1=DATA+CR 
C..	ISPEC= 2=DATA+ESC
C..	ISPEC= 3=DATA+TAB
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
C..
	BYTE ESC,CR,LF,TAB,ARRAY,INCHAR(INLEN)
C..
C..
	BYTE SUCC(2)
	EQUIVALENCE (SUCC,IST(1))
C..
C..	READ IN ALL CHARACTERS
C..
	IR(2)=INLEN
	CALL WTQIO(INREAD,IPR,6,50,IST,IR,IDS)
	IACT=IST(2)
C**	TYPE 44,SUCC,IACT
C**44	FORMAT(' SUCC=',O4,1X,O4,'  IACT=',O7)
	IF(IACT.NE.0) CALL BYTEDO(INCHAR(1),INCHAR(IACT),ARRAY)
	IF(IACT.LT.INLEN) CALL DOBYTE(INCHAR(IACT+1),INCHAR(INLEN),' ')
C..
C.	CHECK OUT SPECIAL TERMINATORS
C..
	ISPEC=0
	IF(SUCC(2).EQ.CR) ISPEC=1
	IF(SUCC(2).EQ.ESC) ISPEC=2
C..TAB KEY
	IF(INCHAR(1).EQ.'!'.AND.IACT.EQ.1) ISPEC=3
	IF(ISPEC.EQ.0.AND.SUCC(1).NE.1) ISPEC=-1
	RETURN
	END
	SUBROUTINE CRTYN(INX,INY,MSG,IYESNO)
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB,ARRAY(144)
     2 ,IPR,IN,INREAD,INWRIT,INATT,INESC
     3 ,IST(2),IR(6)
C..
	BYTE ESC,CR,LF,TAB,ARRAY,MSG(IYESNO)
C..
C..
	BYTE SUCC(2)
	EQUIVALENCE (SUCC,IST(1))
C..
C..	WRITE OUT MSG 
C..
1	CALL CRTWRT(INX,INY,MSG)
C..
C..	READ IN ONE CHARACTER Y/CR OR N
C..
	IR(2)=1
	CALL WTQIO(INREAD,IPR,6,50,IST,IR,IDS)
	IACT=IST(2)
C..
C.	CHECK OUT IF YES/NO
C..
	IYESNO=-1
C..	CHECK FOR EOF
	IF(SUCC(1).EQ.0) RETURN
C..	CHECK FOR Yy/Nn
	IF(ARRAY(1).EQ.'N'.OR.ARRAY(1).EQ.'n') IYESNO=0
	IF(ARRAY(1).EQ.'Y'.OR.ARRAY(1).EQ.'y') IYESNO=1
C..	CHECK FOR CR(DEFAULT)
	IF(IACT.EQ.0.AND.SUCC(2).EQ.CR) IYESNO=2
C..	CHECK IF Y/N INPUTTED
	IF(IYESNO.EQ.-1) GO TO 1
	RETURN
	END
	SUBROUTINE CRTERR(INPUT,KINPUT,MSG)
	BYTE BELL,IPER,INPUT(80),MSG(80)
	DATA BELL,IPER/7,'.'/
	DO 10 KMSG=1,80
	IF(MSG(KMSG).EQ.IPER) GO TO 11
10	CONTINUE
	KMSG=24
11	CONTINUE
	CALL CRTPOS(20,1)
	TYPE 1,BELL,(MSG(I),I=1,KMSG)
1	FORMAT('0*** ERROR *** ',80A1)
	IF(KINPUT.LE.0) RETURN
	TYPE 2,(INPUT(I),I=1,KINPUT)
2	FORMAT(' DATA:',80A1)
	RETURN
	END
	SUBROUTINE ESCSEQ(NUMESC,ARRAY,LENESC)
C..
	COMMON /XCURSE/INTERM
     1 ,ESC,CR,LF,TAB
	BYTE ESC,CR,LF,TAB,ARRAY(LENESC),LENGTH(7)
	DATA LENGTH/2,2,4,9,2,2,4/
C..
C..	GO TO ESCAPE SEQUENCE
C..
	ARRAY(1)=ESC
	LENESC=LENGTH(NUMESC)
	GO TO (1,2,3,4,5,6,7) NUMESC
	TYPE 99
99	FORMAT('0*** ERROR *** ESCSEQ *** ESCAPE SEQUENCE ***')
	STOP
1	ARRAY(2)='J'
	RETURN
2	ARRAY(2)='Y'
	RETURN
3	ARRAY(2)='Y'
 	ARRAY(3)=0
	ARRAY(4)=0
	RETURN
4	ARRAY(2)='&'
	ARRAY(3)='a'
	ARRAY(4)=0
	ARRAY(5)=0
	ARRAY(6)='y'
	ARRAY(7)=0
	ARRAY(8)=0
	ARRAY(9)='C'
	RETURN
5	ARRAY(2)='K'
	RETURN
6	ARRAY(2)='T'
	RETURN
7	ARRAY(2)='='
	ARRAY(3)=0
	ARRAY(4)=0
	RETURN
	END