	SUBROUTINE DTERM(ISC,IX,IY,ARRAY1)
	LOGICAL * 1 ARRAY1(80),ARRAY2(80)
	DATA LUN /5/
	M = 1
	N = 0
   20	M = M + 1
	IF (M.GT.80) GO TO 40
	IF (ARRAY1(1).EQ.ARRAY1(M)) GO TO 40
	N = N + 1
	ARRAY2(N) = ARRAY1(M)
	GO TO 20
   40	CONTINUE
C
C	ARRAY TRANSFERRED, N CALCULATED
C	CALL DISP
C
	CALL DISP (ISC,IX,IY,N,ARRAY2,LUN)
	IF (ISC.GT.2.OR.ISC.EQ.0) RETURN
	I = IX + 1
	J = IY
	IF (ISC.LT.-2) CALL DISP(1,I,J,0,ARRAY2,LUN)
   60	CALL READEF(1,II)
	CALL READEF(2,JJ)
	LL=II*JJ
	IF (LL.EQ.0) GO TO 60
	RETURN
	END

	SUBROUTINE DISP(ISCT,IX,IY,NARRAY,ARRAY,LUNT)
	LOGICAL * 1   ESC,Y,ZERO,AT,IHOME,ARRAY(80),BUF(255,2)
	DIMENSION IPARM(6,2),IOSB(2,3),IEVF(3)
	DATA IBUF,ISTART,IHOME,IOCODE/1,0,1,"400/,N/1/,IEVF/1,2,3/
	DATA ESC,Y,ZERO,AT/"33,'Y','0','@'/
C
C	SET DEFAULT LUN TO TI:
C	RESET ISC'S THAT ARE GREATER THAN 100
C
	LUN = LUNT
	IF (LUN.LT.1.OR.LUN.GT.5) LUN = 5
	ISC = ISCT
	IF (ISC.GE.100) ISC = ISC - 100
C
C	CHECK TO SEE IF QUEING HAS BEEN INITIALIZED
C
	IF (ISTART.EQ.0) CALL LAUINI (IPARM,BUF,ISTART,LUN)
	IF (ISC.NE.(-2.OR.-1.OR.2)) GO TO 20
C
C	QUEUE PRESENT BUFFER OR INITIALIZE TERMINAL
C
	ILOC = 0
	GO TO 1000
   20	ILOC =  1
	IF (ISC.LT.40) GO TO 40
   	NDELTA = 6
	GO TO 60
   40	CONTINUE
C
C	NARRAY = LENGTH OF MESSAGE
C	7 = CHARACTERS NEEDED TO MOVE TO (X,Y) AND SET SCREEN
C
	NDELTA = NARRAY + 7
C
C	IF SPECIAL SCREEN, ADD 7 TO RESTORE SCREEN AFTER MESSAGE
C
	IF (ISC.GT.1) NDELTA = NDELTA + 7
   60	CONTINUE
C
C	SEE IF THERE IS ENOUGH ROOM IN PRESENT BUFFER FOR MESSAGE
	NEWN = N + NDELTA
	IF (NEWN.LT.250) GO TO 80
C
C	IF NOT, WRITE OUT OLD BUFFER
C
	GO TO 1000
   80	CONTINUE
C	MAKE SURE BUFFER IS READY
	CALL READEF (IBUF,IFLAG)
	IF (IFLAG.EQ.0) GO TO 80
C
C	FILL BUFFER
C
	IF (ISC.GE.40) GO TO 400
	I = IX + 31
	J = IY + 31
	IF (ISC.LE.1) GO TO 100
C
C	PRINT A NORMAL CHARACTER AFTER MESSAGE
C
	I = IX + 32 + NARRAY
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = Y
	N = N + 1
	BUF (N,IBUF) = J
	N = N + 1
	BUF (N,IBUF) = I
	N = N + 1
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = ZERO
	N = N + 1
	BUF (N,IBUF) = AT
	N = N + 1
	I = IX + 31
  100	CONTINUE
C
C	MOVE TO STARTING LOCATION
C
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = Y
	N = N + 1
	BUF (N,IBUF) = J
	N = N + 1
	BUF (N,IBUF) = I
	N = N + 1
	IF (ISC.NE.1) GO TO 105
	ILOC = 0
	GO TO 1000
  105	CONTINUE
	IF (ISC.LT.0) ISC = -ISC
C
C	SET SCREEN CODE
C
  	IF (ISC.EQ.0) GO TO 110		!NORMAL
	IF (ISC.EQ.10) ICODE = "103	!HALF BLINK
	IF (ISC.EQ.11) ICODE = "140	!UNDERLINE
	IF (ISC.EQ.12) ICODE = "143	!HALF UNDERLINE BLINK
	IF (ISC.EQ.13) ICODE = "102	!FULL BLINK
	IF (ISC.EQ.14) ICODE = "142	!FULL BLINK UNDERLINE
	IF (ISC.EQ.15) ICODE = "123	!HALF REVERSE BLINK
	IF (ISC.EQ.16) ICODE = "120	!REVERSE VIDEO
	IF (ISC.EQ.17) ICODE = "160	!REVERSE VIDEO, UNDERLINED
	IF (ISC.EQ.18) ICODE = "122	!REVERSE VIDEO, BLINK
	IF (ISC.EQ.19) ICODE = "162	!REVERSE VIDEO, BLINK, UNDERLINE
	IF (ISC.EQ.20) ICODE = "101	!HALF INTENSITY
	IF (ISC.EQ.21) ICODE = "121	!HALF INTENSITY, REVERSE VIDEO
	IF (ISC.EQ.22) ICODE = "161	!HALF INTENSITY, REVERSE VIDEO,
