Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/unplot.for
There is 1 other file named unplot.for in the archive. Click here to see a list.
PROGRAM UNPLOT !Translates PLT file to CALL PLOT
DIMENSION ITEXT(16) !80 characters
EXTERNAL READER !Subroutine to do input
EXTERNAL PLOT,NEWPEN,OPRTXT,PAUSEP,TITLE !Required routines from FORLIB
EXTERNAL TOLP !Use LOAD FOR:UNPLOT.FOR,REL:TOLP.REL
TYPE 10
10 FORMAT(' Name of PLT file: ',$)
ACCEPT 20, ITEXT !Get name from user
20 FORMAT(16A5)
OPEN(UNIT=1,DIALOG=ITEXT,ACCESS='SEQIN',MODE='IMAGE')
CALL PLOTS(IERR,'TTY') !Initialize the graphics terminal
IF(IERR.NE.0) STOP 'Cannot start plotting'
CALL FACTOR(0.7) !Make it fit on TEK or GIGI screen
K=NEWPEN(3)
C IFLAG = 5003 !Do header and trailer with wraparound
C IFLAG = 4400 !No header/trailer with wraparound
IFLAG = 0 !Ignore header/trailer in file
CALL TOLP(READER,IFLAG,ITEXT) !Read plot file, call subroutine PLOT
CALL PLOT(X,Y,999) !Proper end to the plot
IF(IFLAG.EQ.0) IFLAG = 16 !Output full file name if no errors
TYPE 30, (ITEXT(I),I=1,IFLAG) !Type the returned error message
30 FORMAT(1X,16A5)
END
********************************************************************************
SUBROUTINE READER(JWORD) !Called from inside TOLP
READ(1,ERR=40) JWORD !Read 1 binary word from .PLT file
RETURN !OK
40 JWORD = -1 !Minus one means End-of-File
RETURN
END
********************************************************************************
* The following dummy subroutines will write subroutine calls in PLOT.OUT *
* PLOTS,PLOT,NEWPEN,OPRTXT,PAUSEP,TITLE *
********************************************************************************
SUBROUTINE PLOTS(IERR,IPLT)
OPEN (UNIT=2,FILE='PLOT.OUT')
WRITE (2,5)
5 FORMAT(8X,'CALL PLOTS(IERR,IPLT)')
IERR = 0
RETURN
END
********************************************************************************
SUBROUTINE PLOT(X,Y,I)
IF(Y.LT.99.0) WRITE (2,10) X,Y,I
10 FORMAT(8X,'CALL PLOT(',F6.3,',',F6.3,',',I3,')')
IF(Y.GT.99.0) WRITE (2,11)
11 FORMAT(8X,'CALL PLOT(',F6.3,',',F8.3,',',I3,')')
IF(I.EQ.999) WRITE(2,12)
12 FORMAT(8X,'END')
RETURN
END
********************************************************************************
SUBROUTINE NEWPEN(IPEN,IERR)
WRITE (2,20) IPEN
20 FORMAT(8X,'CALL NEWPEN(',I1,',IERR)')
RETURN
END
********************************************************************************
SUBROUTINE PAUSEP(ISEC)
WRITE (2,30) ISEC
30 FORMAT(8X,'CALL PAUSEP(',I3,')')
RETURN
END
********************************************************************************
SUBROUTINE OPRTXT(IMESAG,NCHAR)
TYPE 40
40 FORMAT(' Call to OPRTXT ignored')
RETURN
END
********************************************************************************
SUBROUTINE TITLE(X,Y,HEIGHT,ISTRNG,ANGLE,NCHAR)
TYPE 50
50 FORMAT(' TOLP was not supposed to call TITLE')
RETURN
END