C
C----------SUBROUTINE--ADEIN-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ADEIN(NCHAR,IARAY)
      DIMENSION IARAY(132)
      DATA ICHAR /' '/
      READ (5,10) IARAY
   10 FORMAT(132A1)
      NCHAR=0
      DO 20 I=1,132
      IF(IARAY(I).NE.ICHAR)NCHAR=I
   20 IARAY(I)=IARAY(I)-8192
      RETURN
      END
C
C----------SUBROUTINE--AINST-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE AINST(NCHAR,IAM)
      DIMENSION IADE(132),IAM(1)
      DATA MAXLEN/132/
      LEN=NCHAR
      IF(LEN .GT. MAXLEN)LEN=MAXLEN
      CALL TINSTR(LEN,IADE)
      CALL KAS2AM(LEN,IADE,IAM)
      RETURN
      END
C
C----------SUBROUTINE--ALFMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ALFMOD
	INCLUDE 'COMMON.FOR'
C * SET ALPHA MODE OUTPUT (US)
      CALL TOUTPT(31)
      KGRAFL=0
      KKMODE=0
      IF(KBEAMY.GT.KHOMEY) KBEAMY=KHOMEY
      RETURN
      END
C
C----------SUBROUTINE--ANCHO-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ANCHO(ICHAR)
	INCLUDE 'COMMON.FOR'
      IF(KKMODE.EQ.0)GO TO 10
      CALL ALFMOD
   10 KBEAMX=KBEAMX+(KHORSZ+KFACTR/2)/KFACTR
      IF(KBEAMX.LT.KRMRGN)GO TO 20
      CALL NEWLIN
   20 CALL TOUTPT(ICHAR)
C * ROUND NON-INTEGER CHARACTER WIDTH IN 1023 CO-ORDINATES
      RETURN
      END
C
C----------SUBROUTINE--ANMODE------------------------TEKTRONIX, INC.----
C
C      SUBROUTINE ANMODE
C * ENTER ALPHA-NUMERIC MODE
C      CALL ALFMOD
C * DUMP THE OUTPUT BUFFER
C      CALL TSEND
C      RETURN
C      END
C
C----------SUBROUTINE--ANSTR-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ANSTR(NCHAR,IADE)
	INCLUDE 'COMMON.FOR'
      DIMENSION IADE(1)
      DATA MAXLEN/132/
      IPT=1
C * PLACE THE TERMINAL IN A/N MODE, IF NEEDED
      IF(KKMODE .NE. 0)CALL ALFMOD
C * GET A NEWLINE WHEN THE BEAM POSITION IS OUTSIDE MARGINS
      IF(KBEAMX .LT. KLMRGN-KHORSZ/KFACTR)GO TO 20
   10 IF(KBEAMX .LT. KRMRGN)GO TO 30
      IF(KBEAMX .LT. 4092/KFACTR)GO TO 20
      KBEAMX=KLMRGN
      KBEAMY=KBEAMY-(KVERSZ+KFACTR/2)/KFACTR
      IF(KBEAMY .LT. 0) KBEAMY=KHOMEY
      GO TO 30
   20 CALL NEWLIN
C * CALCULATE NUMBER OF CHARACTERS POSSIBLE TO PUT ON LINE
   30 ISEND=((KRMRGN-KBEAMX)*KFACTR+KHORSZ-1)/KHORSZ
C * PUT OUT AT LEAST ONE CHARACTER
      IF(ISEND .LT. 1)ISEND=1
C * DON@T SEND ENOUGH CHARACTERS TO CAUSE BUFFER TRUNCATION
      IF(ISEND .GT. MAXLEN)ISEND=MAXLEN
      IEND=IPT+ISEND-1
C * SEND ONLY NUMBER OF CHARACTERS RECEIVED
      IF(IEND .GT. NCHAR)ISEND=NCHAR-IPT+1
      CALL TOUTST(ISEND,IADE(IPT))
C * UPDATE THE BEAM
      KBEAMX=KBEAMX+(ISEND*KHORSZ+KFACTR/2)/KFACTR
      IF(KBEAMY .GT. 4092/KFACTR)KBEAMY=4092/KFACTR
      IPT=IPT+ISEND
C * REPEAT ON NEWLINE UNTIL ALL CHARACTERS SENT
      IF(IEND .LT. NCHAR)GO TO 10
      RETURN
      END
C
C----------SUBROUTINE--AOUTST------------------------TEKTRONIX, INC.----
C
      SUBROUTINE AOUTST(NCHAR,IAM)
      DIMENSION IADE(132),IAM(1)
      DATA MAXLEN/132/
      LEN=NCHAR
      IF(LEN .GT. MAXLEN)LEN=MAXLEN
      CALL KAM2AS(LEN,IAM,IADE)
      CALL ANSTR(LEN,IADE)
      RETURN
      END
C
C----------SUBROUTINE--A1IN--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE A1IN(NCHAR,IA1)
      DIMENSION IADE(132),IA1(1)
      DATA MAXLEN/132/
      LEN=NCHAR
      IF(LEN .GT. MAXLEN)LEN=MAXLEN
      CALL TINSTR(LEN,IADE)
      CALL KAS2A1(LEN,IADE,IA1)
      RETURN
      END
C
C----------SUBROUTINE--A1OUT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE A1OUT(NCHAR,IA1)
      DIMENSION IADE(132),IA1(1)
      ITEMP=NCHAR
      DO 10 I=1,NCHAR,132
      ISEND=132
      IF(ITEMP .LT. 132)ISEND=ITEMP
      CALL KA12AS(ISEND,IA1(I),IADE)
      CALL ANSTR(ISEND,IADE)
   10 ITEMP=ITEMP-132
      RETURN
      END
C
C----------SUBROUTINE--BAKSP-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE BAKSP
	INCLUDE 'COMMON.FOR'
      IF(KKMODE.NE.0)CALL ALFMOD
C * OUTPUT (BS)
      CALL TOUTPT(8)
      KBEAMX=KBEAMX-(KHORSZ+KFACTR/2)/KFACTR
      IF(KBEAMX.GE.0)GO TO 10
      KBEAMX=KBEAMX+4095/KFACTR
   10 RETURN
      END
C
C----------SUBROUTINE--BELL--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE BELL
	INCLUDE 'COMMON.FOR'
C *  OUTPUT (BEL)
      CALL TOUTPT(7)
C * BELL NULLIFIES MOVE AT TERMINAL
      CALL IOWAIT(1)
      KMOVEF=0
      RETURN
      END
C
C----------SUBROUTINE--CARTN-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CARTN
	INCLUDE 'COMMON.FOR'
      IF(KLMRGN.EQ.0)GO TO 10
C * IF (CR) CAN NOT BE SENT REMOVE ALL EXECUTEABLE CODE EXCEPT NEXT 2
C * LINES AND RETURN
      CALL MOVABS(KLMRGN,KBEAMY)
      CALL ALFMOD
      GO TO 20
   10 IF(KKMODE.NE.0)CALL ALFMOD
C * OUTPUT (CR)
      CALL TOUTPT(13)
      KBEAMX=0
C * RESTORE ZAXIS STATE ON 4014
      IF(KTERM .GE. 2)CALL CWSEND
   20 RETURN
      END
C
C----------SUBROUTINE--CHRSIZ------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CHRSIZ(K)
	INCLUDE 'COMMON.FOR'
      DIMENSION ICODE(2),ICHRTB(2,4)
      DATA ICHRTB(1,1),ICHRTB(2,1)/56,88/
      DATA ICHRTB(1,2),ICHRTB(2,2)/51,82/
      DATA ICHRTB(1,3),ICHRTB(2,3)/34,53/
      DATA ICHRTB(1,4),ICHRTB(2,4)/31,48/
      DATA ICODE(1)/27/
C * CHECK TERMINAL TYPE
      IF(KTERM .LE. 1)GO TO 10
      IF(K .LT. 1)K=1
      IF(K .GT. 4)K=4
      KSIZEF=K
      KHORSZ=ICHRTB(1,K)
      KVERSZ=ICHRTB(2,K)
      ICODE(2)=55+K
      CALL TOUTST(2,ICODE)
   10 RETURN
      END
