PROGRAM TK4006 C C Program to read plot instructions from intermediate plot file C and pack them into buffer to be sent directly to TEKTRONIX 4006-1 C flatbed plotter. C C THIS VERSION WAS CONVERTED FROM P-E FORTRAN '77 TO C LSI FORTRAN '66. C C Record 1 is the global record as follows: C 1- 8 DATE (ASCII) C 13-20 TIME (ASCII) C 21-24 NPLOTS (BINARY) C 49-50 RECORD POINTER, 1ST PLOT (BINARY) C 51-52 " " 2ND " " C ETC C C The first record of each plot has the following layout: C C 1- 8 Plot minimum x value (ASCII, F8.2) C 9-16 " maximum " " " C 16-24 " minimum Y " " C 25-32 " maximum " " " C 50-80 Plot instructions C C All other plot records contain plot instructions in bytes 1-248. C C Each plot command is made up of 9 bytes as follows: C C Byte 1, command (ASCII): C A = Plot Start C B = Plot Stop C C = Move Pen Up C D = Move Pen Down C E = Message to operator C F = SYMBOL start C G = SYMBOL stop C H = NUMBER start C I = NUMBER stop C J = AXIS start C K = AXIS stop C L = DSHLIN start C M = DSHLIN stop C N = LINE start C O = LINE stop C P = COLOR select (ignored by this program) C C Bytes 2-5, X value (REAL*4) C Bytes 6-9, Y value " C C For Message to Operator (command=E), bytes 2-5 will be C the number of characters in the message (INTEGER*4). The C message will then occupy the next contiguous bytes. C C LU 1 = Intermediate Plot File C LU 2 = Interaction device (CON:) C LU 8 = Plot Device (TEK 4006-1) C INTEGER*2 ALPHA, GRAFIC C INTEGER*4 INREC(20), NCHAR INTEGER*2 PTR(99), POINTR(99), BYTPTR INTEGER*4 DATE(2),TIME(2),XMIN(2),XMAX(2),YMIN(2),YMAX(2) C BYTE INBUFF(80),FNME(80),RNAME(30) BYTE FUNC INTEGER*4 MSGBUF(16) BYTE MBUF(64) BYTE XLAB,YLAB,IANS BYTE A,B,C,D,E,F,O,P C COMMON /MRDOK/ IDEV C EQUIVALENCE (INBUFF,INREC), (DATE,INBUFF(1)), (TIME,INBUFF(13)) EQUIVALENCE (NPLTS,INBUFF(21)), (POINTR(1),INBUFF(49)) EQUIVALENCE (XMIN,INBUFF(1)), (XMAX,INBUFF(9)) EQUIVALENCE (YMIN,INBUFF(17)), (YMAX,INBUFF(25)) EQUIVALENCE (MSGBUF,MBUF) EQUIVALENCE (FNME(4),RNAME) C DATA A/'A'/, B/'B'/, C/'C'/, D/'D'/, E/'E'/, F/'F'/, O/'O'/ DATA P/'P'/ DATA ALPHA /"37/ !US DATA GRAFIC /"35/ !GS DATA XLAB/'X'/, YLAB/'Y'/ C LTHPLT =80 CMXMAX =38.07 CMYMAX =25.38 C IDEV=1 C C GET PARAMETERS C CALL GETMCR(FNME,ILEN) IF (ILEN.GT.3)GOTO 7 TYPE 5 5 FORMAT (' ENTER NAME OF IPF -> ',$) ACCEPT 6,RNAME 6 FORMAT (30A1) RNAME(30)=0 GOTO 8 7 FNME(ILEN+1)=0 C C OPEN THE INPUT FILE C C C 8 OPEN (UNIT=1, FORM='UNFORMATTED', RECORDSIZE=20, NAME=RNAME, 1 ACCESS='DIRECT', TYPE='OLD',READONLY) D OPEN (UNIT=7,FORM='FORMATTED',RECORDSIZE=80,NAME='TK4006.LU7', D 1 ACCESS='SEQUENTIAL',TYPE='NEW') C C OPEN TI: OF TEKTRONIX OUTPUT C OPEN(UNIT=8,NAME='TI:') C C READ THE GLOBAL HEADER RECORD C READ (1'1) INBUFF C C MAXIMUM OF 99 PLOTS C IF (NPLTS.GT.99) NPLTS=99 C C SAVE THE FILE START POINTER. C DO 10 I=1,NPLTS 10 PTR(I) =POINTR(I) C C SAVE THE NUMBER OF PLOTS C NPLOTS =NPLTS C NPLT =NPLOTS IF (NPLOTS.EQ.1) GO TO 25 C C WHICH PLOT IS REQUIRED? C 12 TYPE 15, NPLOTS 15 FORMAT (' WHICH PLOT DO YOU WANT? (1-',I2,1H) / 1 ' ENTER 0 IF FINISHED.') ACCEPT *, NPLT C IF (NPLT.EQ.0) STOP C C RANGE CHECK THE PLOT WANTED C IF (NPLT.GE.1.AND.NPLT.LE.NPLOTS) GO TO 25 C C ERROR: REQUESTED PLOT IS OUT OF RANGE. C ENCODE (43,20,MSGBUF) NPLT,NPLOTS 20 FORMAT ('ERROR: PLOT',I3,' REQUESTED BUT ONLY',I3,' EXIST.') CALL CONMSG (43,MSGBUF) GO TO 12 C C READ THE PLOT'S EXTREMA INFORMATION. C 25 NREC =PTR(NPLT) !1ST PLOT RECORD C READ (1'NREC) INBUFF C C SET THE BUFFER POINTER TO START OF PLOT COMMANDS. C BYTPTR =50 C C CHECK THIS PLOT'S DIMENSION EXTREMA. C DECODE (32,28,INBUFF) XLOW,XHI,YLOW,YHI 28 FORMAT (4F8.2) D WRITE (7,9990) XLOW,XHI,YLOW,YHI D9990 FORMAT (' XLOW,XHI,YLOW,YHI: ',4F8.2) C IF (XLOW.LT.0..OR.XHI.GT.CMXMAX) GO TO 30 IF (YLOW.GE.0..AND.YHI.LE.CMYMAX) GO TO 40 C C GIVE WARNING OF EXTREMA OUT OF RANGE. C 30 ENCODE (48,32,MSGBUF) 32 FORMAT (' WARNING: YOUR PLOT DIMENSIONS ARE OUT OF RANGE.') CALL CONMSG(48,MSGBUF) C ENCODE (63,33,MSGBUF) XLAB,XLOW,XHI,0.,CMXMAX 33 FORMAT ('PLOT ',A1,' VALUES ARE',F8.2,'-',F8.2, 1 '; LIMITS ARE',F6.2,'-',F6.2,' CM.') CALL CONMSG(63,MSGBUF) ENCODE (63,33,MSGBUF) YLAB,YLOW,YHI,0.,CMYMAX CALL CONMSG (63,MSGBUF) C ENCODE (36,34,MSGBUF) 34 FORMAT (' TYPE EITHER "CONTINUE" OR "ABORT". ') CALL CONMSG (36,MSGBUF) C PAUSE C C IS THE NEXT BYTE A RECOGNIZED FUNCTION? C 40 FUNC =INBUFF(BYTPTR) BYTPTR =BYTPTR+1 IF (FUNC.GE.A.AND.FUNC.LE.P) GO TO 45 D WRITE (7,9991) BYTPTR,FUNC D9991 FORMAT (' BYTPTR, FUNC: ',I2,1X,A1) C C ERROR: FUNCTION OUT OF RANGE. C ENCODE (52,42,MSGBUF) 42 FORMAT (' ERROR: BYTE',I4,' OF REC',I5,' NOT A DEFINED FUNCTION.') CALL CONMSG (52,MSGBUF) STOP C C IGNORE START/STOP FUNCTIONS. C THIS ARE FOR THE INTERMEDIATE PLOT FILE INSPECTION UTILITY. C 45 IF (FUNC.GE.F.AND.FUNC.LE.O) GO TO 200 C C IS IT AN OPERATOR MESSAGE? C IF (FUNC.NE.E) GO TO 80 C C IT IS AN OPERATOR MESSAGE. C C SWITCH TO A/N MODE: SEND US. C CALL BUFOUT (1,ALPHA,0) C C FLUSH OUT THE ADE BUFFER IN 'BUFOUT'. C CALL BUFOUT (-1,0,0) C C HOW MANY CHARACTERS IN THE MESSAGE? C CALL CPYBYT (INREC,BYTPTR-1,NCHAR,0,4) BYTPTR =BYTPTR+4 C C RANGE CHECK THE NUMBER OF CHARACTERS. C IF (NCHAR.GE.1.AND.NCHAR.LE.64) GO TO 50 C C ERROR. C ENCODE (66,48,MSGBUF) NREC,BYTPTR,NCHAR 48 FORMAT (' ERROR: OPERATOR MESSAGE NOT 1-64. ', 1 'REC=',I5,' BYTE=',I4,' VALUE=',I5) CALL CONMSG (66,MSGBUF) STOP C C BLANK OUT THE MESSAGE BUFFER. C 50 CALL FILBYT (' ',0,MSGBUF,0,64) C C ASSEMBLE THE PLOT LINE C DO 60 I=1,NCHAR C C ENSURE THAT THERE IS A BYTE AVAILABLE. C IF (BYTPTR.LE.LTHPLT) GO TO 58 C C WE MUST READ IN THE NEXT RECORD. C NREC =NREC+1 C C IS THIS THE LAST PLOT? C IF (NPLT.EQ.NPLOTS) GO TO 55 C C SEE IF WE ARE BEYOND THIS PLOT. C IF (NREC.GT.PTR(NPLT+1)) GO TO 220 C C READ THE NEXT RECORD C 55 READ (1'NREC) INBUFF BYTPTR =1 C C TRANSFER THE BYTE ACROSS C 58 MBUF(I) =INBUFF(BYTPTR) BYTPTR =BYTPTR+1 C 60 CONTINUE C C NOW LOG THE MESSAGE. C ENCODE (64,65,MSGBUF) (MBUF(I),I=1,NCHAR) 65 FORMAT (64A1) CALL CONMSG (64,MSGBUF) C C PAUSE FOR OPERATOR INTERVENTION C PAUSE C C SET TERMINAL TO GRAPHICS MODE. C CALL BUFOUT (1,GRAFIC,0) C C NOTE: NEXT VECTOR WILL BE DARK. C C GO TO 200 C C IS IT 'PLOT START'? C 80 IF (FUNC.NE.A) GO TO 90 C CALL PLOTUP C BYTPTR =BYTPTR+8 !BYPASS X,Y FIELDS GO TO 200 C C IS IT 'PLOT STOP'? C 90 IF (FUNC.NE.B) GO TO 100 C CALL PLOTDN C IF (NPLOTS.EQ.1) STOP GO TO 12 C C IS IT A COLOR SELECTION? C 100 IF (FUNC.EQ.P) GO TO 120 C C IT MUST BE A PEN MOVE. C GET THE X,Y COORDINATES. C CALL CPYBYT (INREC,BYTPTR-1,X,0,4) BYTPTR =BYTPTR+4 CALL CPYBYT (INREC,BYTPTR-1,Y,0,4) BYTPTR =BYTPTR+4 D WRITE (7,9992) FUNC,X,Y D9992 FORMAT (' FUNC,X,Y: ',A1,2F8.2) C C MOVE WITH PEN UP (C) OR PEN DOWN (D). C IF (FUNC.EQ.C) CALL PENMOV (X,Y,0) !UP IF (FUNC.EQ.D) CALL PENMOV (X,Y,1) !DOWN GO TO 200 C C IT IS A COLOR SELECTION. C IGNORE IT. C 120 BYTPTR =BYTPTR+8 GO TO 200 C C IS THERE ROOM IN THIS RECORD FOR ANOTHER 9-BYTE SET? C 200 IF (BYTPTR+8.LE.LTHPLT) GO TO 40 C C WE MUST READ ANOTHER RECORD. C NREC =NREC+1 C C IS THIS THE LAST PLOT? C IF (NPLT.EQ.NPLOTS) GO TO 240 C C SEE IF WE ARE BEYOND THIS PLOT. C IF (NREC.LE.PTR(NPLT+1)) GO TO 240 C C ERROR: UNEXPECTED END OF PLOT FILE. C 220 CALL CONMSG (35,35HERROR: UNEXPECTED END OF PLOT FILE.) STOP C C READ THE NEXT RECORD. C 240 READ (1'NREC) INBUFF BYTPTR =1 GO TO 40 C END