C					! AND UNDERLINED
	IF (ISC.EQ.23) ICODE = "163	!HALF INTENSITY, REVERSE VIDEO,
C					! BLINK, AND UNDERLINED
	IF (ISC.EQ.24) ICODE = "141	!HALF INTENSITY, UNDERLINED
	IF (ISC.EQ.25) ICODE = "104	!ZERO INTENSITY
	IF (ISC.EQ.26) ICODE = "124	!ZERO INTENSITY, REVERSE VIDEO
C
C	ADDITIONAL SCREEN CODES
C
C	-9 THRU -40	SET A SCREEN CODE CHARACTER AT (IX,IY)
C
C	-2		INITIALIZE A LUN
C
C	-1		QUEUE BUFFER
C
C	 1		MOVE TO A LOCATION, LEAVE CURSOR WHERE IT IS,
C				AND QUEUE BUFFER
C
C	 2		LEAVE CURSOR WHERE IT IS AND QUEUE BUFFER
C
C	40		ERASE SCREEN
C
C	41		ERASE THE REST OF IY STARTING AT IX
C
C	42		ERASE THE REST OF THE SCREEN STARTING AT IX,IY
C
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = ZERO
	N = N + 1
	BUF (N,IBUF) = ICODE
	N = N + 1
  110	CONTINUE
	IF (NARRAY.EQ.0) RETURN
C
C	PUT MESSAGE IN BUFFER
C
	DO 120 K = 1,NARRAY
	BUF (N,IBUF)  = ARRAY(K)
  120	N = N + 1
	RETURN
  400	CONTINUE
C
C	PERFORM SCREEN ERASE
C
C	MOVE TO STARTING LOCATION
C
	I = IX + 31
	J = IY + 31
	IF (ISC.NE.40) GO TO 420
	I = 32
	J = 32
  420	CONTINUE
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = Y
	N = N + 1
	BUF (N,IBUF) = J
	N = N + 1
	BUF (N,IBUF) = I
	N = N + 1
C
C	PERFORM ERASE
C
	BUF (N,IBUF) = ESC
	N = N + 1
	BUF (N,IBUF) = "153
	IF (ISC.EQ.41) BUF (N,IBUF) = 'K'
	N = N + 1
	RETURN
 1000	CONTINUE
C
C	SEE IF TERMINAL NEEDS TO BE INITIALIZED
C
	IF (ISC.GE.-1) GO TO 1020
C
C	IF SO; CALL LAUINI, THEN RETURN
C
	CALL LAUINI (IPARM,BUF,ISTART,LUN)
	RETURN
 1020	CONTINUE
C
C	MAKE SURE THERE IS SOMETHING IN THE BUFFER TO PRINT
C	AND THAT IT HAS NOT ALREADY BEEN QUEUED
C
	IF (N.EQ.1) RETURN
	CALL READEF(IBUF,IFLAG)
	IF (IFLAG.EQ.0) RETURN
C
C	RETURN CURSOR HOME
C
	BUF (N,IBUF) = IHOME
	IF(ISC.EQ.1.OR.ISC.EQ.2) N = N - 1
C
C	QUEUE REQUEST
C
	IPARM(2,IBUF) = N
	CALL QIO (IOCODE,LUN,IEVF(IBUF),10,IOSB(1,IBUF),IPARM(1,IBUF))
C
C	GET READY FOR NEXT MESSAGE
C
	N = 1
	IBUF = IBUF + 1
	IF (IBUF.GT.2) IBUF = 1
	IF (ILOC.EQ.1) GO TO 80
	RETURN
	END

	SUBROUTINE LAUINI (IPARM,BUF,ISTART,LUN)
	DIMENSION IPARM(6,2),IOSB(2),LPARM(6)
	LOGICAL * 1 LBUF(4),BUF(255,2)
C
C	CHECK TO SEE IF OUTPUT BUFFERS HAVE BEEN INITIALIZED
C
	IF (ISTART.EQ.1) GO TO 40
C
C	IF NOT, INITIALIZE THEM
C
	ISTART = 1
	DO 20 K = 1,2
	CALL GETADR (IPARM(1,K),BUF(1,K))
	CALL SETEF(K)
   20	IPARM(3,K) = 0
C
C	PREPARE TO INITIALIZE TERMINALS
C
 	LBUF (1) = 1
 	LBUF (2) = 255
	LBUF (3) = "24
	LBUF (4) = 0
 	CALL GETADR (LPARM(1),LBUF(1))
 	LPARM (2) = 4
 	CALL SETEF (4)
   40	CONTINUE
C
C	INITIALIZE TERMINAL
C	   1)	SET BUFFER TO 255 BYTES
C	   2)	ELIMINATE WRAP AROUND
C
 	CALL READEF(4,IFLAG)
 	IF (IFLAG.EQ.0) GO TO 40
 	CALL QIO ("2440,LUN,4,10,IOSB,LPARM)
	RETURN
	END

