forked from idl-coyote/coyote
-
Notifications
You must be signed in to change notification settings - Fork 0
/
cgfixps.pro
324 lines (298 loc) · 13.6 KB
/
cgfixps.pro
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
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
; docformat = 'rst'
;
; NAME:
; cgFixPS
;
; PURPOSE:
; This program modifies an IDL-produced PostScript landscape mode file so that the output
; is right side up rather than upside down. In other words, it turns a so-called seascape
; file into an actual landscape file.
;
;******************************************************************************************;
; ;
; Copyright (c) 2011, by Fanning Software Consulting, Inc. All rights reserved. ;
; ;
; Redistribution and use in source and binary forms, with or without ;
; modification, are permitted provided that the following conditions are met: ;
; ;
; * Redistributions of source code must retain the above copyright ;
; notice, this list of conditions and the following disclaimer. ;
; * Redistributions in binary form must reproduce the above copyright ;
; notice, this list of conditions and the following disclaimer in the ;
; documentation and/or other materials provided with the distribution. ;
; * Neither the name of Fanning Software Consulting, Inc. nor the names of its ;
; contributors may be used to endorse or promote products derived from this ;
; software without specific prior written permission. ;
; ;
; THIS SOFTWARE IS PROVIDED BY FANNING SOFTWARE CONSULTING, INC. ''AS IS'' AND ANY ;
; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES ;
; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT ;
; SHALL FANNING SOFTWARE CONSULTING, INC. BE LIABLE FOR ANY DIRECT, INDIRECT, ;
; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED ;
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; ;
; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ;
; ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ;
; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;
;******************************************************************************************;
;
;+
; This program modifies an IDL-produced PostScript landscape mode file so that the output
; is right side up rather than upside down. In other words, it turns a so-called seascape
; file into an actual landscape file. Files that are not currently in landscape mode will
; be ignored. Tested with single and multiple page PostScript output from IDL 7.0.1 and 7.1.
;
; The program requires the `Coyote Library <http://www.idlcoyote.com/documents/programs.php>`
; to be installed on your machine.
;
; :Categories:
; Graphics, Utilities
;
; :Params:
; in_filename: in, required, type=string
; The name of an IDL-produced PostScript file in landscape mode.
; out_filename: in, optional, type=string
; The name of the fixed output PostScript file. If not provided, the input
; file is overwritten. Overwritting assumes proper read/write permission in
; TEMP directory and in the directory where the input file is located.
;
; :Keywords:
; a4: in, optional, type=boolean, default=0
; Set this keyword if the PostScript file is using a A4 Europeran sized page.
; ledger: in, optional, type=boolean, default=0
; Set this keyword if the PostScript file is using a US ledger size (11 x 17 inch) page.
; legal: in, optional, type=boolean, default=0
; Set this keyword if the PostScript file is using a US legal size (8.5 x 14 inch) page.
; letter: in, optional, type=boolean, default=0
; Set this keyword if the PostScript file is using a US letter size (8.5 x 11 inch) page.
; pagetype: in, optional, type=string, default="Letter"
; A generic way to set the page size. A string of "LETTER", "LEDGER", "LEGAL", or "A4".
; quiet: in, optional, type=boolean, default=0
; Set this keyword to suppress error messages from the program.
; success: out, optional, type=boolean
; If this keyword is set to a named variable, then on output the variable will
; return a 1 if the operation was successful, and a 0 otherwise. Using this
; keyword also supresses the program's ability to "throw" an error. Informational
; messages are issued about program developments, but this program will allow the
; program caller to decide what to do with unsuccessful program completion.
;
; :Author:
; FANNING SOFTWARE CONSULTING::
; David W. Fanning
; 1645 Sheely Drive
; Fort Collins, CO 80526 USA
; Phone: 970-221-0438
; E-mail: [email protected]
; Coyote's Guide to IDL Programming: http://www.idlcoyote.com
;
; :History:
; Change History::
; Written by: David W. Fanning, 6 August 2009.
; Change to overwrite input file if output filename is not provided. 6 August 2009. DWF.
; Incorporated checks for non-landscape mode files and files that have already been fixed. 6 August 2009. DWF.
; Modified to fix multiple-page PostScript files and to work seamlessly with cgPS_Open output. 8 August 2009. DWF.
; Ran into a problem in which the PostScript file is stored in the directory pointed
; to by the IDL_TMPDIR environment variable. Now check to see if the input filename
; is the same as the output filename and make a change, if necessary. 22 July 2010. DWF.
; Retreated to standard error handling with cgErrorMsg as there are inevitable errors. 2 August 2010. DWF.
; Output file was created, even if not used. Now deleting file and issuing messages to
; explain why output file was not created. 1 November 2010. DWF.
; Added SUCCESS and QUIET keywords. 15 Novemember 2010. DWF.
; PostScript file structure changed in IDL 8. Made adjustment to find the
; PageBoundingBox line. 19 Dec 2010. DWF.
; Added a check for an input file with zero length. No fix required. Clean up and return. 1 July 2016. DWF.
; My check for a zero length file was faulty, because I was not opening the file before
; I checked its length. Fixed. 13 Nov 2016. DWF.
;
; :Copyright:
; Copyright (c) 2009-2016, Fanning Software Consulting, Inc.
;-
PRO cgFIXPS, in_filename, out_filename, $
A4=A4, $
LEDGER=ledger, $
LEGAL=legal, $
LETTER=letter, $
PAGETYPE=pagetype, $
QUIET=quiet, $
SUCCESS=success
Compile_Opt idl2
; Error handling.
IF Arg_Present(success) THEN BEGIN
Catch, theError
IF theError NE 0 THEN BEGIN
Catch, /CANCEL
success = 0
IF N_Elements(out_lun) NE 0 THEN Free_Lun, out_lun
IF N_Elements(in_lun) NE 0 THEN Free_Lun, in_lun
IF ~Keyword_Set(quiet) THEN Print, !Error_State.MSG
RETURN
ENDIF
ENDIF ELSE BEGIN
Catch, theError
IF theError NE 0 THEN BEGIN
Catch, /CANCEL
IF ~Keyword_Set(quiet) THEN ok = cgErrorMsg()
success = 0
IF N_Elements(out_lun) NE 0 THEN Free_Lun, out_lun
IF N_Elements(in_lun) NE 0 THEN Free_Lun, in_lun
RETURN
ENDIF
ENDELSE
; Assume success
success = 1
; Is there an input filename?
IF N_Elements(in_filename) EQ 0 THEN BEGIN
in_filename = Dialog_Pickfile(FILTER='*.ps', TITLE='Select PostScript file to repair.')
IF in_filename EQ "" THEN RETURN
ENDIF
; Is there an output filename?
IF N_Elements(out_filename) EQ 0 THEN BEGIN
root_name = cgRootName(in_filename, EXTENSION=ext)
out_filename = Filepath(ROOT_DIR=GetEnv('IDL_TMPDIR'), root_name + '_tmp.' + ext)
print_out = 1
no_output_filename = 1
ENDIF ELSE no_output_filename = 0
; The out_filename can be the same as the in_filename in some cases.
IF out_filename EQ in_filename THEN BEGIN
rootname = cgRootName(out_filename, DIRECTORY=outDir, EXTENSION=ext)
out_filename = FilePath(ROOT_DIR=outDir, rootname + '_tmp.' + ext)
ENDIF
; Open the output filename.
OpenW, out_lun, out_filename, /GET_LUN
; What kind of page is this?
IF N_Elements(pagetype) EQ 0 THEN BEGIN
IF Keyword_Set(A4) THEN pageType = 'A4'
IF Keyword_Set(legal) THEN pageType = 'LEGAL'
IF Keyword_Set(ledger) THEN pageType = 'LEDGER'
IF Keyword_Set(letter) THEN pageType = 'LETTER'
IF N_Elements(pageType) EQ 0 THEN pageType = 'LETTER'
ENDIF ELSE pageType = StrUpCase(pageType)
; Set the rotate/translate command appropriately.
CASE pageType OF
'LETTER': rtcmd = '180 rotate -612 -792 translate'
'A4': rtcmd = '180 rotate -595.28 -841.89 translate'
'LEGAL': rtcmd = '180 rotate -612 -1008 translate'
'LEDGER': rtcmd = '180 rotate -792 -1224 translate'
ELSE: Message, 'Unknown PageType: ' + pageType
ENDCASE
; Move along in the file until the end of the Prolog.
line = ""
count = 0
target = "void"
buffer = StrArr(100)
OpenR, in_lun, in_filename, /GET_LUN
; If the file size is 0, then there is nothing to fix. Clean up and exit with success.
IF (FStat(in_lun)).size EQ 0 THEN BEGIN
Free_lun, in_lun
Free_lun, out_lun
File_Delete, out_filename
;Print, 'Zero Length File Encountered...'
RETURN
ENDIF
; Move along in the file until the end of the Prolog.
line = ""
count = 0
target = "void"
buffer = StrArr(100)
WHILE target NE '%%EndProlog' DO BEGIN
ReadF, in_lun, line
buffer[count] = line
target = StrMid(line, 0, 11)
count = count + 1
IF count MOD 100 EQ 0 THEN buffer = [buffer, StrArr(100)]
ENDWHILE
; Read the next 10 lines all at once. If you have already processed
; this file, exit. But if you haven't write the buffer to the output file.
in_lines = StrArr(10)
ReadF, in_lun, in_lines
; Is this a landscape file? If not, out of here.
index = Where(in_lines EQ '%%PageOrientation: Landscape', landscape_cnt)
IF landscape_cnt EQ 0 THEN BEGIN
Free_Lun, in_lun
Free_Lun, out_lun
File_Delete, out_filename
Message, 'File not a landscape file. Exiting...', /Informational
RETURN
ENDIF
; Has this file already been mucked with? If so, out of here. If not, write
; the buffer to the output file.
IF StrMid(in_lines[1], 0, 10) EQ '180 rotate' THEN BEGIN
Free_Lun, in_lun
Free_Lun, out_lun
File_Delete, out_filename
Message, 'File is in the proper rotation. Exiting...', /Informational
RETURN
ENDIF ELSE BEGIN
FOR j=0,count-1 DO PrintF, out_lun, buffer[j]
ENDELSE
count = count + 10
; We are going to add an extra line in the output file.
out_lines = StrArr(11)
out_lines[0] = in_lines[0]
out_lines[2:10] = in_lines[1:9]
out_lines[1] = rtcmd
; Calculate the new bounding box boundaries.
bbox_line_num = Where(StrMid(in_lines, 0, 17) EQ '%%PageBoundingBox', bbox_count)
IF bbox_count EQ 0 THEN Message, 'Cannot find PageBoundingBox line in file.'
bbox = StrMid(in_lines[bbox_line_num[0]], 18)
x0 = 0
x1 = 0
y0 = 0
y1 = 0
ReadS, bbox, x0, y0, x1, y1
CASE pageType OF
'LETTER': BEGIN
lx = String(612 - x1, FORMAT='(I5)')
ly = String(792 - y1, FORMAT='(I5)')
ux = String(612 - lx, FORMAT='(I5)')
uy = String(792 - ly, FORMAT='(I5)')
END
'A4': BEGIN
lx = String(595.28 - x1, FORMAT='(I5)')
ly = String(841.89 - y1, FORMAT='(I5)')
ux = String(595.28 - lx, FORMAT='(I5)')
uy = String(841.89 - ly, FORMAT='(I5)')
END
'LEGAL': BEGIN
lx = String(612 - x1, FORMAT='(I5)')
ly = String(1008 - y1, FORMAT='(I5)')
ux = String(612 - lx, FORMAT='(I5)')
uy = String(1008 - ly, FORMAT='(I5)')
END
'LEDGER': BEGIN
lx = String(792 - x1, FORMAT='(I5)')
ly = String(1224 - y1, FORMAT='(I5)')
ux = String(792 - lx, FORMAT='(I5)')
uy = String(1224 - ly, FORMAT='(I5)')
END
ENDCASE
; Output the new boundaries.
out_lines[5] = '%%PageBoundingBox: ' + lx + ly + ux + uy
FOR j=0,10 DO PrintF, out_lun, out_lines[j]
; Output the rest of the file, looking for another "%%Page:" marker.
WHILE ~EOF(in_lun) DO BEGIN
ReadF, in_lun, line
PrintF, out_lun, line
IF StrMid(line, 0, 7) EQ '%%Page:' THEN BEGIN
IF Keyword_Set(A4) THEN BEGIN
PrintF, out_lun, rtcmd
ENDIF ELSE BEGIN
PrintF, out_lun, rtcmd
ENDELSE
ENDIF
ENDWHILE
; Clean up.
Free_lun, in_lun
Free_lun, out_lun
; If there was no output filename given, then we are going
; to replace the input file with the temporary output file.
IF no_output_filename THEN BEGIN
inputDir = File_Dirname(in_filename)
root_name = File_BaseName(in_filename)
; Can you write into the input directory?
IF File_Test(in_filename, /WRITE) EQ 0 THEN Message, 'Cannot write TEMPORARY file into input file directory.'
; Replace the input file with the temporary output file.
File_Delete, in_filename
File_Move, out_filename, in_filename
ENDIF
END