PROGRAM MIPLOT C C Program to read plot instructions from intermediate plot file C and pack them into buffer to be sent directly to WANATABE 'MIPLOT' C flatbed plotter. C C THIS PROGRAM WAS CONVERTED FROM P-E FORTRAN '77 TO LSI FORTRAN '66. C C ****** DO NOT USE DEC F77 ON IT ******** 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 selection 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 8 = Plot Device (MIPLOT) C BYTE PENMOV(10) INTEGER*4 IPNO INTEGER*2 HOME LOGICAL EQBYT C BYTE PNAME(10),FNME(80),RNAME(30) INTEGER*4 INREC(20), NCHAR INTEGER*2 PTR(99), POINTR(99), BYTPTR C BYTE IZ,BLNK,IANS BYTE INBUFF(80) BYTE FUNC INTEGER*4 DATE(2), TIME(2), XMIN(2), XMAX(2), YMIN(2), YMAX(2) BYTE MBUF(64) 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 HOME /"000110/ !PEN TO HOME POSITION DATA PENMOV /10*"15/ DATA LTHPLT /80/ !LOGICAL RECORD LENGTH DATA IZ/1H0/, BLNK/1H / 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) C OPEN(UNIT=4,NAME='PL:',FORM='UNFORMATTED',RECORDSIZE=3, 1 ERR=300,TYPE='OLD') C D OPEN (UNIT=7,FORM='FORMATTED', RECORDSIZE=80, NAME='MIPLOT.LU7', D 1 ACCESS='SEQUENTIAL', TYPE='NEW') 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 PRINT 20, NPLT, NPLOTS 20 FORMAT ('ERROR: PLOT',I3,' REQUESTED BUT ONLY',I3,' EXIST.') GO TO 12 C C READ THE GLOBAL HEADER RECORD C 25 READ (1'1) INBUFF C C READ THE PLOT'S EXTREMA INFORMATION. C 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 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 C C ERROR: FUNCTION OUT OF RANGE. C PRINT 42, BYTPTR, NREC 42 FORMAT (' ERROR: BYTE',I4,' OF REC',I5,' NOT A DEFINED FUNCTION.') 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 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 PRINT 48, NREC,BYTPTR,NCHAR 48 FORMAT (' ERROR: OPERATOR MESSAGE NOT 1-64. ', 1 'REC=',I5,' BYTE=',I4,' VALUE=',I5) STOP C C BLANK OUT THE MESSAGE BUFFER. C 50 CALL FILBYT (' ',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 PRINT 65, (MBUF(I),I=1,NCHAR) 65 FORMAT (64A1) C C PAUSE FOR OPERATOR INTERVENTION C PAUSE C GO TO 200 C C IS IT 'PLOT START'? C 80 IF (FUNC.NE.'A') GO TO 90 C C PLACE PEN IN HOME POSITION. C CALL SEND (HOME,2) C BYTPTR =BYTPTR+8 !BYPASS X,Y FIELDS C GO TO 200 C C IS IT 'PLOT STOP'? C 90 IF (FUNC.NE.'B') GO TO 100 C C MOVE PEN TO HOME POSITION. C CALL SEND (HOME,2) C IF (NPLOTS.EQ.1) STOP GO TO 12 C C IS IT A PEN COLOR SELECTION? C 100 IF (FUNC.EQ.'P') GO TO 130 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 C C CONSTRAIN COORDINATES TO DEVICE LIMITS. C IF (X.LT.0) X =0. IF (X.GT.36.) X =36. IF (Y.LT.0.) Y =0. IF (Y.GT.26.) Y =26. C C CONVERT THE CM. TO DEVICE UNITS. C IX =X*100 IY =Y*100 C C NOW ASSEMBLE THE INSTRUCTION. C IF (FUNC.EQ.'C') ENCODE (10,110,PENMOV) IX,IY !PEN UP 110 FORMAT ('M',I4,',',I4) IF (FUNC.EQ.'D') ENCODE (10,115,PENMOV) IX,IY !PEN DOWN 115 FORMAT ('D',I4,',',I4) C C NOW REPLACE LEADING BLANKS WITH ASCII 0'S. C DO 120 I=1,8 IF (EQBYT (PENMOV,I,BLNK,0,1)) CALL CPYBYT (IZ,0,PENMOV,I,1) 120 CONTINUE D WRITE (7,9990) PENMOV D9990 FORMAT (' PENMOV: ',10A1) C CALL SEND (PENMOV,10) GO TO 200 C C IT IS A COLOR PEN SELECTION. C 130 BYTPTR = BYTPTR+4 CALL CPYBYT (INREC,BYTPTR-1,IPNO,0,4) BYTPTR =BYTPTR+4 IF (IPNO.GT.0.AND.IPNO.LT.7) GO TO 140 C C RANGE ERROR ON PEN NUMBER. C PRINT *,'ARGUMENT TO SUBR "COLOR" OUT OF RANGE.' STOP C C SEND THE PEN COMMAND. C 140 ENCODE (2,145,PENMOV) IPNO 145 FORMAT ('J',I1) CALL SEND (PENMOV,2) 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 PRINT *,'ERROR: UNEXPECTED END OF PLOT FILE.' STOP C C READ THE NEXT RECORD. C 240 READ (1'NREC) INBUFF BYTPTR =1 GO TO 40 300 TYPE 301 301 FORMAT('0Cant attach to device= PL:',/) C END SUBROUTINE SEND (STREAM,NBYTES) C C SUBROUTINE TO SEND A COMMAND STREAM OF LENGTH 'NBYTES' GO C 'MIPLOT' DEVICE. C C THIS SUBROUTINE REPLACES A MOVE COMPLICATED ONE REQUIRED FOR C THE P-E VERSION. C BYTE STREAM(10) C DATA LU/4/ C D WRITE (7,9990) NBYTES, STREAM D9990 FORMAT (' NBYTES, STREAM:',I5,10A1) WRITE (LU) (STREAM(I), I=1,NBYTES) C RETURN END