1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
PROGRAM EXPGMF
C-----------------------------------------------------------------------
C This is a simple program to examine the pictures contained in a
C PGPLOT metafile, displaying them one at a time on a selected PGPLOT
C device. Options are provided for converting color pictures to
C monochrome or grey scale.
C-----------------------------------------------------------------------
CHARACTER*80 FILE
CHARACTER*8 OPT
INTEGER I, ISTAT, NPICT, PGOPEN
C
FILE = 'pgplot.pgmf'
C
C Scan the metafile to find number of pictures
C
CALL PGEXMF(FILE, NPICT, ISTAT)
WRITE (*,*) 'Number of pictures in metafile:', NPICT
C
C Open output graphics device
C
ISTAT = PGOPEN('?')
IF (ISTAT.LT.1) STOP
CALL PGASK(.FALSE.)
C
C Display requested picture(s)
C
WRITE (*,*) 'Options (M for monochrome, G for grey scale):'
READ (*, '(A)') OPT
10 WRITE (*,*) 'Enter number of picture to display: '
READ (*,*, END=20) I
IF (I.LT.1) GOTO 20
IF (I.GT.NPICT) GOTO 10
CALL PGPAGE
CALL PGSVP(0.0, 1.0, 0.0, 1.0)
CALL PGRDMF(FILE, OPT, I, ISTAT)
GOTO 10
C
C Close output graphics device
C
20 CALL PGCLOS
C-----------------------------------------------------------------------
END
C*PGRDMF -- read and display a picture from a PGPLOT metafile
C%void cpgrdmf(char *file, char *opt, int npict, int *istat);
C+
SUBROUTINE PGRDMF (FILE, OPT, NPICT, ISTAT)
CHARACTER*(*) FILE, OPT
INTEGER NPICT, ISTAT
C
C This routine reads a PGPLOT metafile from a disk file and displays
C it in the current viewport.
C
C Arguments:
C FILE (input) : name of metafile to read
C OPT (input) : string of single-character options (see below)
C NPICT (input) : sequence number of picture to display
C ISTAT (output) : receives 0 if file is read successfully; >0 if
C an error occurs (e.g., file not found, wrong
C format)
C
C Options:
C M : display in monochrome, using color indices 0 and 1;
C all color information in the metafile will be ignored.
C G : display in grey scale: colors in the metafile will be
C converted to shades of grey.
C D : debug: report unrecognized entries in the metafile.
C--
C 3-Jun-1997 - new routine (TJP).
C-----------------------------------------------------------------------
INTEGER MAXPOL
PARAMETER (MAXPOL=1000)
INTEGER UNIT, IER, I, N1, N2, N3, N4, NPTS, NFND, LW, N, CI
INTEGER GROPTX, GRCTOI
LOGICAL MONO, GREY, DEBUG
REAL X, Y, X1, Y1, X2, Y2, SCALE, POLX(MAXPOL), POLY(MAXPOL)
REAL SHADE
CHARACTER REC*80, OP
C
MONO = INDEX(OPT,'M').NE.0 .OR. INDEX(OPT,'m').NE.0
GREY = INDEX(OPT,'G').NE.0 .OR. INDEX(OPT,'g').NE.0
DEBUG = INDEX(OPT,'D').NE.0 .OR. INDEX(OPT,'d').NE.0
C
C Open file and check that it is a PGPLOT metafile
C
CALL GRGLUN(UNIT)
IER = GROPTX(UNIT, FILE, 'pgplot.pgmf', 0)
IF (IER.NE.0) THEN
ISTAT = 1
CALL GRWARN('Cannot open PGPLOT metafile:')
CALL GRWARN(FILE(1:LEN(FILE)))
CALL GRFLUN(UNIT)
RETURN
END IF
READ (UNIT, '(A)', IOSTAT=IER) REC
IF (IER.NE.0 .OR. REC(1:5).NE.'%PGMF') THEN
ISTAT = 2
CALL GRWARN('File is not a PGPLOT metafile:')
CALL GRWARN(FILE(1:LEN(FILE)))
CLOSE (UNIT=UNIT)
CALL GRFLUN(UNIT)
RETURN
END IF
C
C Skip to start of requested picture
C
N = 0
50 READ (UNIT, '(A)', IOSTAT=IER) REC
IF (IER.NE.0) THEN
ISTAT = 3
CALL GRWARN('Requested picture not found in PGPLOT metafile:')
CALL GRWARN(FILE(1:LEN(FILE)))
CLOSE (UNIT=UNIT)
CALL GRFLUN(UNIT)
RETURN
END IF
IF (REC(1:1).NE.'B') GOTO 50
N = N+1
IF (N.LT.NPICT) GOTO 50
C
C Display this picture
C
CALL PGBBUF
CALL PGSAVE
100 CONTINUE
OP = REC(1:1)
I = 2
N1 = GRCTOI(REC, I)
I = I+1
N2 = GRCTOI(REC, I)
I = I+1
N3 = GRCTOI(REC, I)
I = I+1
N4 = GRCTOI(REC, I)
IF (OP.EQ.'L') THEN
C -- line segment
X = X + REAL(N1)
Y = Y + REAL(N2)
CALL PGDRAW(X, Y)
ELSE IF (OP.EQ.'M') THEN
C -- move pen
X = REAL(N1)
Y = REAL(N2)
CALL PGMOVE(X, Y)
ELSE IF (OP.EQ.'D') THEN
C -- dot
X = REAL(N1)
Y = REAL(N2)
CALL PGPT1(X, Y, -1)
ELSE IF (OP.EQ.'S') THEN
C -- marker
X = REAL(N2)
Y = REAL(N3)
CALL PGPT1(X, Y, N1)
ELSE IF (OP.EQ.'I') THEN
C -- set color index
IF (MONO) THEN
CI = 1
IF (N1.EQ.0) CI = 0
ELSE
CI = N1
END IF
CALL PGSCI(CI)
ELSE IF (OP.EQ.'W') THEN
C -- set line width
C (N1 is width in PGMF units; convert to unit 1/200 inch)
LW = NINT(200.0*N1/SCALE)
IF (LW.LT.1) LW = 1
CALL PGSLW(LW)
ELSE IF (OP.EQ.'Y') THEN
C -- begin polygon
NPTS = N1
NFND = 0
ELSE IF (OP.EQ.'X') THEN
C -- polygon vertex
NFND = NFND +1
IF (NFND.LE.MAXPOL) THEN
POLX(NFND) = REAL(N1)
POLY(NFND) = REAL(N2)
END IF
IF (NFND.EQ.NPTS) THEN
CALL PGPOLY(MIN(NPTS,MAXPOL), POLX, POLY)
NPTS = 0
END IF
ELSE IF (OP.EQ.'R') THEN
C -- rectangle
CALL PGRECT(REAL(N1), REAL(N3), REAL(N2), REAL(N4))
ELSE IF (OP.EQ.'C') THEN
C -- set color representation
IF (MONO) THEN
CONTINUE
ELSE IF (GREY) THEN
SHADE = (0.30*N2 + 0.59*N3 + 0.11*N4)/255.0
CALL PGSCR(N1, SHADE, SHADE, SHADE)
ELSE
CALL PGSCR(N1,
: REAL(N2)/255.0, REAL(N3)/255.0, REAL(N4)/255.0)
END IF
ELSE IF (OP.EQ.'B') THEN
C -- begin picture
CALL PGWNAD(0.0, REAL(N2), 0.0, REAL(N3))
X = 0.0
Y = 0.0
C -- find device scale (PGMF units per inch)
CALL PGQVP(1, X1, X2, Y1, Y2)
SCALE = REAL(N2)/(X2-X1)
ELSE IF (OP.EQ.'E') THEN
C -- end picture
GOTO 200
ELSE IF (REC(1:1).EQ.'%') THEN
C -- comment
CONTINUE
ELSE
IF (DEBUG) THEN
CALL GRWARN('Bad entry in metafile: '//REC(1:16))
END IF
END IF
READ (UNIT, '(A)', IOSTAT=IER) REC
IF (IER.NE.0) GOTO 200
GOTO 100
200 CONTINUE
CALL PGUNSA
CALL PGEBUF
CLOSE (UNIT=UNIT)
CALL GRFLUN(UNIT)
RETURN
END
C*PGEXMF -- determine properties of PGPLOT metafile
C%void cpgexmf(char *file, int *npict, int *istat);
C+
SUBROUTINE PGEXMF (FILE, NPICT, ISTAT)
CHARACTER*(*) FILE
INTEGER NPICT, ISTAT
C
C Arguments:
C FILE (input) : name of metafile to read
C NPICT (output) : number of pictures in metafile
C ISTAT (output) : receives 0 if file is read successfully; 1 if
C an error occurs (e.g., file not found, wrong
C format)
C--
C 3-Jun-1997 - new routine (TJP).
C-----------------------------------------------------------------------
INTEGER UNIT, IER
INTEGER GROPTX
CHARACTER REC*80
C
CALL GRGLUN(UNIT)
IER = GROPTX(UNIT, FILE, 'pgplot.pgmf', 0)
IF (IER.NE.0) THEN
ISTAT = 1
CALL GRWARN('Cannot open PGPLOT metafile:')
CALL GRWARN(FILE(1:LEN(FILE)))
CALL GRFLUN(UNIT)
RETURN
END IF
READ (UNIT, '(A)', IOSTAT=IER) REC
IF (IER.NE.0 .OR. REC(1:5).NE.'%PGMF') THEN
ISTAT = 2
CALL GRWARN('File is not a PGPLOT metafile:')
CALL GRWARN(FILE(1:LEN(FILE)))
CLOSE (UNIT=UNIT)
CALL GRFLUN(UNIT)
RETURN
END IF
NPICT = 0
100 CONTINUE
READ (UNIT, '(A)', IOSTAT=IER) REC
IF (IER.NE.0) GOTO 200
IF (REC(1:1).EQ.'B') THEN
NPICT = NPICT+1
END IF
GOTO 100
200 CONTINUE
CLOSE (UNIT=UNIT)
CALL GRFLUN(UNIT)
RETURN
END
|