C
C----------SUBROUTINE--CLIPT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CLIPT(BUFIN,OUTBF)
      DIMENSION  BUFIN(1),OUTBF(1)
	INCLUDE 'COMMON.FOR'
      GSTAX=BUFIN(1)
      GSTAY=BUFIN(2)
      GENDX=BUFIN(3)
      GENDY=BUFIN(4)
      IF(GSTAX.GE.TMINVX)GO TO 10
      IF(GENDX.GE.TMINVX)GO TO 20
      GO TO 210
   10 IF(GSTAX.LE.TMAXVX)GO TO 20
      IF(GENDX.LE.TMAXVX)GO TO 20
      GO TO 210
   20 IF(GSTAY.GE.TMINVY)GO TO 30
      IF(GENDY.GE.TMINVY)GO TO 40
      GO TO 210
   30 IF(GSTAY.LE.TMAXVY)GO TO 40
      IF(GENDY.LE.TMAXVY)GO TO 40
      GO TO 210
   40 IF(GSTAX.NE.GENDX)GO TO 50
      DSTAX=GSTAX
      DENDX=GSTAX
      CALL PARCLT(GSTAY,GENDY,TMINVY,TMAXVY,DSTAY,DENDY)
      GO TO 200
   50 IF(GSTAY.NE.GENDY)GO TO 60
      DSTAY=GSTAY
      DENDY=GSTAY
      CALL PARCLT(GSTAX,GENDX,TMINVX,TMAXVX,DSTAX,DENDX)
      GO TO 200
   60 A=GENDX-GSTAX
      B=GENDY-GSTAY
      IF(GSTAX.LT.TMINVX)GO TO 80
      IF(GSTAX.LE.TMAXVX)GO TO 70
      Q=TMAXVX
      GO TO 90
   70 IF(GSTAY.GT.TMAXVY)GO TO 110
      IF(GSTAY.LT.TMINVY)GO TO 100
      DSTAX=GSTAX
      DSTAY=GSTAY
      GO TO 130
   80 Q=TMINVX
   90 DSTAY=GSTAY+((Q-GSTAX)*B/A)
      IF(DSTAY.GT.TMAXVY)GO TO 110
      IF(DSTAY.LT.TMINVY)GO TO 100
      DSTAX=Q
      GO TO 130
  100 R=TMINVY
      GO TO 120
  110 R=TMAXVY
  120 DSTAX=GSTAX+((R-GSTAY)*A/B)
      IF(DSTAX.GT.TMAXVX)GO TO 210
      IF(DSTAX.LT.TMINVX)GO TO 210
      DSTAY=R
  130 IF(GENDX.LT.TMINVX)GO TO 150
      IF(GENDX.GT.TMAXVX)GO TO 140
      IF(GENDY.GT.TMAXVY)GO TO 180
      IF(GENDY.LT.TMINVY)GO TO 170
      DENDX=GENDX
      DENDY=GENDY
      GO TO 200
  140 Q=TMAXVX
      GO TO 160
  150 Q=TMINVX
  160 DENDY=GSTAY+((Q-GSTAX)*B/A)
      IF(DENDY.GT.TMAXVY)GO TO 180
      IF(DENDY.LT.TMINVY)GO TO 170
      DENDX=Q
      GO TO 200
  170 R=TMINVY
      GO TO 190
  180 R=TMAXVY
  190 DENDX=GSTAX+((R-GSTAY)*A/B)
      DENDY=R
  200 OUTBF(1)=DSTAX
      OUTBF(2)=DSTAY
      OUTBF(3)=DENDX
      OUTBF(4)=DENDY
      KGNFLG=0
      GO TO 220
C * SET FLAG IF LINE OUTSIDE WINDOW
  210 KGNFLG=1
  220 RETURN
      END
C
C----------SUBROUTINE--CSIZE-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CSIZE(IHORZ,IVERT)
	INCLUDE 'COMMON.FOR'
      IHORZ=(KHORSZ+KFACTR/2)/KFACTR
      IVERT=(KVERSZ+KFACTR/2)/KFACTR
      RETURN
      END
C
C----------SUBROUTINE--CWSEND------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CWSEND
	INCLUDE 'COMMON.FOR'
      DIMENSION ICODE(2)
      DATA ICODE(1)/27/
      ICODE(2)=96+KZAXIS*8+KLINE
      CALL TOUTST(2,ICODE)
      RETURN
      END
C
C----------SUBROUTINE--CZAXIS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE CZAXIS(ICODE)
	INCLUDE 'COMMON.FOR'
C * ICODE = 0 -- NORMAL Z AXIS
C *       = 1 --DEFOCUSED Z AXIS
C *       = 2 --WRITE-THRU ENABLE
      IF(KTERM .LE. 1)GO TO 10
      KZAXIS=ICODE
      IF(KZAXIS .LT. 0)KZAXIS=0
      IF(KZAXIS .GT. 2)KZAXIS=2
      CALL CWSEND
   10 RETURN
      END
