aboutsummaryrefslogtreecommitdiff
path: root/pkg/images/imutil/src/imheader.x
blob: 57c496fed651de6162544880f85e6a4b908927f3 (plain) (blame)
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