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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <error.h>
include <ctype.h>
include <imhdr.h>
include <imset.h>
include <imio.h>
include <time.h>
define SZ_DIMSTR (IM_MAXDIM*4)
define SZ_MMSTR 40
define USER_AREA Memc[($1+IMU-1)*SZ_STRUCT + 1]
define LMARGIN 0
# IMHEADER -- Read contents of an image header and print on STDOUT.
procedure t_imheader()
int list, nimages, errcode
bool long_format, user_fields
pointer sp, template, image, errmsg
int imtopen(), imtgetim(), imtlen(), clgeti(), errget()
bool clgetb()
begin
call smark (sp)
call salloc (image, SZ_FNAME, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
call salloc (template, SZ_LINE, TY_CHAR)
if (clgeti ("$nargs") == 0)
call clgstr ("imlist", Memc[template], SZ_LINE)
else
call clgstr ("images", Memc[template], SZ_LINE)
list = imtopen (Memc[template])
long_format = clgetb ("longheader")
user_fields = clgetb ("userfields")
nimages = 0
if (imtlen (list) <= 0)
call printf ("no images found\n")
else {
while (imtgetim (list, Memc[image], SZ_FNAME) != EOF) {
nimages = nimages + 1
if (long_format && nimages > 1)
call putci (STDOUT, '\n')
iferr {
call imphdr (STDOUT,Memc[image],long_format,user_fields)
} then {
errcode = errget (Memc[errmsg], SZ_LINE)
call eprintf ("%s: %s\n")
call pargstr (Memc[image])
call pargstr (Memc[errmsg])
}
call flush (STDOUT)
}
}
call imtclose (list)
call sfree (sp)
end
# IMPHDR -- Print the contents of an image header.
procedure imphdr (fd, image, long_format, user_fields)
int fd
char image[ARB]
bool long_format
bool user_fields
int hi, i
bool pixfile_ok
pointer im, sp, ctime, mtime, ldim, pdim, title, lbuf, ip
int gstrcpy(), stropen(), getline(), strlen(), stridxs(), imstati()
errchk im_fmt_dimensions, immap, access, stropen, getline
define done_ 91
pointer immap()
begin
# Allocate automatic buffers.
call smark (sp)
call salloc (ctime, SZ_TIME, TY_CHAR)
call salloc (mtime, SZ_TIME, TY_CHAR)
call salloc (ldim, SZ_DIMSTR, TY_CHAR)
call salloc (pdim, SZ_DIMSTR, TY_CHAR)
call salloc (title, SZ_LINE, TY_CHAR)
call salloc (lbuf, SZ_LINE, TY_CHAR)
im = immap (image, READ_ONLY, 0)
# Format subscript strings, date strings, mininum and maximum
# pixel values.
call im_fmt_dimensions (im, Memc[ldim], SZ_DIMSTR, IM_LEN(im,1))
call im_fmt_dimensions (im, Memc[pdim], SZ_DIMSTR, IM_PHYSLEN(im,1))
call cnvtime (IM_CTIME(im), Memc[ctime], SZ_TIME)
call cnvtime (IM_MTIME(im), Memc[mtime], SZ_TIME)
# Strip any trailing whitespace from the title string.
ip = title + gstrcpy (IM_TITLE(im), Memc[title], SZ_LINE) - 1
while (ip >= title && IS_WHITE(Memc[ip]) || Memc[ip] == '\n')
ip = ip - 1
Memc[ip+1] = EOS
# Begin printing image header.
call fprintf (fd, "%s%s[%s]: %s\n")
call pargstr (IM_NAME(im))
call pargstr (Memc[ldim])
call pargtype (IM_PIXTYPE(im))
call pargstr (Memc[title])
# All done if not long format.
if (! long_format)
goto done_
call fprintf (fd, "%*w%s bad pixels, min=%s, max=%s%s\n")
call pargi (LMARGIN)
if (IM_NBPIX(im) == 0) # num bad pixels
call pargstr ("No")
else
call pargl (IM_NBPIX(im))
if (IM_LIMTIME(im) == 0) { # min,max pixel values
do i = 1, 2
call pargstr ("unknown")
call pargstr ("")
} else {
call pargr (IM_MIN(im))
call pargr (IM_MAX(im))
if (IM_LIMTIME(im) < IM_MTIME(im))
call pargstr (" (old)")
else
call pargstr ("")
}
call fprintf (fd,
"%*w%s storage mode, physdim %s, length of user area %d s.u.\n")
call pargi (LMARGIN)
call pargstr ("Line")
call pargstr (Memc[pdim])
call pargi (IM_HDRLEN(im) - LEN_IMHDR)
call fprintf (fd, "%*wCreated %s, Last modified %s\n")
call pargi (LMARGIN)
call pargstr (Memc[ctime]) # times
call pargstr (Memc[mtime])
pixfile_ok = (imstati (im, IM_PIXFD) > 0)
if (!pixfile_ok) {
ifnoerr (call imopsf (im))
pixfile_ok = (imstati (im, IM_PIXFD) > 0)
if (pixfile_ok)
call close (imstati (im, IM_PIXFD))
}
if (pixfile_ok)
call strcpy ("[ok]", Memc[lbuf], SZ_LINE)
else
call strcpy ("[NO PIXEL FILE]", Memc[lbuf], SZ_LINE)
call fprintf (fd, "%*wPixel file \"%s\" %s\n")
call pargi (LMARGIN)
call pargstr (IM_PIXFILE(im))
call pargstr (Memc[lbuf])
# Print the history records.
if (strlen (IM_HISTORY(im)) > 1) {
hi = stropen (IM_HISTORY(im), ARB, READ_ONLY)
while (getline (hi, Memc[lbuf]) != EOF) {
for (i=1; i <= LMARGIN; i=i+1)
call putci (fd, ' ')
call putline (fd, Memc[lbuf])
if (stridxs ("\n", Memc[lbuf]) == 0)
call putline (fd, "\n")
}
call close (hi)
}
if (user_fields)
call imh_print_user_area (fd, im)
done_
call imunmap (im)
call sfree (sp)
end
# IM_FMT_DIMENSIONS -- Format the image dimensions in the form of a subscript,
# i.e., "[nx,ny,nz,...]".
procedure im_fmt_dimensions (im, outstr, maxch, len_axes)
pointer im
char outstr[ARB]
int maxch, i, fd, stropen()
long len_axes[ARB]
errchk stropen, fprintf, pargl
begin
fd = stropen (outstr, maxch, NEW_FILE)
if (IM_NDIM(im) == 0) {
call fprintf (fd, "[0")
} else {
call fprintf (fd, "[%d")
call pargl (len_axes[1])
}
do i = 2, IM_NDIM(im) {
call fprintf (fd, ",%d")
call pargl (len_axes[i])
}
call fprintf (fd, "]")
call close (fd)
end
# PARGTYPE -- Convert an integer type code into a string, and output the
# string with PARGSTR to FMTIO.
procedure pargtype (dtype)
int dtype
begin
switch (dtype) {
case TY_UBYTE:
call pargstr ("ubyte")
case TY_BOOL:
call pargstr ("bool")
case TY_CHAR:
call pargstr ("char")
case TY_SHORT:
call pargstr ("short")
case TY_USHORT:
call pargstr ("ushort")
case TY_INT:
call pargstr ("int")
case TY_LONG:
call pargstr ("long")
case TY_REAL:
call pargstr ("real")
case TY_DOUBLE:
call pargstr ("double")
case TY_COMPLEX:
call pargstr ("complex")
case TY_POINTER:
call pargstr ("pointer")
case TY_STRUCT:
call pargstr ("struct")
default:
call pargstr ("unknown datatype")
}
end
# IMH_PRINT_USER_AREA -- Print the user area of the image, if nonzero length
# and it contains only ascii values.
procedure imh_print_user_area (out, im)
int out # output file
pointer im # image descriptor
pointer sp, lbuf, ip
int in, ncols, min_lenuserarea, i
int stropen(), getline(), envgeti()
errchk stropen, envgeti, getline, putci, putline
begin
call smark (sp)
call salloc (lbuf, SZ_LINE, TY_CHAR)
# Open user area in header.
min_lenuserarea = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
in = stropen (USER_AREA(im), min_lenuserarea, READ_ONLY)
ncols = envgeti ("ttyncols") - LMARGIN
# Copy header records to the output, stripping any trailing
# whitespace and clipping at the right margin.
while (getline (in, Memc[lbuf]) != EOF) {
for (ip=lbuf; Memc[ip] != EOS && Memc[ip] != '\n'; ip=ip+1)
;
while (ip > lbuf && Memc[ip-1] == ' ')
ip = ip - 1
if (ip - lbuf > ncols)
ip = lbuf + ncols
Memc[ip] = '\n'
Memc[ip+1] = EOS
for (i=1; i <= LMARGIN; i=i+1)
call putci (out, ' ')
call putline (out, Memc[lbuf])
}
call close (in)
call sfree (sp)
end
|