C
C----------SUBROUTINE--DASHA-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DASHA(X,Y,L)
	INCLUDE 'COMMON.FOR'
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(1,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      CALL DSHMOD(L)
      CALL TKDASH(IX,IY)
   10 RETURN
      END
C
C----------SUBROUTINE--DASHR-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DASHR(X,Y,L)
      CALL REL2AB(X,Y,XL,YL)
      CALL DASHA(XL,YL,L)
      RETURN
      END
C
C----------SUBROUTINE--DCURSR------------------------TEKTRONIX, INC.----
C
C      SUBROUTINE DCURSR(ICHAR,IX,IY)
C      CALL SCURSR(ICHAR,IX,IY)
C      RETURN
C      END
C
C----------SUBROUTINE--DRAWA-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRAWA(X,Y)
	INCLUDE 'COMMON.FOR'
C * SET TERMINAL TO DRAW SOLID LINES IF NEEDED
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(1,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      IF(KKMODE.NE.1)CALL VECMOD
      IF(KMOVEF.EQ.1)CALL XYCNVT(KBEAMX,KBEAMY)
      CALL XYCNVT(IX,IY)
   10 RETURN
      END
C
C----------SUBROUTINE--DRAWR-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRAWR(X,Y)
      CALL REL2AB(X,Y,RX,RY)
      CALL DRAWA(RX,RY)
      RETURN
      END
C
C----------SUBROUTINE--DRAWSA------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRAWSA(X,Y)
	INCLUDE 'COMMON.FOR'
      CALL LVLCHT
      XOLD=TIMAGX
      YOLD=TIMAGY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C * LINEAR LOG POLAR USER ERROR
      GO TO (10, 10, 20, 40, 10),KEY
C * ERROR LINEAR LOG
   10 CALL DRAWA(X,Y)
      XOLD=X
      YOLD=Y
      RETURN
C * POLAR
   20 DX=X-XOLD
      DY=Y-YOLD
      YSTEP=SIGN(5.0/TRFACY,DY)
      IF(ABS(DY*.75) .LT. ABS(YSTEP)) GO TO 10
      FRAC=DX/DY
      NSEG=(DY/YSTEP)+.9999
      YOUT=YOLD
   30 IF(NSEG .LT. 2) GO TO 10
      YOUT=YOUT+YSTEP
      XOUT=XOLD+(YOUT-YOLD)*FRAC
      CALL DRAWA(XOUT,YOUT)
      NSEG=NSEG-1
      GO TO 30
C * USER SEGMENTATION
   40 CONTINUE
C      CALL USDRAW(X,Y)
      GO TO 10
      END
C
C----------SUBROUTINE--DRAWSR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRAWSR(X,Y)
      CALL REL2AB(X,Y,RX,RY)
      CALL DRAWSA(RX,RY)
      RETURN
      END
C
C----------SUBROUTINE--DRWABS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRWABS(IX,IY)
	INCLUDE 'COMMON.FOR'
C * NON-4014/15 PRUNING BOUNDARY
C * SET TERMINAL TO DRAW SOLID LINES
      IF(KKMODE.NE.1)CALL VECMOD
      IF(KMOVEF.EQ.1)CALL XYCNVT(KBEAMX,KBEAMY)
      CALL XYCNVT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
C----------SUBROUTINE--DRWREL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DRWREL(IX,IY)
	INCLUDE 'COMMON.FOR'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL DRWABS(JX,JY)
      RETURN
      END
C
C----------SUBROUTINE--DSHABS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DSHABS(IX,IY,L)
	INCLUDE 'COMMON.FOR'
      CALL DSHMOD(L)
      CALL TKDASH(IX,IY)
C * SET THE GRAPHIC LEVEL FLAG TO SCREEN
      KGRAFL=0
      RETURN
      END
C
C----------SUBROUTINE--DSHMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DSHMOD(L)
	INCLUDE 'COMMON.FOR'
      IF(KKMODE .EQ. 4) GO TO 20
      KKMODE=4
C * OUTPUT (US) TO CANCEL PREVIOUS MODE
      CALL TOUTPT(31)
C * CANCEL OPTIMIZATION AND INSERT MOVE TO CURRENT LOCATION
      CALL TOUTPT(29)
      KMOVEF=1
      DO 10 I=1,5
   10 KPCHAR(I)=-1
      CALL XYCNVT(KBEAMX,KBEAMY)
   20 KDASHT=L
      RETURN
      END
C
C----------SUBROUTINE--DSHREL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DSHREL(IX,IY,L)
	INCLUDE 'COMMON.FOR'
      JX=IX+KBEAMX
      JY=IY+KBEAMY
      CALL DSHABS(JX,JY,L)
      RETURN
      END
C
C----------SUBROUTINE--DWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX)
	INCLUDE 'COMMON.FOR'
C * DEFINE DATA WINDOW IN TERMINAL COMMON AREA
      TMINVX=XMIN
      TMAXVX=XMAX
      TMINVY=YMIN
      TMAXVY=YMAX
      CALL RESCAL
      RETURN
      END
C
C----------SUBROUTINE--ERASE-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE ERASE
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(10)
      CALL RECOVR
      RETURN
      END
C
C----------SUBROUTINE--FINITT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE FINITT(IX,IY)
      CALL MOVABS(IX,IY)
      CALL ALFMOD
C     CALL TSEND
      CALL EXIT
      END
C
C----------FUNCTION----GENFLG------------------------TEKTRONIX, INC.----
C
      LOGICAL FUNCTION GENFLG(ITEM)
	INCLUDE 'COMMON.FOR'
      GENFLG=KGNFLG .EQ. ITEM
      RETURN
      END
C
C----------SUBROUTINE--HDCOPY------------------------TEKTRONIX, INC.----
C CORRECTION X507 APPLIED
C
      SUBROUTINE HDCOPY
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,23/
C *  OUTPUT (ESC) (ETB) TO START HARD COPY
      CALL TOUTST(2,ICODE)
      CALL IOWAIT(20)
      RETURN
      END
C
C----------SUBROUTINE--HOME--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE HOME
	INCLUDE 'COMMON.FOR'
      CALL MOVABS(KLMRGN,KHOMEY)
      CALL ALFMOD
      RETURN
      END
C
C----------SUBROUTINE--INCPLT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE INCPLT(IONOFF,IDIR,NO)
      DIMENSION IPLTBL(8),KBMUP(10)
	INCLUDE 'COMMON.FOR'
      DATA IPLTBL(1),IPLTBL(2),IPLTBL(3),IPLTBL(4)/4,5,1,9/
      DATA IPLTBL(5),IPLTBL(6),IPLTBL(7),IPLTBL(8)/8,10,2,6/
      DATA KBMUP(1),KBMUP(2),KBMUP(3),KBMUP(4),KBMUP(5)/0,1,1,1,0/
      DATA KBMUP(6),KBMUP(7),KBMUP(8),KBMUP(9),KBMUP(10)/-1,-1,-1,0,1/
      IF(KKMODE .NE. 3)CALL IPMOD
      IPEN=32+IONOFF*48
C * THIS SECTION TO ACCOMMODATE PLOTTERS REQUIRING A SEPARATE PEN
C * CHARACTER -- IT MAY BE OMITTED IF NOT NEEDED ***********************
      CALL TOUTPT(IPEN)
      IPEN=64
C **********************************************************************
      KMOVEF=IABS(IONOFF-1)
      NDXPLT=MOD(IDIR,8)+1
      IPLTCH=IPLTBL(NDXPLT)+IPEN
      KBMUPX=KBMUP(NDXPLT)
      KBMUPY=KBMUP(NDXPLT+2)
      DO 10 I=1,NO
      CALL TOUTPT(IPLTCH)
      KBEAMX=KBEAMX+KBMUPX
   10 KBEAMY=KBEAMY+KBMUPY
      RETURN
      END
C
C----------SUBROUTINE--INITT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE INITT(IBAUD)
	INCLUDE 'COMMON.FOR'
      KBAUDR=IBAUD
      KPAD2=KBAUDR/308+1
      KPADV=0
      KTERM=1
      KFACTR=4
C * SET THE OUTPUT BUFFER FORMAT
      KUNIT=4
      KINLFT=0
      KOTLFT=1
      KGNMOD=0
      CALL RESET
      CALL NEWPAG
      RETURN
      END
C
C----------SUBROUTINE--IOWAIT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE IOWAIT(ITIME)
C * THIS ROUTINE IS USED TO GENERATE DELAYS FOR REMOTE TERMINALS
	INCLUDE 'COMMON.FOR'
      IF(KBAUDR.LE.0)GO TO 20
      COUNT=FLOAT(ITIME)*FLOAT(KBAUDR/10)
      CNTR = 0.0
   10 CONTINUE
C * OUTPUT (SYN) TO INSURE AGAINST LOSS OF OUTPUT WHILE
C * TERMINAL IS BUSY. (SYN) DOES NOT AFFECT THE TERMINAL.
      CALL TOUTPT(22)
      CNTR = CNTR + 1.0
      IF (CNTR .LE. COUNT) GO TO 10
   20 RETURN
      END
C
C----------SUBROUTINE--IPMOD-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE IPMOD
	INCLUDE 'COMMON.FOR'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/31,30/
C * OUTPUT (US) TO CANCEL PREVIOUS MODE AND (RS) TO SET INCPLT MODE
      CALL TOUTST(2,ICODE)
      KKMODE=3
      KGRAFL=0
      RETURN
      END
C
C----------SUBROUTINE--KAM2AS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE KAM2AS(NCHAR,KA2,KAS)
      DIMENSION KA2(1),KAS(1)
      IF(NCHAR .LE. 0)GO TO 20
      K=(NCHAR+1)/2
      DO 10 I=1,K
      J=I*2
      KAS(J-1)=MOD(KA2(I),256)
      IF(J .GT. NCHAR)GO TO 20
   10 KAS(J)=KA2(I)/256
   20 RETURN
      END
C
C----------SUBROUTINE--KAS2AM------------------------TEKTRONIX, INC.----
C
      SUBROUTINE KAS2AM(NCHAR,KADE,KA2)
      DIMENSION KADE(1),KA2(1)
      IF(NCHAR .LE. 0)GO TO 20
C * TRANSLATE ADE ARRAY INTO A2 ARRAY
      K=(NCHAR+1)/2
      DO 10 I=1,K
      KA2(I)=KADE(I*2-1)
      IF(I*2-1 .EQ. NCHAR)GO TO 20
   10 KA2(I)=KA2(I)+KADE(I*2)*256
   20 RETURN
      END
C
C----------SUBROUTINE--KAS2A1------------------------TEKTRONIX, INC.----
C
      SUBROUTINE KAS2A1(NCHAR,KAS,KA1)
      DIMENSION KAS(1),KA1(1)
      IF(NCHAR .LE. 0)GO TO 20
      DO 10 I=1,NCHAR
   10 KA1(I)=KAS(I)+8192
   20 RETURN
      END
C
C----------SUBROUTINE--KA12AS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE KA12AS(NCHAR,KA1,KAS)
      DIMENSION KAS(1),KA1(1)
      IF(NCHAR .LE. 0)GO TO 20
      DO 10 I=1,NCHAR
   10 KAS(I)=KA1(I)-8192
   20 RETURN
      END
C
C----------FUNCTION----KCM---------------------------TEKTRONIX, INC.----
C
      FUNCTION KCM(RC)
	INCLUDE 'COMMON.FOR'
      KCM=RC*215.2/FLOAT(KFACTR)
C * USE APPROPRIATE FACTOR FOR LARGE SCREEN TERMINALS
      IF(KTERM .GT. 1)KCM=RC*112.48/FLOAT(KFACTR)
      RETURN
      END
C
C----------FUNCTION----KIN---------------------------TEKTRONIX, INC.----
C
      FUNCTION KIN(RI)
	INCLUDE 'COMMON.FOR'
      KIN=RI*546.0/FLOAT(KFACTR)
C * USE APPROPRIATE FACTOR FOR LARGE SCREEN TERMINALS
      IF(KTERM .GT. 1)KIN=RI*25.7/FLOAT(KFACTR)
      RETURN
      END
C
C----------FUNCTION----LEFTIO------------------------TEKTRONIX, INC.----
C
      FUNCTION LEFTIO(IOBUF)
	INCLUDE 'COMMON.FOR'
      ITEMP=KINLFT
      IF(IOBUF .EQ. 0)ITEMP=KOTLFT
      LEFTIO=ITEMP
      RETURN
      END
C
C----------SUBROUTINE--LINEF-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE LINEF
	INCLUDE 'COMMON.FOR'
C * IF (LF) CAN NOT BE SENT REMOVE NEXT 2 EXECUTEABLE LINES AND
C * CHANGE @GO TO@ FROM 200 TO 100
      IF(KKMODE .NE. 0)CALL ALFMOD
C * OUTPUT (LF)
      CALL TOUTPT(10)
      KBEAMY=KBEAMY-(KVERSZ+KFACTR/2)/KFACTR
      IF(KBEAMY .GE. 0)GO TO 20
      KBEAMY=KHOMEY
   10 CALL MOVABS(KBEAMX,KBEAMY)
      CALL ALFMOD
C * RESTORE ZAXIS MODE IF APPROPRIATE
   20 IF(KTERM .GE. 2)CALL CWSEND
      RETURN
      END
C
C----------FUNCTION----LINHGT-----------------------TEKTRONIX, INC.----
C
      FUNCTION LINHGT(NUMLIN)
	INCLUDE 'COMMON.FOR'
      LINHGT=(KVERSZ * NUMLIN + KFACTR/2)/KFACTR
      RETURN
      END
C
C----------SUBROUTINE--LINTRN------------------------TEKTRONIX, IC.----
C
      SUBROUTINE LINTRN
	INCLUDE 'COMMON.FOR'
      KEYCON=1
      CALL RESCAL
      RETURN
      END
C
C----------FUNCTION----LINWDT------------------------TEKTRONIX, INC.----
C
      FUNCTION LINWDT(NUMCHR)
	INCLUDE 'COMMON.FOR'
      LINWDT=(KHORSZ * NUMCHR + KFACTR/2)/KFACTR
      RETURN
      END
C
C----------SUBROUTINE--LOGTRN------------------------TEKTRONIX, INC.----
C
      SUBROUTINE LOGTRN(ITYPE)
	INCLUDE 'COMMON.FOR'
      KEYCON=2
      TRPAR1=ITYPE
      CALL RESCAL
      RETURN
      END
C
C----------SUBROUTINE--LVLCHT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE LVLCHT
	INCLUDE 'COMMON.FOR'
      IF(KGRAFL.NE.0)GO TO 10
      CALL REVCOT(KBEAMX,KBEAMY,TREALX,TREALY)
      TIMAGX=TREALX
      TIMAGY=TREALY
      KGRAFL=1
   10 RETURN
      END
C
C----------SUBROUTINE--MOVABS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE MOVABS(IX,IY)
	INCLUDE 'COMMON.FOR'
      CALL VECMOD
      CALL XYCNVT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
C----------SUBROUTINE--MOVEA-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE MOVEA(X,Y)
	INCLUDE 'COMMON.FOR'
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(0,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      CALL VECMOD
      CALL XYCNVT(IX,IY)
   10 RETURN
      END
C
C----------SUBROUTINE--MOVER-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE MOVER(X,Y)
      CALL REL2AB(X,Y,RX,RY)
      CALL MOVEA(RX,RY)
      RETURN
      END
C
C----------SUBROUTINE--MOVREL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE MOVREL(IX,IY)
	INCLUDE 'COMMON.FOR'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL MOVABS(JX,JY)
      RETURN
      END
C
C----------SUBROUTINE--NEWLIN------------------------TEKTRONIX, INC.----
C
      SUBROUTINE NEWLIN
      CALL CARTN
      CALL LINEF
      RETURN
      END
C
C----------SUBROUTINE--NEWPAG------------------------TEKTRONIX, INC.----
C
      SUBROUTINE NEWPAG
	INCLUDE 'COMMON.FOR'
      DIMENSION ICODE(2)
      DATA ICODE(1),ICODE(2)/27,12/
      IF(KKMODE .NE. 0)CALL ALFMOD
C * OUTPUT (ESC) (FF) FOR NEW PAGE
      CALL TOUTST(2,ICODE)
C      CALL IOWAIT(10)			!TAKEN OUT FOR SPEED
      IF(KLMRGN.EQ.0)GO TO 10
      CALL MOVABS(KLMRGN,KHOMEY)
      CALL ALFMOD
      GO TO 20
   10 KBEAMX=0
      KBEAMY=KHOMEY
   20 RETURN
      END
C
C----------SUBROUTINE--PARCLT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PARCLT(RL1,RL2,RM1,RM2,RN1,RN2)
      IF(RL1.LT.RM1)GO TO 10
      IF(RL1.GT.RM2)GO TO 40
      RN1=RL1
      IF(RL2-RM1)50,20,20
   10 RN1=RM1
   20 IF(RL2.LE.RM2)GO TO 30
      RN2=RM2
      GO TO 60
   30 RN2=RL2
      GO TO 60
   40 RN1=RM2
      IF(RL2.GE.RM1)GO TO 30
   50 RN2=RM1
   60 RETURN
      END
C
C----------SUBROUTINE--PCLIPT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PCLIPT(X,Y)
	INCLUDE 'COMMON.FOR'
      KGNFLG=0
      IF(X.LT.TMINVX)GO TO 10
      IF(X.GT.TMAXVX)GO TO 10
      IF(Y.LT.TMINVY)GO TO 10
      IF(Y.LE.TMAXVY)GO TO 20
   10 KGNFLG=1
   20 RETURN
      END
C
C----------SUBROUTINE--PLTCHR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PLTCHR(IX,IY,ICHAR)
      INCLUDE 'COMMON.FOR'
      DIMENSION ICHAR(1)
C * CALCULATE THE PLOT CHARACTERS TO ARRIVE AT IX,IY
C * ORDER IS HIY, LSBYX, LOY, HIX, LOX
      KX=IX*KFACTR
      KY=IY*KFACTR
      IF(KY .LT. 0)KY=0
      IF(KX .LT. 0)KX=0
      ICHAR(1)=MOD(KY/128,32)+32
      ICHAR(2)=MOD(KY,4)*4+MOD(KX,4)+96
      ICHAR(3)=MOD(KY/4,32)+96
      ICHAR(4)=MOD(KX/128,32)+32
      ICHAR(5)=MOD(KX/4,32)+64
      IF(KBAUDR .LT. 480) GO TO 10
      KPADV=KPAD2-1
      IF(KTERM .LT. 2) GO TO 10
      KPADV=IABS(KBEAMX-IX)+IABS(KBEAMY-IY)
      KPADV=KPADV*KPAD2*KFACTR/8192+1
   10 RETURN
      END
C
C----------SUBROUTINE--PNTABS------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PNTABS(IX,IY)
	INCLUDE 'COMMON.FOR'
      IF(KKMODE .NE. 2)CALL PNTMOD
      CALL TKPNT(IX,IY)
      KGRAFL=0
      RETURN
      END
C
C----------SUBROUTINE--PNTMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PNTMOD
	INCLUDE 'COMMON.FOR'
C * CANCEL PREVIOUS MODES - OUTPUT (US)
      CALL TOUTPT(31)
      DO 10 II=1,5
   10 KPCHAR(II)=-1
      KKMODE=2
C * FOR HARDWARE OINT PLOT OUTPUT AN (FS)
      IF(KTERM .GE. 3)CALL TOUTPT(28)
      RETURN
      END
C
C----------SUBROUTINE--PNTREL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PNTREL(IX,IY)
	INCLUDE 'COMMON.FOR'
      JX=KBEAMX+IX
      JY=KBEAMY+IY
      CALL PNTABS(JX,JY)
      RETURN
      END
C
C----------SUBROUTINE--POINTA------------------------TEKTRONIX, INC.----
C
      SUBROUTINE POINTA(X,Y)
	INCLUDE 'COMMON.FOR'
      CALL LVLCHT
C * CONVERT TO SCREEN CO-ORDINATES
      CALL V2ST(0,X,Y,IX,IY)
C * SKIP IF LINE COMPLETELY OUTSIDE WINDOW
      IF(KGNFLG .EQ. 1)GO TO 10
      IF(KKMODE .NE. 2)CALL PNTMOD
      CALL TKPNT(IX,IY)
   10 RETURN
      END
C
C----------SUBROUTINE--POINTR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE POINTR(X,Y)
      CALL REL2AB(X,Y,RX,RY)
      CALL POINTA(RX,RY)
      RETURN
      END
C
C----------SUBROUTINE--POLTRN------------------------TEKTRONIX, INC.----
C
      SUBROUTINE POLTRN(ANGMIN,ANGMAX,RSUPRS)
	INCLUDE 'COMMON.FOR'
      KEYCON=3
      TRPAR1=ANGMIN
      TRPAR2=ANGMAX
      TRPAR5=RSUPRS
      CALL PSCAL
      RETURN
      END
C
C----------SUBROUTINE--PSCAL-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE PSCAL
	INCLUDE 'COMMON.FOR'
      LOGICAL ANEG
      ANEG=TRPAR1 .GT. TRPAR2
C * FLAG THE OLD VIRTUAL COORDINATES AS INCORRECT
      KGRAFL=0
      PIDV2=90.00
C * SET UP UNTRANSLATED TRIAL POLAR WINDOW
      TRPAR3=0.
      TRPAR4=0.
      TRFACY=1.
      TRPAR6=0.
      R1=TMINVX
      R2=TMAXVX
      RMAX=AMAX1(ABS(R1),ABS(R2))
      TRFACX=1000./RMAX
      THMIN=AMIN1(TRPAR1,TRPAR2)
      THMAX=AMAX1(TRPAR2,TRPAR1)
C * FIND EXTREMES OF THE TRIAL POLAR WINDOW
      CALL WINCOT(R1,THMIN,IX1,IY1)
      CALL WINCOT(R1,THMAX,IX2,IY2)
      CALL WINCOT(R2,THMIN,IX3,IY3)
      CALL WINCOT(R2,THMAX,IX4,IY4)
      IXMIN=MIN0(IX1,IX2,IX3,IX4)
      IXMAX=MAX0(IX1,IX2,IX3,IX4)
      IYMIN=MIN0(IY1,IY2,IY3,IY4)
      IYMAX=MAX0(IY1,IY2,IY3,IY4)
      X=THMIN/PIDV2
      IF(THMIN.GT.0.)X=X+.999
      QUAD=FLOAT(IFIX(X))*PIDV2
      NQUAD=0
C * CHECK EXTREMES OF TRIAL WINDOW AT 90 DEGREE INTERVALS
   10 IF(QUAD.GE.THMAX)GO TO 20
      NQUAD=NQUAD+1
      CALL WINCOT(R1,QUAD,IX1,IY1)
      CALL WINCOT(R2,QUAD,IX2,IY2)
      IXMIN=MIN0(IX1,IX2,IXMIN)
      IXMAX=MAX0(IX1,IX2,IXMAX)
      IYMIN=MIN0(IY1,IY2,IYMIN)
      IYMAX=MAX0(IY1,IY2,IYMAX)
      QUAD=QUAD+PIDV2
      IF(NQUAD.LT.4)GO TO 10
C * COMPUTE SCREEN AND VIRTUAL RANGES
   20 TSRANX=KMAXSX-KMINSX
      TSRANY=KMAXSY-KMINSY
      XRANGE=IXMAX-IXMIN
      YRANGE=IYMAX-IYMIN
C * COMPUTE RELATIVE RADIUS SCALE FACTOR
      FACTOR=AMIN1(ABS(TSRANX)/XRANGE,ABS(TSRANY)/YRANGE)
C * COMPUTE SCREEN OFFSETS
      TRPAR3=FLOAT(KMINSX)-FACTOR*FLOAT(IXMIN)
      TRPAR4=FLOAT(KMINSY)-FACTOR*FLOAT(IYMIN)
C * COMPUTE FINAL RADIUS SCALE FACTOR
      TRFACX=TRFACX*FACTOR
C * COMPUTE ANGLE SCALE FACTOR
      TRFACY=(TRPAR2-TRPAR1)/(TMAXVY-TMINVY)
C * APPLY CORRECT SIGN TO ANGLE SCALE FACTOR
      TRFACY=SIGN(1.,TSRANX*TSRANY)*TRFACY
      AANG=0.
C * APPLY CORRECTION FOR @REVERSED@ WINDOWS
      IF(ANEG.AND.TSRANY.LT.0..OR.TSRANX.LT.0..AND..NOT.ANEG)AANG=180.
C * COMPUTE ANGLE OFFSET
      TRPAR6=TMINVY-(TRPAR1+AANG)/TRFACY
      RETURN
      END
C
C----------SUBROUTINE--RECOVR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RECOVR
	INCLUDE 'COMMON.FOR'
C * SAVE THE GRAPHIC LEVEL FLAG
      IFLAG=KGRAFL
C * REMOVE MOVE FLAG
      KMOVEF=0
C * SAVE THE MODE
      MODE=KKMODE+1
C * SAVE THE Y-COORDINATE
      IY=KBEAMY
C * CLEAR ALL OTHER MODES
      CALL ALFMOD
C * MOVE TO SCREEN LOCATION
      CALL MOVABS(KBEAMX,IY)
      IF(KTERM .GE. 2) CALL CWSEND
C * PLACE IN THE PROPER MODE
      IF(MODE .LT. 1)MODE=1
      IF(MODE .GT.5)MODE=5
      GO TO (10,30,20,10,30),MODE
   10 CALL ALFMOD
      GO TO 30
   20 CALL PNTMOD
C * RESTORE THE GRAPHIC LEVEL FLAG
   30 KGRAFL=IFLAG
      RETURN
      END
C
C----------SUBROUTINE--REL2AB------------------------TEKTRONIX, INC.----
C
      SUBROUTINE REL2AB(XIN,YIN,XOUT,YOUT)
	INCLUDE 'COMMON.FOR'
      CALL LVLCHT
      XOUT=(((XIN*TRCOSF)-(YIN*TRSINF))*TRSCAL)+TIMAGX
      YOUT=(((XIN*TRSINF)+(YIN*TRCOSF))*TRSCAL)+TIMAGY
      RETURN
      END
C
C----------SUBROUTINE--RESCAL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RESCAL
	INCLUDE 'COMMON.FOR'
C * FLAG OLD VIRTUAL COORDINATES AS INCORRECT
      KGRAFL=0
      KGNFLG=0
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C * BRANCH TO PROPER SECTON AND RETURN
C * LINEAR LOG POLAR USER ERROR
      GO TO (10,20,100,110,120),KEY
C * BOTH AXES LINEAR
   10 TRPAR1=0.
C * SEMI LOG OR LOG LOG
   20 KEYL=TRPAR1+1.001
C * X AXIS -- LINEAR OR LOG
      GO TO (30,40,30,40),KEYL
C * LINEAR
   30 TRFACX=FLOAT(KMAXSX-KMINSX)/(TMAXVX-TMINVX)
      GO TO 60
C * PREVENT INVALID TRANSFORMATION
   40 IF(TMINVX .GT. 0. .AND. TMAXVX .GT. 0.0)GO TO 50
      KGNFLG=1
      TRPAR1=TRPAR1-1.0
      GO TO 30
C * SEMI LOG X AXIS
   50 TRPAR2=ALOG(TMINVX)
      TRFACX=FLOAT(KMAXSX-KMINSX)/(ALOG(TMAXVX)-TRPAR2)
C * Y AXIS -- LINEAR OR LOG
   60 GO TO (70,70,80,80),KEYL
C * LINEAR
   70 TRFACY=FLOAT(KMAXSY-KMINSY)/(TMAXVY-TMINVY)
      GO TO 130
C * PREVENT INVALID TRANSFORMATION
   80 IF(TMINVY .GT. 0.0 .AND. TMAXVY .GT. 0.0)GO TO 90
      KGNFLG=1
      TRPAR1=TRPAR1-2.0
      GO TO 70
C * SEMI LOG Y AXIS
   90 TRPAR3=ALOG(TMINVY)
      TRFACY=FLOAT(KMAXSY-KMINSY)/(ALOG(TMAXVY)-TRPAR3)
      GO TO 130
C * POLAR SCALING
  100 CALL PSCAL
      GO TO 130
C* USER FUNCTION
  110 CONTINUE
C      CALL URSCAL
      GO TO 130
C * NO SCALE
  120 TRFACX=1.
      TRFACY=1.
  130 RETURN
      END
C
C----------SUBROUTINE--RESET-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RESET
	INCLUDE 'COMMON.FOR'
      KEYCON=1
      TRFACX=1.
      TRFACY=1.
      KBEAMX=0
      KHOMEY=3068/KFACTR
      KBEAMY=KHOMEY
      KMINSX=0
      KMAXSX=4095/KFACTR
      KMINSY=0
      KMAXSY=3120/KFACTR
      KHORSZ=56
      KLINE=0
      KZAXIS=0
      KLMRGN=0
      KRMRGN=4088/KFACTR
      KSIZEF=1
      KTBLSZ=10
      KVERSZ=88
      TMINVX=0.
      TMAXVX=KMAXSX
      TMINVY=0.
      TMAXVY=KMAXSY
      TRCOSF=1.
      TRSINF=0.
      TRSCAL=1.
C * MOVE TO THE HOME POSITION
      CALL MOVABS(KLMRGN,KHOMEY)
C * SET 4014 ENHANCED FOR SOLID LINES
      IF(KTERM .GE. 3)CALL CWSEND
C * PLACE 4014 IN LARGE CHARACTER SIZE
      IF(KTERM .GE. 2)CALL CHRSIZ(1)
C * PLACE THE TERMINAL IN A/N MODE
      CALL ALFMOD
      RETURN
      END
C
C----------SUBROUTINE--RESTAT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RESTAT(RARRAY)
	INCLUDE 'COMMON.FOR'
      DIMENSION RARRAY(60),IB(41),RB(19)
      EQUIVALENCE(IB(1),KMOFLG(1)),(RB(1),TMINVX)
C * COPY GIVEN STATUS INTO TCS COMMON
      DO 10 I=1,19
   10 RB(I)=RARRAY(I)
      DO 20 I=1,41
   20 IB(I)=RARRAY(I+19)
C *RESTORE CHARACTER SIZE
      IF(KTERM .GT. 1)CALL CHRSIZ(KSIZEF)
C * RESTORE ZAXIS AND DASH LINE
      IF(KTERM .GT. 2)CALL CWSEND
C * CALL TO RECOVER POSITION AND MODE
      CALL RECOVR
      RETURN
      END
C
C----------SUBROUTINE--REVCOT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE REVCOT(IX,IY,X,Y)
      LOGICAL DEC
	INCLUDE 'COMMON.FOR'
      E=2.7182818284
      DX=FLOAT(IX-KMINSX)/TRFACX
      DY=FLOAT(IY-KMINSY)/TRFACY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C *       LINEAR LOG POLAR USER ERROR
      GO TO(20, 30, 40, 90, 10 ),KEY
C * ERROR
   10 X=IX
      Y=IY
      GO TO 100
C * LINEAR
   20 X=DX+TMINVX
      Y=DY+TMINVY
      GO TO 100
C * LOG SCALES
   30 KEYL=TRPAR1
      X=DX+TMINVX
      Y=DY+TMINVY
      IF(KEYL .NE. 2)X=E**(DX+TRPAR2)
      IF(KEYL .NE. 1)Y=E**(DY+TRPAR3)
      GO TO 100
C * POLAR
   40 DX=FLOAT(IX)-TRPAR3
      DY=FLOAT(IY)-TRPAR4
      Y=ATAN2(DY,DX)*57.2957795131
      X=SQRT(DY*DY+DX*DX)/TRFACX+TRPAR5
C * ADJUST ANGLE MOD 2 PI TO VALUE WITHIN WINDOW
      DEC=.FALSE.
   50 IF(Y .GT. TRPAR1) GO TO 60
C * INCREMENT ANGLE
      Y=Y+360.0
      GO TO 50
   60 IF(Y .LE. TRPAR2) GO TO 70
C * DECREMENT ANGLE
      Y=Y-360.0
      DEC=.TRUE.
      GO TO 60
   70 IF(DEC .AND. Y .LT. TRPAR1)Y=Y+360.0
      IF(TMINVX .GE. 0.)GO TO 80
      TR1A=AMOD(TRPAR1+180.,360.)
      TR2A=AMOD(TRPAR2+180.,360.)
      IF(Y.GT.AMAX1(TR1A,TR2A).OR.Y.LT.AMIN1(TR1A,TR2A))GO TO 80
      Y=AMOD(Y+180.,360.)
      X=-X
   80 Y=Y/TRFACY+TRPAR6
      GO TO 100
C * USER CONVERSION
   90 CONTINUE
C      CALL UREVCT(IX,IY,X,Y)
C * EXIT POINT
  100 CALL PCLIPT(X,Y)
      RETURN
      END
C
C----------SUBROUTINE--RROTAT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RROTAT(DEG)
	INCLUDE 'COMMON.FOR'
      TRSINF=SIN(DEG/57.29578)
      TRCOSF=COS(DEG/57.29578)
      RETURN
      END
C
C----------SUBROUTINE--RSCALE------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RSCALE(FACTOR)
	INCLUDE 'COMMON.FOR'
      TRSCAL=FACTOR
      RETURN
      END
C
C----------SUBROUTINE--RSTTAB------------------------TEKTRONIX, INC.----
C
      SUBROUTINE RSTTAB(ITAB,ITBTBL)
      DIMENSION ITBTBL(1)
	INCLUDE 'COMMON.FOR'
      IF(ITAB)70,50,10
   10 DO 20 I=1,KTBLSZ
      IF(ITAB.EQ.ITBTBL(I))GO TO 30
   20 CONTINUE
      GO TO 70
   30 J=KTBLSZ-1
      DO 40 K=I,J
   40 ITBTBL(K)=ITBTBL(K+1)
      ITBTBL(KTBLSZ)=0
      GO TO 70
   50 DO 60 II=1,KTBLSZ
   60 ITBTBL(II)=0
   70 RETURN
      END
C
C----------SUBROUTINE--SCURSR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SCURSR(ICHAR,IX,IY)
	INCLUDE 'COMMON.FOR'
      DIMENSION ICODE(2),IN(5)
      DATA ICODE(1),ICODE(2)/27,26/
C * SET THE GRAPHIC INPUT FLAG
      KGNMOD=1
C * OUTPUT (ESC) (SUB) TO TURN ON CURSOR
      CALL TOUTST(2,ICODE)
C * CURSER SHOULD ALWAYS INPUT A NEW BUFFER
      KINLFT=0
      CALL TINSTR(5,IN)
C * REMOVE THE GRAPHIC INPUT FLAG
      KGNMOD=0
C * RESTORE THE TERMINAL STATUS
      CALL RECOVR
      ICHAR=IN(1)
C * DECODE SCREEN CO-ORDINATES
      IX=MOD(IN(2),32)*32+MOD(IN(3),32)
      IY=MOD(IN(4),32)*32+MOD(IN(5),32)
C * APPLY SCREEN SCALE FACTOR
      IX=IX*4/KFACTR
      IY=IY*4/KFACTR
      RETURN
      END
C
C----------SUBROUTINE--SEEDW-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEEDW(XMIN,XMAX,YMIN,YMAX)
	INCLUDE 'COMMON.FOR'
      XMIN=TMINVX
      XMAX=TMAXVX
      YMIN=TMINVY
      YMAX=TMAXVY
      RETURN
      END
C
C----------SUBROUTINE--SEELOC------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEELOC(IX,IY)
	INCLUDE 'COMMON.FOR'
      IX=KBEAMX
      IY=KBEAMY
      RETURN
      END
C
C----------SUBROUTINE--SEEMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEEMOD(LINE,IZAXIS,MODE)
	INCLUDE 'COMMON.FOR'
      LINE=KLINE
      IZAXIS=KZAXIS
      MODE=KKMODE
      RETURN
      END
C
C----------SUBROUTINE--SEEMRG------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEEMRG(MLEFT,MRIGHT)
	INCLUDE 'COMMON.FOR'
      MLEFT=KLMRGN
      MRIGHT=KRMRGN
      RETURN
      END
C
C----------SUBROUTINE--SEEREL------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEEREL(RCOS,RSIN,SCALE)
	INCLUDE 'COMMON.FOR'
      RCOS=TRCOSF
      RSIN=TRSINF
      SCALE=TRSCAL
      RETURN
      END
C
C----------SUBROUTINE--SEETRM------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEETRM(IBAUDR,ITERM,ICSIZE,MAXSCR)
	INCLUDE 'COMMON.FOR'
      IBAUDR=KBAUDR
      ITERM=KTERM
      ICSIZE=KSIZEF
      MAXSCR=4095/KFACTR
      RETURN
      END
C
C----------SUBROUTINE--SEETRN------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEETRN(XFAC,YFAC,KEY)
	INCLUDE 'COMMON.FOR'
      XFAC=TRFACX
      YFAC=TRFACY
      KEY=KEYCON
      RETURN
      END
C
C----------SUBROUTINE--SEETW-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SEETW(MINX,MAXX,MINY,MAXY)
	INCLUDE 'COMMON.FOR'
      MINX=KMINSX
      MAXX=KMAXSX
      MINY=KMINSY
      MAXY=KMAXSY
      RETURN
      END
C
C----------SUBROUTINE--SETMRG------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SETMRG(MLEFT,MRIGHT)
	INCLUDE 'COMMON.FOR'
      KLMRGN=MLEFT
      KRMRGN=MRIGHT
      RETURN
      END
C
C----------SUBROUTINE--SETTAB------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SETTAB(ITAB,ITBTBL)
      DIMENSION ITBTBL(1)
	INCLUDE 'COMMON.FOR'
      KGNFLG=0
      IF(ITAB.LE.0)GO TO 30
      I=1
   10 IF(ITBTBL(I).EQ.ITAB)GO TO 30
      IF(ITAB.LT.ITBTBL(I))GO TO 40
      IF(ITBTBL(I).EQ.0)GO TO 40
      I=I+1
      IF(I.LE.KTBLSZ)GO TO 10
   20 KGNFLG=1
   30 RETURN
   40 ITEMP=ITBTBL(I)
      ITBTBL(I)=ITAB
   50 IF(ITEMP.EQ.0)GO TO 30
      I=I+1
      IF(I.GT.KTBLSZ)GO TO 20
      ITEMPA=ITBTBL(I)
      ITBTBL(I)=ITEMP
      ITEMP=ITEMPA
      GO TO 50
      END
C
C----------SUBROUTINE--SVSTAT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SVSTAT(RARRAY)
	INCLUDE 'COMMON.FOR'
      DIMENSION RARRAY(60),IB(41),RB(19)
      EQUIVALENCE (IB(1),KMOFLG(1)),(RB(1),TMINVX)
C * COPY TERMINAL STATUS AREA INTO GIVEN SAVE ARRAY
      DO 10 I=1,19
   10 RARRAY(I)=RB(I)
      DO 20 I=1,41
   20 RARRAY(I+19)=IB(I)
      RETURN
      END
C
C----------SUBROUTINE--SWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE SWINDO(MINX,LENX,MINY,LENY)
	INCLUDE 'COMMON.FOR'
C * DEFINE SCREEN WINDOW IN TERMINAL COMMON AREA
      KMINSX=MINX
      KMAXSX=MINX+LENX
      KMINSY=MINY
      KMAXSY=MINY+LENY
      CALL RESCAL
      RETURN
      END
C
C----------SUBROUTINE--TABHOR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TABHOR(ITBTBL)
      DIMENSION ITBTBL(1)
	INCLUDE 'COMMON.FOR'
      KFLG=0
      DO 10 K=1,KTBLSZ
      IF(ITBTBL(K).NE.0)KFLG=1
      IF(ITBTBL(K).GT.KBEAMX)GO TO 30
   10 CONTINUE
      IF(KFLG.EQ.0)GO TO 40
   20 CALL NEWLIN
      GO TO 40
   30 IF (ITBTBL(K).GE.KRMRGN) GO TO 20
      CALL MOVABS(ITBTBL(K),KBEAMY)
      CALL ALFMOD
   40 RETURN
      END
C
C----------SUBROUTINE--TABVER------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TABVER(ITBTBL)
      DIMENSION ITBTBL (1)
	INCLUDE 'COMMON.FOR'
      DO 10 K=1,KTBLSZ
      I=KTBLSZ-K+1
      IF(ITBTBL(I) .LE. 0)GO TO 10
      IF(ITBTBL(I) .LT. KBEAMY)GO TO 20
   10 CONTINUE
      GO TO 30
   20 CALL MOVABS(KBEAMX,ITBTBL(I))
      CALL ALFMOD
   30 RETURN
      END
C
C----------SUBROUTINE--TCSLEV------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TCSLEV(LEVEL)
      DIMENSION LEVEL(3)
C
C RE-RE-RE-MODIFIED BY MARK ENGBRETSON
C                       WVU PHYSICS DEPARTMENT
C                       FOR RSX
C
C * FOR THE PDP-11 VERSION, LEVEL IS AN ARRAY
C * LEVEL(1) IS THE YEAR OF THIS RELEASE
      LEVEL(1)=76
C * LEVEL(2) IS THE DAY OF THIS RELEASE
      LEVEL(2)=126
C * LEVEL(3) IS THE RELEASE NUMBER
      LEVEL(3)=33
      RETURN
      END
C
C----------SUBROUTINE--TERM--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TERM(ITERM,ISCAL)
	INCLUDE 'COMMON.FOR'
      KTERM=ITERM
      KFACTR=4
      IF(ISCAL .GT. 1025)KFACTR=1
      CALL RESET
      RETURN
      END
C
C----------SUBROUTINE--TINPUT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TINPUT(IN)
      DIMENSION INT(1)
      CALL TINSTR(1,INT)
      IN=INT(1)
      RETURN
      END
C
C----------SUBROUTINE--TINSTR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TINSTR(NCHAR,IADE)
	INCLUDE 'COMMON.FOR'
      DIMENSION INBUFF(132),IADE(1)
      DATA ISENT,IGOT,IPAD/0,0,32/
      IF(KINLFT .GT. 0)GO TO 10
C * REQUEST A NEW INPUT BUFFER
C * PUT OUT THE OUTPUT BUFFER
C      CALL TSEND
      CALL ADEIN(IGOT,INBUFF)
      ISENT=0
      KINLFT=IGOT
   10 LEN=NCHAR
      IF(LEN .LE. 0)GO TO 50
      DO 20 I=1,LEN
      ISENT=ISENT+1
      ITMP=I
      IF(ISENT .GT. IGOT)GO TO 30
   20 IADE(I)=INBUFF(ISENT)
      KINLFT=IGOT-ISENT
      GO TO 50
C * PAD WITH BLANKS WHEN NEEDED
   30 DO 40 I=ITMP,LEN
   40 IADE(I)=IPAD
      KINLFT=0
   50 RETURN
      END
C
C----------SUBROUTINE--TKDASH------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TKDASH(IX,IY)
	INCLUDE 'COMMON.FOR'
      DIMENSION DTABL(10), U(9), WORK(10),ISIMHD(4)
      DATA ISIMHD(1),ISIMHD(2),ISIMHD(3),ISIMHD(4)/12,31212,32,52/
      DATA IDTYPE/-1/
      DATA U(1),U(2),U(3),U(4),U(5)/5.,-5.,10.,-10.,25./
      DATA U(6),U(7),U(8),U(9)/-25.,50.,-50.,0./
      DATA LASTX,LASTY/-1,-1/
      IF(KDASHT .LT. 0)GO TO 200
C * SET TERMINAL FOR HARDWARE DASHED LINES
      IF(KDASHT .EQ. 0)GO TO 210
      IF(KDASHT .EQ. IDTYPE)GO TO 70
C * BUILD NEW DASH TABLE
      ICHAR=KDASHT
      DO 30 NO=1,10
   10 IF(ICHAR)20,40,20
   20 I=ICHAR-((ICHAR/10)*10)
      ICHAR=ICHAR/10
      IF(I)30,10,30
   30 WORK(NO)=U(I)
      NO=11
   40 NO=NO-1
C * INVERT TABLE AN STORE IN DTABLE
      DO 50 I=1,NO
      ISUB=NO+1-I
   50 DTABL(I)=WORK(ISUB)
C * MODIFIY TABLE TO COMPENSATE FOR FLARE
      D1=DTABL(1)
      NUM=NO-1
      DO 60 K=1,NUM
      DCUR=DTABL(K)
      IF(DCUR*DTABL(K+1).GT.0. .OR. DCUR*D1 .LT.0.)GO TO 60
      DTABL(K)=DTABL(K)-1.
      DTABL(K+1)=DTABL(K+1)-1.
   60 CONTINUE
      IDTYPE=KDASHT
      I=0
      SEGLEN=0
C * BRANCH FOR ALTERNATING AND SOLID
   70 IF(NO-1)200,210,80
   80 IF(LASTX-KBEAMX)100,90,100
   90 IF(LASTY-KBEAMY)100,110,100
C * SET START OF SEQUENCE IF NOT INTERRUPTED BY A MOVE
  100 SEGLEN=0
      I=0
C * COMPUTE NEXT SEGMENT LENGTH
  110 X=FLOAT(KBEAMX)
      Y=FLOAT(KBEAMY)
      DX=FLOAT(IX-KBEAMX)
      DY=FLOAT(IY-KBEAMY)
      DIAG=SQRT(DX*DX+DY*DY)
      DIST=DIAG
      IF (SEGLEN-1.5)120,120,130
  120 I=MOD(I,NO)+1
      SEGLEN=ABS(DTABL(I))
  130 IF(SEGLEN-DIST)140,170,170
  140 F=SEGLEN/DIAG
      X=X+DX*F
      Y=Y+DY*F
      IF (DTABL(I))150,150,160
C * OUTPUT A GS FOR A DARK VECTOR
  150 CALL TOUTPT(29)
      KMOVEF=1
  160 CALL XYCNVT(IFIX(X),IFIX(Y))
C * CALCULATE REMAINING DISTANCE TO POINT
      DIST=DIST-SEGLEN
      SEGLEN=0
      GO TO 120
  170 IF(DTABL(I))180,180,190
  180 CALL TOUTPT(29)
      KMOVEF=1
C * THAT WAS A GS FOR AN INVISIBLE LINE
  190 CALL XYCNVT(IX,IY)
      LASTX=IX
      LASTY=IY
C * CALCULATE SEGMENT FRAGMENT UNUSED
      SEGLEN=SEGLEN-DIST
      GO TO 220
  200 CALL TOUTPT(29)
      KMOVEF=1
  210 CALL XYCNVT(IX,IY)
      NO=1-NO
      IDTYPE=KDASHT
  220 RETURN
      END
C----------SUBROUTINE TKINIT
C
C      SUBROUTINE TKINIT
C      INTEGER TKNAM
C      DATA TKNAM /2RTK/
C      I = IFETCH (TKNAM)
C      IF (I .EQ. 1) STOP 'TKINIT: DEVICE NOT CONFIGURED'
C      IF (I .EQ. 2) STOP 'TKINIT: NO ROOM FOR HANDLER'
C      IF (I .EQ. 3) STOP 'TKINIT: HANDLER NOT IN SYSTEM'
C      I = IASIGN (10,TKNAM)
C      IF (I .NE. 0) STOP 'TKINIT: CANNOT ASSIGN 4015 TO 10'
C      CALL INITT (960)
C      CALL TERM (3,1024)
C     RETURN
C      END
C
C----------SUBROUTINE--TKPNT-------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TKPNT(IX,IY)
	INCLUDE 'COMMON.FOR'
      IF(KTERM .GE. 3)GO TO 10
      CALL TOUTPT(29)
      KMOVEF=1
C * MOVE TO POINT
      CALL XYCNVT(IX,IY)
C * DRAW  POINT
   10 CALL XYCNVT(IX,IY)
      RETURN
      END
C
C----------SUBROUTINE--TOUTPT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TOUTPT(KKOUT)
      DIMENSION KOUT(1)
      KOUT(1)=KKOUT
      CALL TOUTST(1,KOUT)
      RETURN
      END
C
C----------SUBROUTINE--TOUTST------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TOUTST(LEN,IADE)
	INCLUDE 'COMMON.FOR'
      DIMENSION IADE(1),ISYNC(5)
      DATA
     * MAXLEN/132/,ISYNC(1),ISYNC(2),ISYNC(3),ISYNC(4),ISYNC(5)/5*22/
      LENOUT=LEN
      IF(LENOUT .GT. MAXLEN)LENOUT=MAXLEN
      CALL ADEOUT(LENOUT,IADE)
      IF(KPADV .GT. 0)CALL ADEOUT(KPADV,ISYNC)
      KPADV=0
      RETURN
      END
C
C----------SUBROUTINE--TSEND-------------------------TEKTRONIX, INC.----
C
C      SUBROUTINE TSEND
C      RETURN
C      END
C
C----------SUBROUTINE--TTBLSZ------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TTBLSZ(ITBLSZ)
	INCLUDE 'COMMON.FOR'
      KTBLSZ=ITBLSZ
      RETURN
      END
C
C----------SUBROUTINE--TWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY)
	INCLUDE 'COMMON.FOR'
C * DEFINE TERMINAL WINDOW IN TERMINAL COMMON AREA
      KMINSX=MINX
      KMAXSX=MAXX
      KMINSY=MINY
      KMAXSY=MAXY
      CALL RESCAL
      RETURN
      END
C
C----------SUBROUTINE--VCURSR------------------------TEKTRONIX, INC.----
C
      SUBROUTINE VCURSR(ICHAR,X,Y)
      CALL SCURSR(ICHAR,IXA,IYA)
      CALL REVCOT(IXA,IYA,X,Y)
      RETURN
      END
C
C----------SUBROUTINE--VECMOD------------------------TEKTRONIX, INC.----
C
      SUBROUTINE VECMOD
	INCLUDE 'COMMON.FOR'
      IF(KKMODE.EQ.1)GO TO 20
C * OUTPUT (US) TO ENTER A/N MODE AND RESET FOR VECTOR MODE
      CALL TOUTPT(31)
      DO 10 II=1,5
   10 KPCHAR(II)=-1
      KKMODE=1
C * OUTPUT (GS) TO ENTER VECTOR MODE
   20 CALL TOUTPT(29)
      KMOVEF=1
      RETURN
      END
C
C----------SUBROUTINE--VWINDO------------------------TEKTRONIX, INC.----
C
      SUBROUTINE VWINDO(XMIN,XRANGE,YMIN,YRANGE)
	INCLUDE 'COMMON.FOR'
C * DEFINE VIRTUAL WINDOWIN TERMINAL COMMON AREA
      TMINVX=XMIN
      TMAXVX=XMIN+XRANGE
      TMINVY=YMIN
      TMAXVY=YMIN+YRANGE
      CALL RESCAL
      RETURN
      END
C
C----------SUBROUTINE--V2ST--------------------------TEKTRONIX, INC.----
C
      SUBROUTINE V2ST(I,X,Y,IX,IY)
      DIMENSION BUFIN(4),BFOUT(4)
	INCLUDE 'COMMON.FOR'
      EQUIVALENCE (BUFIN(1),XS),(BUFIN(2),YS),(BUFIN(3),XE),
     1(BUFIN(4),YE)
      EQUIVALENCE (BFOUT(1),CXS),(BFOUT(2),CYS),(BFOUT(3),CXE),
     1            (BFOUT(4),CYE)
      XE=X
      YE=Y
C * POINT OR MOVE
      IF(I .EQ. 0) GO TO 10
C * BRIGHT VECTOR
      XS=TIMAGX
      YS=TIMAGY
C * CLIP VECTOR
      CALL CLIPT(BUFIN,BFOUT)
C * ON SCREEN{
      IF(KGNFLG .EQ. 1) GO TO 30
C * ARE WE AT START POINT{
      IF(CXS .EQ. TREALX .AND. CYS .EQ. TREALY) GO TO 20
C * MOVE BEAM TO START POINT
      MODE=KKMODE
      CALL VECMOD
      CALL WINCOT(CXS,CYS,IX,IY)
      CALL XYCNVT(IX,IY)
      KKMODE=MODE
      GO TO 20
C * POINT OR MOVE
   10 CALL PCLIPT(XE,YE)
C * OFF SCREEN{
      IF(KGNFLG .EQ. 1) GO TO 30
      CXE=XE
      CYE=YE
C * CONVERT TO SCREEN COORDINATES
   20 CALL WINCOT(CXE,CYE,IX,IY)
C * SAVE POSITION  ABS AND IMAGINARY
      TREALX=CXE
      TREALY=CYE
   30 TIMAGX=X
      TIMAGY=Y
      RETURN
      END
C
C----------SUBROUTINE--WINCOT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE WINCOT(X,Y,IX,IY)
	INCLUDE 'COMMON.FOR'
      DATA DE2RAD/0.01745/
C * CHECK FOR PERMITTED VALUE OFCONVERSION KEY
C * DEFAULT IS LINEAR,ERROR IS NONE
      DX=X-TMINVX
      DY=Y-TMINVY
      KEY=KEYCON
      IF(KEYCON .LT. 1)KEY=5
      IF(KEYCON .GT. 4)KEY=4
C * BRANCH TO PROPER SECTION
C * LINEAR LOG POLAR USER ERROR
      GO TO(40,20,50,60,10),KEY
C       ERROR
   10 IX=X
      IY=Y
      GO TO 70
C * LOG TRANSFORM
   20 KEYL=TRPAR1+.001
      IF(KEYL .EQ. 2) GO TO 30
C * SETUP X LOG TRANSFORM
      DX=ALOG(X)-TRPAR2
   30 IF(KEYL .EQ. 1) GO TO 40
C * SETUP Y LOG TRANSFORM
      DY=ALOG(Y)-TRPAR3
C * CONVERT LINIER
   40 IX=IFIX(DX*TRFACX+.5)+KMINSX
      IY=IFIX(DY*TRFACY+.5)+KMINSY
C * GO TO EXIT
      GO TO 70
C * POLAR TRANSFORMATION
   50 A=(Y-TRPAR6)*TRFACY
      R=(X-TRPAR5)*TRFACX
      IX=R*COS(A*DE2RAD)+TRPAR3
      IY=R*SIN(A*DE2RAD)+TRPAR4
C * GO TO EXIT
      GO TO 70
C * USER TRANSFORMATION IN USE
   60 CONTINUE
C      CALL USECOT(X,Y,IX,IY)
C * EXIT POINT
   70 RETURN
      END
C
C----------SUBROUTINE--XYCNVT------------------------TEKTRONIX, INC.----
C
      SUBROUTINE XYCNVT(IX,IY)
	INCLUDE 'COMMON.FOR'
      DIMENSION IPLT(5),IOPT(5)
      DATA IDREW,ISYN /0,22/
C * RECEIVE THE PLOT CHARACTERS
      CALL PLTCHR(IX,IY,IPLT)
C * OPTIMIZE THE OUTPUT
      LEN=0
C * CHECK IF HIGH Y IS NEEDED
      IF(KPCHAR(1) .EQ. IPLT(1))GO TO 10
C * INCLUDE HIGH Y IF NEEDED
      LEN=1
      KPCHAR(1)=IPLT(1)
      IOPT(1)=IPLT(1)
C * CHECK IF LSBYX IS NEEDED
   10 IF(KTERM .LE. 2)GO TO 20
      IF(KPCHAR(2) .EQ. IPLT(2))GO TO 20
C * INCLUDE LSBYX IF NEEDED
      LEN=LEN+1
      KPCHAR(2)=IPLT(2)
      IOPT(LEN)=IPLT(2)
      GO TO 30
C * CHECK IF LOW Y IS NEEDED
   20 IF(KPCHAR(3) .NE. IPLT(3))GO TO 30
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 40
C * INCLUDE LOW Y IF NEEDED
   30 LEN=LEN+1
      KPCHAR(3)=IPLT(3)
      IOPT(LEN)=IPLT(3)
C * CHECK IF HIGH X IS NEEDED
      IF(KPCHAR(4) .EQ. IPLT(4))GO TO 50
C * INCLUDE HIGH X IF NEEDED
      LEN=LEN+1
      KPCHAR(4)=IPLT(4)
      IOPT(LEN)=IPLT(4)
C * CHECK IF LOW X IS NEEDED
   40 IF(KPCHAR(5) .NE. IPLT(5))GO TO 50
C * CHECK IF ALL THE CHARACTERS ARE THE SAME
      IF(LEN .NE. 0)GO TO 50
C * CHECK IF (GS) FOR DARK VECTOR ALREADY SENT
      IF(KMOVEF .EQ. 1)GO TO 50
C * CHECK IF VECTOR IS ALREADY DRAWN TO SPOT
      IF(IDREW .EQ. 1)GO TO 70
C * INCLUDE THE LOW X
   50 LEN=LEN+1
      KPCHAR(5)=IPLT(5)
      IOPT(LEN)=IPLT(5)
C * SEND THE ARRAY TO THE OUTPUT BUFFER
   60 CALL TOUTST(LEN,IOPT)
C * SET THE COMMON AND HISTORY VARIABLES
C * SET THE DREW HERE FLAG
      IDREW=1
C * REMOVE  THE DREW HERE FLAG IF DIDNT DRAW
      IF(KMOVEF .EQ. 1)IDREW=0
C * REMOVE THE MOVE FLAG
      KMOVEF=0
   70 KBEAMX=IX
      KBEAMY=IY
      RETURN
      END
C
                SUBROUTINE ADEOUT(NCHAR, IBUF)
C
C THIS VERSION OF ADEOUT SPECIFICALLY FOR VAX/VMS VER.3.0
C MODS MADE BY GORDON SMITH, AMD, X3216      DEC.,1982
C
C METHOD EMPLOYED TO TRANSMIT BUFFER(IE TERMINAL IN NO_WRAP MODE
C AND THE SPECIAL WRITE FORMAT) IS ONLY ONE WAY TO PERFORM TRANSMISSION
C OF GRAPHICS BUFFER.  I THINK IT IS THE EASIEST IN TERMS OF MODS
C NEEDED.  IT MAY GIVE FAILURES FOR SOME PLOT10 FEATURES, IN WHICH
C CASE THE MORE COMPLICATED METHODS WILL BE REQUIRED.
C
C REFER TO FORTRAN USERS GUIDE CHAPTER 6 FOR CALLING SYSTEM SERVICES
C FROM FORTRAN .
C REFER TO SYSTEM SERVICES USERS GUIDE AND I/O USERS GUIDE(VOL.1)
C FOR DETAILS OF SYS. SERV. ROUTINES, ERRORS, STATI, ETC.
C
C      COMMON /TEKIO/ ITEK, OTEK                                         
      INTEGER OTEK                                                      
        INTEGER    KCHAN
        CHARACTER *11  LOGDEV
      DIMENSION IBUF(NCHAR)                                             
C FOLLOWING VARIABLES ARE USED IN VAX/VMS ROUTINES AND SHOULD
C ALWAYS BE 4-BYTE INTEGERS
        INTEGER *4  ISTAT, FUNCOD
        INTEGER *4  SYS$ASSIGN, SYS$QIOW, SYS$DASSGN
        INTEGER *4  IOSTAT(2), IBLOK1(2), IBLOK2(2)
C
        DATA LOGDEV /'SYS$OUTPUT:'/
        EXTERNAL TT$M_WRAP, IO$_SENSEMODE, IO$_SETMODE
C SETTING OF VALUES FOR ITEK, OTEK REALLY BELONGS IN SOME OTHER SUBR.
      ITEK=5                                                            
      OTEK=6                                                            
        ISTAT = SYS$ASSIGN(LOGDEV,KCHAN,,)
C ISTAT=1 IF OPERATION SUCCESSFUL.  THIS HOLDS FOR ALL SYSTEM SERVICES
C OPERATIONS.
        IF(.NOT. ISTAT)  CALL LIB$SIGNAL(%VAL(ISTAT))
C GET CURRENT TERMINAL MODES
        FUNCOD = %LOC(IO$_SENSEMODE)
        ISTAT = SYS$QIOW(,%VAL(KCHAN),%VAL(FUNCOD),IOSTAT,
     $           ,,IBLOK1, , , , , )
        IF(.NOT. ISTAT)  CALL LIB$SIGNAL(%VAL(ISTAT))
C GET VALUE FOR NOWRAP BY .NOT. WRAP
        IBLOK2(1) = IBLOK1(1)
        IBLOK2(2) = IBLOK1(2) .AND. (.NOT. %LOC(TT$M_WRAP))
C SET TERMINAL NOWRAP
        FUNCOD = %LOC(IO$_SETMODE)
        ISTAT = SYS$QIOW(,%VAL(KCHAN),%VAL(FUNCOD),IOSTAT,
     $           ,,IBLOK2, , , , , )
        IF(.NOT. ISTAT)  CALL LIB$SIGNAL(%VAL(ISTAT))
      WRITE(OTEK, 1) (IBUF(I),I=1,NCHAR)                                
C FOLLOWING FORMAT WHEN USED WITH TERMINAL IN NO_WRAP MODE
C GUARANTEES THAT NO CR/LF'S OCCUR IN OUTPUT TO TERMINAL.
C       SEE FORTRAN REF. MANUAL FOR DETAILS.
    1 FORMAT (1H+,A1,$)                                                 
C RESET TERMINAL TO ORIGINAL MODE
        FUNCOD = %LOC(IO$_SETMODE)
        ISTAT = SYS$QIOW(,%VAL(KCHAN),%VAL(FUNCOD),IOSTAT,
     $          ,,IBLOK1, , , , , )
        IF(.NOT. ISTAT)  CALL LIB$SIGNAL(%VAL(ISTAT))
C DEASSIGN TERMINAL CHANNEL
          ISTAT = SYS$DASSGN(%VAL(KCHAN))
        IF(.NOT. ISTAT)  CALL LIB$SIGNAL(%VAL(ISTAT))
		RETURN
		END
