C IDENT:
C
C	MODULE NAME  VTLIST.FOR
C	VERSION      X00-02
C	AUTHOR       REH
C	DATE CREATED ?
C
C REVISION:
C
C	NUMBER	2
C	AUTHOR	REH
C	DATE	7-JUL-77
C
C FUNCTION:
C
C	OUTPUTS A VT11 DISPLAY LIST TO LOGICAL UNIT 10
C	EXPECTS RT11 DISPLAY LIST FORMAT
C
C	CALLED BY
C		CALL VTLIST(IBUF,N)
C	WHERE	IBUF IS THE START OF THE LIST
C		N IS THE # OF LOC'NS TO BE LISTED
C		WILL NOT LIST BEYOND THE END OF THE DISPLAY LIST
C
C	EDIT1	CHANGES TO ACOMMEDATE NEW LIBRARY VT
C%EOH

	SUBROUTINE VTLIST(IBUF,N)
	INTEGER VMOD(2,12),VINT(2,8),VLP(2,2),VFL(2,2),VTYP(2,4),ON,
	1IFILL(14)
	INTEGER IBUF(1),IPNT(25,2),IPNT1(50),JMP,NOP,STSA,STSB,STOP
	EQUIVALENCE(IPNT(1,1),IPNT1(1))
	DATA LPT/10/,IPNT/50*0/
	DATA JMP/"10/,NOP/"11/,STSA/"12/,STSB/"13/,STOP/"14/
	CALL SCOPY('CHARSVCTLVCTPNT XGRAYGRARDOTJMP NOP STSASTSBSTOP
	1INT0INT1INT2INT3INT4INT5INT6INT7LPOFLPONFLOFFLONTYP1
	2TYP2TYP3TYP4',VMOD(1,1))
	IBEG=IADDR(IBUF(1))
	DO 5 I=1,50
	   IPNT1(I)=0
5	CONTINUE
	MODE=0
	ISUB=0
	IEND=0
	IEXT=0
	LOC=0
	ICNT=0
	IFILL(1)="40
8	IFIRST=-1
	GOTO 10
9	IFIRST=0
10	LOC=LOC+1
	LPNT=(LOC-1)*2
	ICNT=ICNT+1
	IF(ICNT.GT.N)GOTO 150
	ON=0
	ITEMP=IBUF(LOC)
	IF(IEXT)IFILL(1)="52
	IF(.NOT.IEXT)IFILL(1)="40
	IFILL(2)=LOC
	IFILL(3)=ITEMP
	NO=3
	IF(ISUB)GOTO 200		!SUBP MODE
	IF(ITEMP.AND."100000)GOTO 100	!NEW MODE WORD
	IF(ITEMP.AND."40000)ON=-1
	IF(MODE.LT.1.OR.MODE.GT.7)GOTO 140
	CALL SCOPY('    ',IFILL(4))
	NO=5
	IF(MODE.EQ.1)GOTO 20
	IF(ON)CALL SCOPY('  ON',IFILL(4))
	IF(.NOT.ON)CALL SCOPY(' OFF',IFILL(4))
20	GOTO(50,60,70,70,70,70,60)MODE
	GOTO 10
C
C  CHARACTER MODE
C
50	IFILL(4)=ITEMP		!CHAR
	WRITE(LPT,59)(IFILL(I),I=1,4)
59	FORMAT(1X,1A1,I6,2X,O6,4X,1A2)
	GOTO 10
C
C RDOT, SVECT
C
60	NO=7
	IFILL(6)=ITEMP/"200.AND."77
	IFILL(7)=ITEMP.AND."77
	IF(ITEMP.AND."20000)IFILL(6)=-IFILL(6)
	IF(ITEMP.AND."100)IFILL(7)=-IFILL(7)
65	WRITE(LPT,69)(IFILL(I),I=1,NO)
69	FORMAT(1X,1A1,I6,2X,O6,4X,2A2,2X,1I3,2X,1I3)
	GOTO 10
C
C LVECT, PNT, GRAPH
C
70	IF(.NOT.IFIRST)CALL SCOPY('    ',IFILL(4))
	IFILL(6)=ITEMP.AND."1777
	IF(ITEMP.AND."20000)IFILL(6)=-IFILL(6)
	WRITE(LPT,78)(IFILL(I),I=1,6)
78	FORMAT(1X,1A1,I6,2X,O6,4X,2A2,2X,1I5)
	IF(IFIRST)GOTO 9
	GOTO 8
C
100	ISUB=0
	ISAVE=MODE
	MODE=(ITEMP.AND."74000)/"4000.AND."17
	IF(MODE.GT.7)MODE=MODE-5
	IF(ITEMP.EQ."173400)MODE="13	!STOP
	MODE=MODE+1
	IFILL(4)=VMOD(1,MODE)
	IFILL(5)=VMOD(2,MODE)
	NO=5
	IF(MODE.LT.JMP)GOTO 105
	IF(MODE.EQ.JMP.OR. MODE.EQ.STOP)ISUB=1!PUT SUBP MODE
	MODE=ISAVE
	GOTO 140
105	IF(.NOT.(ITEMP.AND."100))GOTO 110	!LIGHT PEN
	LP=1
	IF(ITEMP.AND."40)LP=2
	NO=NO+1
	IFILL(NO)=VLP(1,LP)
	NO=NO+1
	IFILL(NO)=VLP(2,LP)
110	IF(.NOT.(ITEMP.AND."2000))GOTO 120	!INTENSITY
	INT=(ITEMP.AND."1600)/"200.AND."7
	INT=INT+1
	NO=NO+1
	IFILL(NO)=VINT(1,INT)
	NO=NO+1
	IFILL(NO)=VINT(2,INT)
120	IF(.NOT.(ITEMP.AND."20))GOTO 130	!FLASH
	IFL=1
	IF(ITEMP.AND."10)IFL=2
	NO=NO+1
	IFILL(NO)=VFL(1,IFL)
	NO=NO+1
	IFILL(NO)=VFL(2,IFL)
130	IF(.NOT.(ITEMP.AND."4))GOTO 140		!LINE TYPE
	ITYP=(ITEMP.AND."3)+1
	NO=NO+1
	IFILL(NO)=VTYP(1,ITYP)
	NO=NO+1
	IFILL(NO)=VTYP(2,ITYP)
140	WRITE(LPT,149)(IFILL(I),I=1,NO)
149	FORMAT(1X,1A1,I6,2X,O6,4X,2A2,1X,2A2,1X,2A2,1X,2A2,1X,2A2,1X,2A2)
	IF(.NOT.IEND)GOTO 10
150	CALL CLOSE(LPT)
	RETURN
C
200	GOTO(210,250,240,260,260)ISUB
210	IF(ITEMP)GOTO 220		!START OF SUBP
	   DO 202 IB=1,25		!END OF SUBP
	      IF(IPNT(IB,2).EQ.LPNT)GOTO 204	!FIND SUBP NO
202	   CONTINUE
	   IEND=-1			!MUST BE END OF LIST
	   NO=7
	   CALL SCOPY(' ENDLIST',IFILL(4))
	      GOTO 140
204	   IF(IPNT(IB,1).EQ.0)GOTO 206	!IGNORE ERASED SUBP
	      CALL SCOPY(' END',IFILL(4))
	      IFILL(6)=IPNT(IB,1)		!PRINT SUBP NO
205	      NO=6
206	   ISUB=0			!SUBP MODE FINISHED
	   IPNT(IB,1)=0			!CLEAR SUBP ARRAY
	   IPNT(IB,2)=0
	      GOTO 65
C
C  START OF NEW SUBP
C
220	IF(.NOT.IEXT)GOTO 222
	   IEXT=0			!GET BACK TO USER DISPLAY
	   LOC=(IBUF(LOC)-IBEG)/2
	   MODE=ISAVE
	   GOTO 253
222	DO 224 IB=1,25			!FIND SPACE IN ARRAY
	   IF(IPNT(IB,1).EQ.0)GOTO 228	!TO SAVE SUBP INFO
224	CONTINUE
	STOP'HUH?!#$%#"'		!CAN'T HAPPEN
228	IPNT(IB,2)=ITEMP-IBEG-2		!SUBP END PNTR
	   GOTO 253
240	IPNT(IB,1)=ITEMP		!SAVE SUBP NO
	IF(ITEMP.EQ.0)GOTO255		!ERASED SUBP
	CALL SCOPY('SUBP',IFILL(4))
	IFILL(6)=ITEMP
	NO=6
	   GOTO 255
250	IF(ITEMP.GT.4)GOTO 253
	   IEXT=-1
	   MODE=ISAVE			!DISPLAY LIST
	   LOCS=LOC
	   LOC=(IBUF(LOC-1)-IBEG)/2
	   IF(LOC.EQ.LOCS)IEXT=0
	IF(ITEMP.LT.4)GOTO 206
	CALL SCOPY('FIGR',IFILL(4))
	NO=5
	GOTO 206
253	IF(ITEMP)IFILL(3)=ITEMP-IBEG		!SUBT RELOCATION FACTOR
255	ISUB=ISUB+1
	   GOTO 65
260	ISUB=0				!END SUBP MODE
	   GOTO 140
	END