C READ NEUTRAL PLOT FILE AND CREATE PLOT C C This program reads a binary plot file produced by user programs C task-built with $PFLIB rather than a device specific plotting C library. It translates the coded records into common plotting C routine calls. This program may be task built with each C library to yield a version for each plotting device. C C The command line is C C PLOTxx filename, nframe, charsetno C C where filename defaults to PLOT.PLT, and nframe is the C number of the first frame to plot, defaulting to the first. C If nframe is negative, it will prompt for the pen colour C translation (useful when using odd pens). C Charsetno, if given, specifies the default Hershey character C set to use, default 3. Specifying 5 gives the complex set. C C This command line is translated by CCL into C RUN SF:[5,3]PLOTxx/CMD="PLT filename.PLT, nframe, charsetno" C C If the task is run without giving a command line, it will C prompt for a command line with a colon; the above command C line should be entered, but without the PLT taskname. C C Each record has a variable length, but well defined format: C Byte 1 = length of record in bytes, including this one. C Byte 2 = subroutine code (0=PLOTS, 1=PLOTF, 2=PLOT, 3=SYMBOL ...) C The rest are real or integer parameters, arranged so that the C real number are on double word boundaries. C Note that the length must be at least two. C C This program can use either hardware or software character sets. C Task build appropriately. C C NOTE: This program is computer-dependent since it assumes a certain C format for the records which is reads from the plot file. C This format must agree with that written by the subroutines in PFSUBS. C In particular it requires INTEGER*2 for all encoded integers in the C records. This is known to work for the PDP-11 and the VAX computers. C C C David Villeneuve C Division of Physics M23A C National Research Council C Ottawa Ont. K1A 0R6 C 613-993-9975 C INTEGER IPENS(4), IARG(10) INTEGER*2 ITYPE BYTE LINE(100) LOGICAL CPLOTF C C STORAGE FOR BYTE BUFFER FROM BINARY READ C BYTE BBUF(28) INTEGER*2 IBUF(14) REAL RBUF(7) EQUIVALENCE (BBUF(1), IBUF(1), RBUF(1)) C C LENGTH OF BINARY RECORD IS A BYTE C INTEGER*2 LEN BYTE LENB EQUIVALENCE (LEN, LENB) DATA CPLOTF /.FALSE./ C C GET COMMAND LINE, SEE IF STARTING FRAME NUMBER IS GIVEN C CALL PARSCL (LINE, IARG, NARG) IFRAME = 1 IF (NARG .GE. 2 .AND. LENGTH(LINE(IARG(2))) .GT. 0) 1 IFRAME = FPCONV( LINE(IARG(2)), LENGTH(LINE(IARG(2))), 1, L ) IF (IFRAME .EQ. 0) IFRAME = 1 IF (NARG .GE. 3 .AND. LENGTH(LINE(IARG(3))) .GT. 0) 1 KSETNO = FPCONV( LINE(IARG(3)), LENGTH(LINE(IARG(3))), 1, L ) C C GET FILENAME, ADD .PLT IF NECESSARY, OPEN FILE ON LUN 2. C NOTE THAT IF .PLT IS ADDED, IT DESTROYS THE REST OF THE COMMAND LINE. C CALL FDBSET (2, 'READONLY') IFF (NARG .GE. 1 .AND. LENGTH(LINE(IARG(1))) .GT. 0) THEN { CALL INDEXC (INDEX, '.', LINE(IARG(1)) ) IF (INDEX .LE. 0) CALL CONCAT (LINE(IARG(1)), '.PLT') CALL ASSIGN (2, LINE(IARG(1))) } ELSE CALL ASSIGN (2, 'PLOT.PLT') C C IF IFRAME IS NEGATIVE, ASK FOR PEN TRANSLATION C FOR J=1,4 IPENS(J) = J !ASSUME NO PEN TRANSLATION IFF (IFRAME .LT. 0) THEN { WRITE (5,%%) FORMAT (' Enter pen numbers to use for pens 1-4 [0,0,0,0]: ',$) READ (5,%%) IPENS FORMAT (4I10) IFRAME = -IFRAME } C C SKIP THOSE FRAMES TO BE IGNORED C IF (IFRAME .LE. 0) IFRAME = 1 WHILE (IFRAME .GT. 0) { READ(2, END=1000) ITYPE !LOOK FOR PLOTS CALLS IF (ITYPE .EQ. 2) IFRAME = IFRAME-1 } CALL PLOTS !INITIALIZE PLOTTER LEN = 0 !ENSURE HIGH ORDER BYTE ZERO C C SPECIFY THE DEFAULT CHARACTER SET. THIS ONLY WORKS WITH THE HERSHEY C VERSION OF THE SYMBOC ROUTINE, AND IS IGNORED BY OTHERS. C IF (KSETNO .LT. 3 .OR. KSETNO .GT. 20) KSETNO = 3 CALL SYMBOC (0.0, 0.0, 0.0, 0, 0.0, 0, KSETNO) C C READ THROUGH EACH RECORD, TRANSLATE INTO PLOTTER ROUTINE CALLS C REPEAT { READ(2, END=1000) LENB, (BBUF(K), K=2,LEN) IFF (BBUF(2) .EQ. 2) THEN { IPEN = IBUF(2) !FOR VAX, I*2 TO I*4 CALL PLOT (RBUF(2), RBUF(3), IPEN) } ELSEIF (BBUF(2) .EQ. 3) THEN { LENTH = IBUF(2) READ(2, END=1000) ITYPE, (LINE(K), K=1,LENTH) IF (IBUF(12) .LT. 0) LENTH = IBUF(12) !SPECIAL SYMBOLS ICENTR = IBUF(11) CALL SYMBOC (RBUF(2), RBUF(3), RBUF(4), LINE, RBUF(5), 1 LENTH, ICENTR) } ELSEIF (BBUF(2) .EQ. 0) THEN { IF (CPLOTF) CALL PLOTF !PREVIOUS CALL WAS PLOTF CALL PLOTS CPLOTF = .FALSE. } ELSEIF (BBUF(2) .EQ. 1) THEN CPLOTF = .TRUE. !PREVENT UNECESSARY PEN MOVEMENT FOR HP ELSEIF (BBUF(2) .EQ. 4) THEN { IPEN = IBUF(2) CALL SYMTYP (IPEN, RBUF(2)) } ELSEIF (BBUF(2) .EQ. 5) THEN { IP = IBUF(2) IF (IP .GT. 0 .AND. IP .LE. 4) IP = IPENS(IP) !PEN CHANGE CALL NEWPEN (IP) } C ELSEIF (BBUF(2) .EQ. 6) C THEN C CALL NPLLT (IBUF(2), IBUF(3), IBUF(4), IBUF(5)) ELSE { WRITE (5,%%) BBUF(2) FORMAT (' ROUTINE CODE', I5, ' IS NOT RECOGNIZED') } } C C END OF FILE C 1000 CALL PLOTF !IN CASE HE FORGOT CALL EXIT END