C C----------SUBROUTINE--INITT-------------------------TEKTRONIX, INC.---- C SUBROUTINE INITT(IBAUD) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C C THE FOLLOWING LINES ARE ADDED FOR THE VAX 11-750 C FOR TERMINAL DEFINITION C CALL CHANNEL C C END OF ADDITION C KBAUDR=IBAUD KPAD2=KBAUDR/308+1 KGNMOD=0 KPADV=0 KOBLEN=89 KTERM=1 KFACTR=4 C * SET THE OUTPUT BUFFER FORMAT CALL SETBUF(3) KINLFT=0 KOTLFT=1 CALL RESET CALL NEWPAG RETURN END c C C----------SUBROUTINE--TWINDO------------------------TEKTRONIX, INC.---- C SUBROUTINE TWINDO(MINX,MAXX,MINY,MAXY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * DEFINE TERMINAL WINDOW IN TERMINAL COMMON AREA KMINSX=MINX KMAXSX=MAXX KMINSY=MINY KMAXSY=MAXY CALL RESCAL RETURN END c C C----------SUBROUTINE--DWINDO------------------------TEKTRONIX, INC.---- C SUBROUTINE DWINDO(XMIN,XMAX,YMIN,YMAX) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * DEFINE DATA WINDOW IN TERMINAL COMMON AREA TMINVX=XMIN TMAXVX=XMAX TMINVY=YMIN TMAXVY=YMAX CALL RESCAL RETURN END c C C----------SUBROUTINE--POINTA------------------------TEKTRONIX, INC.---- C SUBROUTINE POINTA(X,Y) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 C----------SUBROUTINE--DRAWA-------------------------TEKTRONIX, INC.---- C SUBROUTINE DRAWA(X,Y) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * SET TERMINAL TO DRAW SOLID LINES IF NEEDED C * THIS SECTION IS NEEDED FOR 4014 ENHANCED *************************** C IF(KLINE .EQ. 0)GO TO 5 C KLINE=0 C CALL CWSEND C5 CONTINUE C ********************************************************************** 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 C----------SUBROUTINE--SCURSR------------------------TEKTRONIX, INC.---- C SUBROUTINE SCURSR(ICHAR,IX,IY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 IF(KTERM .GT. 0)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 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 C----------SUBROUTINE--FINITT------------------------TEKTRONIX, INC.---- C SUBROUTINE FINITT(IX,IY) CALL MOVABS(IX,IY) CALL ALFMOD CALL TSEND C STOP RETURN END c C C----------SUBROUTINE--MOVABS------------------------TEKTRONIX, INC.---- C SUBROUTINE MOVABS(IX,IY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT CALL VECMOD CALL XYCNVT(IX,IY) KGRAFL=0 RETURN END c C C----------SUBROUTINE--SETBUF------------------------TEKTRONIX, INC.---- C SUBROUTINE SETBUF(KFORM) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT KUNIT=KFORM C * CHECK FOR OUT OF BOUNDS FORMAT TYPES IF(KUNIT .LT. 1)KUNIT=1 IF(KUNIT .GT. 4)KUNIT=4 C * SET MAXIMUM OUTPT CHAR COUNT DEPENDING ON BUFFER TYPE IF(KUNIT .GE. 3) GO TO 1 KACHAR=KOBLEN-11-KPAD2 KTRAIL=1 RETURN 1 KACHAR=KOBLEN KTRAIL=0 RETURN END c SUBROUTINE ERRMSG(IERR) C INTEGER*4 LLEN INTEGER*4 SYS$GETMSG CHARACTER*100 BUFFER C I = SYS$GETMSG(%VAL(IERR),LLEN,BUFFER,%VAL(15),) WRITE(6,*) BUFFER(1:LLEN) RETURN END C C----------SUBROUTINE--REVCOT------------------------TEKTRONIX, INC.---- C SUBROUTINE REVCOT(IX,IY,X,Y) LOGICAL DEC COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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(300, 400, 500, 600, 100 ),KEY C * ERROR 100 X=IX Y=IY GO TO 700 C * LINEAR 300 X=DX+TMINVX Y=DY+TMINVY GO TO 700 C * LOG SCALES 400 KEYL=TRPAR1 X=DX+TMINVX Y=DY+TMINVY IF(KEYL .EQ. 1 .OR. KEYL .EQ. 3)X=E**(DX+TRPAR2) IF(KEYL .EQ. 2 .OR. KEYL .EQ. 3)Y=E**(DY+TRPAR3) GO TO 700 C * POLAR 500 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. 510 IF(Y .GT. TRPAR1) GO TO 530 C * INCREMENT ANGLE Y=Y+360.0 GO TO 510 530 IF(Y .LE. TRPAR2) GO TO 550 C * DECREMENT ANGLE Y=Y-360.0 DEC=.TRUE. GO TO 530 550 IF(DEC .AND. Y .LT. TRPAR1)Y=Y+360.0 IF(TMINVX .GE. 0.)GO TO 560 TR1A=AMOD(TRPAR1+180.,360.) TR2A=AMOD(TRPAR2+180.,360.) IF(Y.GT.AMAX1(TR1A,TR2A).OR.Y.LT.AMIN1(TR1A,TR2A))GO TO 560 Y=AMOD(Y+180.,360.) X=-X 560 Y=Y/TRFACY+TRPAR6 GO TO 700 C * USER CONVERSION 600 CONTINUE C CALL UREVCT(IX,IY,X,Y) C * EXIT POINT 700 CALL PCLIPT(X,Y) RETURN END c C C----------SUBROUTINE--PSCAL-------------------------TEKTRONIX, INC.---- C SUBROUTINE PSCAL COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 200 IF(QUAD.GE.THMAX)GO TO 300 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 200 C * COMPUTE SCREEN AND VIRTUAL RANGES 300 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 C----------SUBROUTINE--WINCOT------------------------TEKTRONIX, INC.---- C SUBROUTINE WINCOT(X,Y,IX,IY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DATA DE2RAD/0.01745/ C * CHECK FOR PERMITTED VALUE OF CONVERSION 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(500,300,600,700,100),KEY C ERROR 100 IX=X IY=Y GO TO 800 C * LOG TRANSFORM 300 KEYL=TRPAR1+.001 IF(KEYL .EQ. 2) GO TO 400 C * SETUP X LOG TRANSFORM DX=ALOG(X)-TRPAR2 400 IF(KEYL .EQ. 1) GO TO 500 C * SETUP Y LOG TRANSFORM DY=ALOG(Y)-TRPAR3 C * CONVERT LINEAR 500 IX=IFIX(DX*TRFACX+.5)+KMINSX IY=IFIX(DY*TRFACY+.5)+KMINSY C * GO TO EXIT GO TO 800 C * POLAR TRANSFORMATION 600 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 800 C * USER TRANSFORMATION IN USE 700 CONTINUE C CALL USECOT(X,Y,IX,IY) C * EXIT POINT 800 RETURN END C C----------SUBROUTINE--RESET-------------------------TEKTRONIX, INC.---- C SUBROUTINE RESET COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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=4096/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 C----------SUBROUTINE--CWSEND------------------------TEKTRONIX, INC.---- C SUBROUTINE CWSEND COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION ICODE(2) DATA ICODE(1)/27/ ICODE(2)=96+KZAXIS*8+KLINE CALL TOUTST(2,ICODE) RETURN END c C C----------SUBROUTINE--CHRSIZ------------------------TEKTRONIX, INC.---- C SUBROUTINE CHRSIZ(K) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 KSIZEF=K IF(K .LT. 1)KSIZEF=1 IF(K .GT. 4)KSIZEF=4 KHORSZ=ICHRTB(1,KSIZEF) KVERSZ=ICHRTB(2,KSIZEF) ICODE(2)=55+KSIZEF CALL TOUTST(2,ICODE) 10 RETURN END c C C----------SUBROUTINE--ALFMOD------------------------TEKTRONIX, INC.---- C SUBROUTINE ALFMOD COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * SET ALPHA MODE OUTPUT (US) CALL TOUTPT(31) KGRAFL=0 KKMODE=0 IF(KBEAMY.GT.KHOMEY) KBEAMY=KHOMEY RETURN END c C C----------SUBROUTINE--NEWPAG------------------------TEKTRONIX, INC.---- C SUBROUTINE NEWPAG COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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) CALL IOWAIT(10) 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 C----------SUBROUTINE--TOUTST------------------------TEKTRONIX, INC.---- C SUBROUTINE TOUTST(LEN,IADE) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION IADE(1) LENOUT=LEN IF(LENOUT .GT. KACHAR)LENOUT=KACHAR CALL BUFFPK(LENOUT,IADE) RETURN END c C C----------SUBROUTINE--TINSTR------------------------TEKTRONIX, INC.---- C SUBROUTINE TINSTR(NCHAR,IADE) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION INBUFF(80),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 CALL TSEND CALL ADEIN(IGOT,INBUFF) IF(KTERM.GE.3) CALL CWSEND 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 C----------SUBROUTINE--IOWAIT------------------------TEKTRONIX, INC.---- C SUBROUTINE IOWAIT(ITIME) C * THIS ROUTINE IS USED TO GENERATE DELAYS FOR REMOTE TERMINALS COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT IF(KBAUDR.LE.0)GO TO 20 KOUNT=ITIME*(KBAUDR/10) DO 10 J=1,KOUNT C * OUTPUT (SYN) TO INSURE AGAINST LOSS OF OUTPUT WHILE C * TERMINAL IS BUSY. (SYN) DOES NOT AFFECT THE TERMINAL. 10 CALL TOUTPT(22) 20 RETURN END c C C----------SUBROUTINE--VECMOD------------------------TEKTRONIX, INC.---- C SUBROUTINE VECMOD COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT IF(KKMODE.EQ.1)GO TO 10 C * OUTPUT (US) TO ENTER A/N MODE AND RESET FOR VECTOR MODE CALL TOUTPT(31) DO 112 II=1,5 112 KPCHAR(II)=-1 KKMODE=1 C * OUTPUT (GS) TO ENTER VECTOR MODE 10 CALL TOUTPT(29) KMOVEF=1 RETURN END c C C----------SUBROUTINE--XYCNVT------------------------TEKTRONIX, INC.---- C SUBROUTINE XYCNVT(IX,IY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION IPLT(5),IOPT(8) DATA IDREW /0/ C * RECEIVE THE PLOT CHARACTERS IX1=MIN0(4095/KFACTR,MAX0(0,IX)) IY1=MIN0(4095/KFACTR,MAX0(0,IY)) CALL PLTCHR(IX1,IY1,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 80 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 70 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 80 KBEAMX=IX1 KBEAMY=IY1 RETURN END c C C----------SUBROUTINE--TOUTPT------------------------TEKTRONIX, INC.---- C SUBROUTINE TOUTPT(KKOUT) DIMENSION KOUT(1) KOUT(1)=KKOUT CALL TOUTST(1,KOUT) RETURN END c C C----------SUBROUTINE--PLTCHR------------------------TEKTRONIX, INC.---- C SUBROUTINE PLTCHR(IX,IY,ICHAR) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION ICHAR(5) C * CALCULATE THE PLOT CHARACTERS TO ARRIVE AT IX,IY C * ORDER IS HIY, LSBYX, LOY, HIX, LOX KX=IX*KFACTR KY=IY*KFACTR 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 11 ITEMP=KPAD2-1 IF(KTERM .LT. 2) GO TO 10 ITEMP=IABS(KBEAMX-IX)+IABS(KBEAMY-IY) ITEMP=ITEMP*KPAD2*KFACTR/8192 + 1 10 KPADV=ITEMP 11 CONTINUE RETURN END c C C----------SUBROUTINE--BUFFPK------------------------TEKTRONIX, INC.---- C SUBROUTINE BUFFPK(NCHAR,IOUT) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT DIMENSION IDATA(80),IOUT(1),ISYNC(5) DATA MAXLEN,LENOUT,NODATA/80,0,1/ DATA ITEMP/0/,ISYNC(1),ISYNC(2),ISYNC(3),ISYNC(4),ISYNC(5)/5*22/ ITRAIL=KTRAIL LEN=NCHAR KOTLFT=MAXLEN-LENOUT-KTRAIL C * DUMP THE BUFFER IF THE MODE IS UNBUFFERED IF(KUNIT .EQ. 4)GO TO 45 C * DUMP THE BUFFER WHEN REQUESTED BY LEN=0 IF(NCHAR .LE. 0)GO TO 10 C * DON'T DUMP THE BUFFER IF NEW STRING WILL FIT KSYNCS=KPADV ISETBK=0 NCH=NCHAR-1 IF(IOUT(1) .GT. 31) ISETBK=MIN0(ITEMP,NCH) IMAXL=KSYNCS+NCHAR-ISETBK IF(IMAXL .LE. KOTLFT)GO TO 70 C * DETERMINE IF THERE IS DATA IN BUFFER 10 IF(NODATA .EQ. 1)GO TO 50 NODATA=1 C * DETERMINE THE FORMAT THE USER WANTS BUFFER DUMPED IN GO TO (20,30,40,45),KUNIT C * OUTPUT BUFFER FORMAT IS (GS),PLTCHRS,DATA,(US) 20 LENOUT=LENOUT+1 C * APPEND (US) TO END OF BUFFER IDATA(LENOUT)=31 CALL ADEOUT(LENOUT,IDATA) C * RESTORE THE BEAM POSITION AT FIRST OF THE NEXT BUFFER ISUB=1 IF(KTERM .GE. 3) ISUB=2 CALL PLTCHR(KBEAMX,KBEAMY,IDATA(ISUB)) IDATA(2)=IDATA(ISUB) LENOUT=5+ISUB IDATA(1)=29 C * AND NOW THE MODE BEFORE THE OUTPUT WAS ASKED FOR DO 19 I=2,KPAD2 IDATA(LENOUT)=22 19 LENOUT=LENOUT+1 KEY=KKMODE+1 IF(KEY .LT. 1)KEY=1 IF(KEY .GT. 5)KEY=1 C * MODE IS A/N,VEC,PNT,INC,DSH GO TO (21, 22, 23, 24, 22),KEY C * ENTER A/N MODE 21 IDATA(LENOUT)=31 GO TO 50 C * IF READY FOR A MOVE, THEN REMOVE FIXUP CHARS 22 IF(KMOVEF .EQ. 1) LENOUT=2 LENOUT=LENOUT-1 C * CHECK IF DASHED LINE OR Z AXIS MUST BE RESTORED IF(KLINE .EQ. 0 .AND. KZAXIS .EQ. 0) GO TO 50 IDATA(LENOUT+1)=27 LENOUT=LENOUT+2 IDATA(LENOUT)=96+KZAXIS*8+KLINE GO TO 50 C * ENTER POINT MODE 23 IF(KTERM .LT. 3)GO TO 22 IDATA(LENOUT)=28 LENOUT=LENOUT+1 GO TO 22 C * ENTER INCREMENTAL PLOT MODE 24 IDATA(LENOUT)=30 C * RAISE OR LOWER PEN AS NEEDED C * THE FOLLOWING 3 LINES ARE NOT NEEDED ON SOME PLOTTERS ************** LENOUT=LENOUT+1 IDATA(LENOUT)=80 IF(KMOVEF .EQ. 1)IDATA(LENOUT)=32 C ********************************************************************** GO TO 50 C * OUTPUT BUFFER FORMAT IS (SYN),DATA,(ESC) 30 IF(NCHAR .LE. 0 .AND. KGNMOD .NE. 1)GO TO 20 LENOUT=LENOUT+1 C * APPEND (ESC) TO END OF BUFFER IDATA(LENOUT)=27 CALL ADEOUT(LENOUT,IDATA) IDATA(1)=22 LENOUT=1 GO TO 50 C * OUTPUT BUFFER FORMAT IS DATA ONLY 40 CALL ADEOUT(LENOUT,IDATA) LENOUT=0 GO TO 50 C * NON-BUFFERED OUTPUT FORMAT 45 IF(LENOUT .GT. 0)CALL ADEOUT(LENOUT,IDATA) IF(LEN .GT. 0)CALL ADEOUT(LEN,IOUT) IF(KPADV .GT. 0)CALL ADEOUT(KPADV,ISYNC) KPADV=0 LENOUT=0 NODATA=1 GO TO 90 50 KOTLFT=MAXLEN-LENOUT-ITRAIL ITEMP=0 ISETBK=0 KPADV=0 IF(LEN .LE. 0) GO TO 90 70 NODATA=0 LENOUT=LENOUT-ISETBK KOTLFT=KOTLFT+ISETBK IF(LEN .GT. KOTLFT)LEN=KOTLFT DO 80 I=1,LEN LENOUT=LENOUT+1 80 IDATA(LENOUT)=IOUT(I) ITEMP=KSYNCS KPADV=0 IF(ITEMP .LE. 0) GO TO 90 DO 85 I=1,ITEMP LENOUT=LENOUT+1 85 IDATA(LENOUT)=22 90 KOTLFT=MAXLEN-LENOUT-ITRAIL RETURN END c C C----------SUBROUTINE--RESCAL------------------------TEKTRONIX, INC.---- C SUBROUTINE RESCAL COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * FLAG THE 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 SECTION AND RETURN C * LINEAR LOG POLAR USER ERROR GO TO (100,200,300,400,500),KEY C * BOTH AXES LINEAR 100 TRPAR1=0. C * SEMI LOG OR LOG LOG 200 KEYL=TRPAR1+1.001 C * X AXIS -- LINEAR OR LOG GO TO (210,215,210,215),KEYL C * LINEAR 210 TRFACX=FLOAT(KMAXSX-KMINSX)/(TMAXVX-TMINVX) GO TO 250 C * PREVENT INVALID TRANSFORMATION 215 IF(TMINVX .GT. 0.0 .AND. TMAXVX .GT. 0.0)GO TO 220 KGNFLG=1 TRPAR1=TRPAR1-1.0 GO TO 210 C * SEMI LOG X AXIS 220 TRPAR2=ALOG(TMINVX) TRFACX=FLOAT(KMAXSX-KMINSX)/(ALOG(TMAXVX)-TRPAR2) C * Y AXIS -- LINEAR OR LOG 250 GO TO (260,260,270,270),KEYL C * LINEAR 260 TRFACY=FLOAT(KMAXSY-KMINSY)/(TMAXVY-TMINVY) GO TO 600 C * PREVENT INVALID TRANSFORMATION 270 IF(TMINVY .GT. 0.0 .AND. TMAXVY .GT. 0.0)GO TO 280 KGNFLG=1 TRPAR1=TRPAR1-2.0 GO TO 260 C * SEMI LOG Y AXIS 280 TRPAR3=ALOG(TMINVY) TRFACY=FLOAT(KMAXSY-KMINSY)/(ALOG(TMAXVY)-TRPAR3) GO TO 600 C * POLAR SCALING 300 CALL PSCAL GO TO 600 C * USER FUNCTION 400 CONTINUE C CALL URSCAL GO TO 600 C * NO SCALE 500 TRFACX=1. TRFACY=1. 600 RETURN END c C C----------SUBROUTINE--LVLCHT------------------------TEKTRONIX, INC.---- C SUBROUTINE LVLCHT COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT IF(KGRAFL.NE.0)GO TO 10 CALL REVCOT(KBEAMX,KBEAMY,TREALX,TREALY) TIMAGX=TREALX TIMAGY=TREALY KGRAFL=1 10 RETURN END c C C----------SUBROUTINE--V2ST--------------------------TEKTRONIX, INC.---- C SUBROUTINE V2ST(I,X,Y,IX,IY) DIMENSION BUFIN(4),BFOUT(4) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 110 C * ARE WE AT START POINT IF(CXS .EQ. TREALX .AND. CYS .EQ. TREALY) GO TO 120 C * MOVE BEAM TO START POINT MODE=KKMODE CALL VECMOD CALL WINCOT(CXS,CYS,IX,IY) CALL XYCNVT(IX,IY) KKMODE=MODE GO TO 120 C * POINT OR MOVE 10 CALL PCLIPT(XE,YE) C * OFF SCREEN IF(KGNFLG .EQ. 1) GO TO 110 CXE=XE CYE=YE C * CONVERT TO SCREEN COORDINATES 120 CALL WINCOT(CXE,CYE,IX,IY) C * SAVE POSITION ABS AND IMAGINARY TREALX=CXE TREALY=CYE 110 TIMAGX=X TIMAGY=Y RETURN END c C C----------SUBROUTINE--PNTMOD------------------------TEKTRONIX, INC.---- C SUBROUTINE PNTMOD COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * CANCEL PREVIOUS MODES - OUTPUT (US) CALL TOUTPT(31) DO 111 II=1,5 111 KPCHAR(II)=-1 KKMODE=2 C * FOR HARDWARE POINT PLOT OUTPUT AN (FS) IF(KTERM .GE. 3)CALL TOUTPT(28) RETURN END c C C----------SUBROUTINE--TKPNT-------------------------TEKTRONIX, INC.---- C SUBROUTINE TKPNT(IX,IY) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT C * THIS SECTION IS FOR 4014 ENHANCED ********************************** C IF(KTERM .GE. 3)GO TO 10 C ********************************************************************** C * PUT OUT A GS FOR SIMULATED POINT PLOT MODE 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 C----------SUBROUTINE--CLIPT-------------------------TEKTRONIX, INC.---- C SUBROUTINE CLIPT(BUFIN,OUTBF) DIMENSION BUFIN(4),OUTBF(4) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 110 10 IF(GSTAX.LE.TMAXVX)GO TO 20 IF(GENDX.LE.TMAXVX)GO TO 20 GO TO 110 20 IF(GSTAY.GE.TMINVY)GO TO 21 IF(GENDY.GE.TMINVY)GO TO 30 GO TO 110 21 IF(GSTAY.LE.TMAXVY)GO TO 30 IF(GENDY.LE.TMAXVY)GO TO 30 GO TO 110 30 IF(GSTAX.NE.GENDX)GO TO 31 DSTAX=GSTAX DENDX=GSTAX CALL PARCLT(GSTAY,GENDY,TMINVY,TMAXVY,DSTAY,DENDY) GO TO 120 31 IF(GSTAY.NE.GENDY)GO TO 40 DSTAY=GSTAY DENDY=GSTAY CALL PARCLT(GSTAX,GENDX,TMINVX,TMAXVX,DSTAX,DENDX) GO TO 120 40 A=GENDX-GSTAX B=GENDY-GSTAY IF(GSTAX.LT.TMINVX)GO TO 41 IF(GSTAX.LE.TMAXVX)GO TO 43 Q=TMAXVX GO TO 42 43 IF(GSTAY.GT.TMAXVY)GO TO 140 IF(GSTAY.LT.TMINVY)GO TO 44 DSTAX=GSTAX DSTAY=GSTAY GO TO 150 41 Q=TMINVX 42 DSTAY=GSTAY+((Q-GSTAX)*B/A) IF(DSTAY.GT.TMAXVY)GO TO 140 IF(DSTAY.LT.TMINVY)GO TO 44 DSTAX=Q GO TO 150 44 R=TMINVY GO TO 45 140 R=TMAXVY 45 DSTAX=GSTAX+((R-GSTAY)*A/B) IF(DSTAX.GT.TMAXVX)GO TO 110 IF(DSTAX.LT.TMINVX)GO TO 110 DSTAY=R 150 IF(GENDX.LT.TMINVX)GO TO 50 IF(GENDX.GT.TMAXVX)GO TO 51 IF(GENDY.GT.TMAXVY)GO TO 160 IF(GENDY.LT.TMINVY)GO TO 52 DENDX=GENDX DENDY=GENDY GO TO 120 51 Q=TMAXVX GO TO 53 50 Q=TMINVX 53 DENDY=GSTAY+((Q-GSTAX)*B/A) IF(DENDY.GT.TMAXVY)GO TO 160 IF(DENDY.LT.TMINVY)GO TO 52 DENDX=Q GO TO 120 52 R=TMINVY GO TO 60 160 R=TMAXVY 60 DENDX=GSTAX+((R-GSTAY)*A/B) DENDY=R 120 OUTBF(1)=DSTAX OUTBF(2)=DSTAY OUTBF(3)=DENDX OUTBF(4)=DENDY KGNFLG=0 GO TO 70 C * SET FLAG IF LINE OUTSIDE WINDOW 110 KGNFLG=1 70 RETURN END c C C----------SUBROUTINE--PCLIPT------------------------TEKTRONIX, INC.---- C SUBROUTINE PCLIPT(X,Y) COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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 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 20 RN1=RL1 IF(RL2-RM1)30,40,40 10 RN1=RM1 40 IF(RL2.LE.RM2)GO TO 50 RN2=RM2 GO TO 60 50 RN2=RL2 GO TO 60 20 RN1=RM2 IF(RL2.GE.RM1)GO TO 50 30 RN2=RM1 60 RETURN END c C C----------SUBROUTINE--TSEND-------------------------TEKTRONIX, INC.---- C SUBROUTINE TSEND DIMENSION ITEMP(1) CALL BUFFPK(0,ITEMP) RETURN END c C C----------SUBROUTINE--RECOVR------------------------TEKTRONIX, INC.---- C SUBROUTINE RECOVR COMMON /TKTRNX/ TMINVX,TMINVY,TMAXVX,TMAXVY,TREALX,TREALY, & TIMAGX,TIMAGY,TRCOSF,TRSINF,TRSCAL,TRFACX,TRFACY, & TRPAR1,TRPAR2,TRPAR3,TRPAR4,TRPAR5,TRPAR6,KMOFLG(2), & KGNMOD,KPADV,KACHAR,KOBLEN,KTRAIL,KLEVEL,KPAD2, & KBAUDR,KGNFLG,KGRAFL,KHOMEY,KKMODE,KHORSZ,KVERSZ,KTBLSZ, & KSIZEF,KLMRGN,KRMRGN,KFACTR,KTERM,KLINE,KZAXIS,KBEAMX,KBEAMY, & KMOVEF,KPCHAR(5),KDASHT,KMINSX,KMINSY,KMAXSX,KMAXSY,KEYCON, & KINLFT,KOTLFT,KUNIT 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) C * SET THE HARDWARE DASH AND Z-AXIS WHEN NEEDED 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 (100,200,120,100,200),MODE 100 CALL ALFMOD GO TO 200 120 CALL PNTMOD C * RESTORE THE GRAPHIC LEVEL FLAG 200 KGRAFL=IFLAG RETURN END c C SUBROUTINE ADEIN(NCHAR,IARAY) DIMENSION IARAY(1),KARAY(72) C C 860527;rb C lab of phys chem C READ 5, KARAY 5 FORMAT(72A1) DO 10 K=1,72 IF (KARAY(73-K).NE.' ') GO TO 20 10 CONTINUE NCHAR=0 RETURN 20 NCHAR=73-K DO 30 I=1,NCHAR IARAY(I)=IAND(KARAY(I),127) 30 CONTINUE RETURN END C SUBROUTINE ADEOUT(NCHAR,IARAY) C C 860427;rb C lab of physical chemistry C DIMENSION IARAY(1) BYTE KARAY(80) C C check for NCHAR = 0 IF (NCHAR.EQ.0) RETURN C check for NCHAR > 80 IF (NCHAR.GT.80) THEN PRINT *,(' TCS OVERFLOW'),NCHAR STOP ENDIF DO 50 I=1,NCHAR KARAY(I)=IAND(IARAY(I),127) 50 CONTINUE CALL SEND (NCHAR,KARAY) RETURN END C c......... VAX/VMS specific c SUBROUTINE SEND(NCHARS,ARRAY) C C AJC 2/27/84 C RB 12/23/87 C INCLUDE '($IODEF)' INCLUDE '($SSDEF)' INCLUDE '($TTDEF)' C BYTE ARRAY(1) C INTEGER*4 SYS$QIOW,ICHAN INTEGER*2 IOSB(4) C COMMON /IOINFO/ ICHAN C IFUNC = IO$_WRITEVBLK + IO$M_NOFORMAT C IRETURN = SYS$QIOW(,%VAL(ICHAN),%VAL(IFUNC),,,, 1 ARRAY,%VAL(NCHARS),,,,) C IF (IRETURN.NE.1) CALL ERRMSG(IRETURN) RETURN END c SUBROUTINE CHANNEL INTEGER*4 SYS$ASSIGN,ICHAN COMMON /IOINFO/ ICHAN LOGICAL LFLAG DATA LFLAG/.TRUE./ IF (LFLAG) THEN IRETURN = SYS$ASSIGN('TT:',ICHAN,,) LFLAG=.FALSE. ENDIF RETURN END c