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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <ctype.h>
include <fset.h>
include <error.h>
include <mach.h>
include <imhdr.h>
include "imtext.h"
define SZ_FORMAT 20
# WTEXTIMAGE -- Write a text file from an IRAF image. Image header information
# is written in the "keyword = value / comment" format of FITS. Pixel values
# follow the header. The resulting text file can be read as a FITS image. The
# header cards include "NAXIS = 0", indicating no binary data matrix is written.
# The encoded pixel values can be read as special records following the null
# data matrix.
procedure t_wtextimage ()
bool header
bool pixels
pointer im
char output[SZ_FNAME], format[SZ_FORMAT], imlist[SZ_LINE]
char image[SZ_FNAME], out_fname[SZ_FNAME]
int maxll, file_num, out, input, nfiles
pointer immap()
bool clgetb(), strne()
int clgeti(), imtgetim(), open(), imtopen(), fstati(), imtlen()
begin
# Open template of input image filenames.
call clgstr ("input", imlist, SZ_LINE)
input = imtopen (imlist)
nfiles = imtlen (input)
# See if STDOUT has been redirected and get output filename.
if (fstati (STDOUT, F_REDIR) == YES) {
# Output has been redirected, set output filename to STDOUT
call strcpy ("STDOUT", output, SZ_FNAME)
} else {
# Get output filename from cl
call clgstr ("output", output, SZ_FNAME)
}
# Get other parameters from cl.
header = clgetb ("header")
pixels = clgetb ("pixels")
maxll = min (MAX_LENTEXT, clgeti ("maxlinelen"))
if (maxll <= 0)
call error (1, "Illegal maximum line length: must be > 0")
call clgstr ("format", format, SZ_FORMAT)
call strlwr (format)
file_num = 0
while (imtgetim (input, image, SZ_FNAME) != EOF) {
file_num = file_num + 1
# Open image.
iferr (im = immap (image, READ_ONLY, 0)) {
call erract (EA_WARN)
next
}
if (nfiles > 1 && strne (output, "STDOUT")) {
# Generate unique output file name
call sprintf (out_fname, SZ_FNAME, "%s.%03d")
call pargstr (output)
call pargi (file_num)
} else
call strcpy (output, out_fname, SZ_FNAME)
# Open output file.
iferr (out = open (out_fname, APPEND, TEXT_FILE)) {
call imunmap (im)
call erract (EA_WARN)
next
}
iferr (call wti_convert_image (im,image,out,header,pixels,
maxll,format))
call erract (EA_WARN)
call imunmap (im)
call close (out)
}
call imtclose (input)
end
# WTI_CONVERT_IMAGE -- called once for each image to be converted. This
# procedure determines the output pixel format and then directs the processing
# depending on user request.
procedure wti_convert_image (im, image, out, header, pixels, maxll, user_format)
pointer im # input image
char image[ARB] # image name
int out # output text file descriptor
bool header # convert header information (y/n)?
bool pixels # convert pixels (y/n)?
int maxll # maximum line length of text file
char user_format[ARB] # output format for single pixel entered by user
int width, decpl, fmtchar
pointer sp, out_format, ftn_format, spp_format, ep
errchk wti_determine_fmt, wti_write_header
errchk wti_putint, wti_putreal, wti_putcomplex
begin
call smark (sp)
call salloc (out_format, SZ_FORMAT, TY_CHAR)
call salloc (spp_format, SZ_FORMAT, TY_CHAR)
call salloc (ftn_format, SZ_FORMAT, TY_CHAR)
call salloc (ep, SZ_LINE, TY_CHAR)
# Clear the format variables.
call aclrc (Memc[out_format], SZ_FORMAT)
call aclrc (Memc[spp_format], SZ_FORMAT)
call aclrc (Memc[ftn_format], SZ_FORMAT)
call aclrc (Memc[ep], SZ_LINE)
fmtchar = ' '
# Determine the output format.
if (user_format[1] == EOS) {
# Format has not been set by user. Set appropriate defaults.
switch (IM_PIXTYPE(im)) {
case TY_USHORT:
call strcpy ("6d", Memc[spp_format], SZ_FORMAT)
case TY_SHORT:
call strcpy ("7d", Memc[spp_format], SZ_FORMAT)
case TY_INT:
call strcpy ("12d", Memc[spp_format], SZ_FORMAT)
case TY_LONG:
call strcpy ("12d", Memc[spp_format], SZ_FORMAT)
case TY_REAL:
call strcpy ("14.7g", Memc[spp_format], SZ_FORMAT)
case TY_DOUBLE:
call strcpy ("22.15g", Memc[spp_format], SZ_FORMAT)
case TY_COMPLEX:
call strcpy ("21.7z", Memc[spp_format], SZ_FORMAT)
}
} else
call strcpy (user_format, Memc[spp_format], SZ_FORMAT)
call wti_determine_fmt (Memc[spp_format], Memc[ftn_format],
decpl, fmtchar, width)
# Write the header.
if (header) {
if (width > 0) {
if ((maxll / width) < 1) {
call sprintf (Memc[ep], SZ_LINE,
"%s: output maxlinelen=%d is too short for format %s")
call pargstr (image)
call pargi (maxll)
call pargstr (Memc[ftn_format])
call error (2, Memc[ep])
}
call sprintf (Memc[out_format], SZ_FORMAT, "%d%s")
call pargi (maxll / width)
call pargstr (Memc[ftn_format])
} else
call strcpy ("*", Memc[out_format], SZ_FORMAT)
call wti_write_header (im, image, out, Memc[out_format])
}
# Write out the pixels in text form.
if (pixels) {
switch (fmtchar) {
case 'd':
call wti_putint (im, out, maxll, width)
case 'e', 'f', 'g':
call wti_putreal (im, out, maxll, decpl, fmtchar, width)
case 'z':
call wti_putcomplex (im, out, maxll, decpl, 'e', width)
}
}
call sfree (sp)
end
# WTI_DETERMINE_FMT -- Extract field width from input format string and
# generate a fortran format equivalent to the input spp format. The input
# format may be either a Fortran sytle format or an SPP format.
procedure wti_determine_fmt (spp_format, ftn_format, decpl, fmtchar, width)
char spp_format[ARB] # SPP format of each pixel
char ftn_format[ARB] # equivalent Fortran format (output)
int decpl # number of decimal places of precision (output)
int fmtchar # format character (output)
int width # field width (output)
int ip
bool fortran_format
int ctoi()
begin
# Parse either an SPP format "W.Dc" or a Fortran format "cW.D" to
# determine the field width, number of decimal places or precision,
# and the format char. If the field width is missing or zero we set
# width=0 to flag that free format output is desired.
for (ip=1; IS_WHITE (spp_format[ip]); ip=ip+1)
;
fortran_format = IS_ALPHA (spp_format[ip])
if (fortran_format) {
if (spp_format[ip] == 'i')
fmtchar = 'd'
ip = ip + 1
}
# Extract W and D fields.
if (ctoi (spp_format, ip, width) == 0)
width = 0
if (spp_format[ip] == '.') {
ip = ip + 1
if (ctoi (spp_format, ip, decpl) == 0)
decpl = 0
} else
decpl = 0
if (!fortran_format && spp_format[ip] != EOS) {
fmtchar = spp_format[ip]
ip = ip + 1
}
if (spp_format[ip] != EOS)
call error (3, "unacceptable numeric format")
# Construct the FTN version of the spp_format. This will be
# output in the header.
switch (fmtchar) {
case 'd':
call sprintf (ftn_format, SZ_FORMAT, "I%d")
call pargi (width)
case 'e', 'f', 'g':
call sprintf (ftn_format, SZ_FORMAT, "%c%d.%d")
call pargi (TO_UPPER (fmtchar))
call pargi (width)
call pargi (decpl)
case 'z':
# Tell Fortran to use a list directed read to read complex data.
call strcpy ("*", ftn_format, SZ_FORMAT)
width = 0
default:
call error (4, "Improper format. Must be chosen from [defgz].")
}
end
|
