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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <imhdr.h>
include <imio.h>
include "imtext.h"
# RT_RHEADER -- read FITS header, saving the image dimension information in
# the image header. The format (integer/floating point) is returned.
procedure rt_rheader (tf, im, format)
int tf # File descriptor for input text file
pointer im # Pointer to image header
int format # Format of text file pixels (integer/floating point)
pointer sp, wt, card
bool streq()
int ncard, fd_user, max_lenuser
int getline(), rt_decode_card(), stridxs(), strlen(), stropen()
errchk getline, rt_decode_card
begin
call smark (sp)
call salloc (wt, LEN_WT, TY_STRUCT)
call salloc (card, LEN_CARD+1, TY_CHAR)
Memc[card+LEN_CARD] = '\n'
Memc[card+LEN_CARD+1] = EOS
# Prepare user area string to be written
max_lenuser = (LEN_IMDES + IM_LENHDRMEM(im) - IMU) * SZ_STRUCT - 1
fd_user = stropen (Memc[IM_USERAREA(im)], max_lenuser, NEW_FILE)
ncard = 1
repeat {
if (getline (tf, Memc[card]) == EOF)
call error (2, "RT_RHEADER: EOF encountered before END card")
ncard = ncard + 1
if (rt_decode_card (wt, im, fd_user, Memc[card]) == YES)
break
}
# Encountered END card; examine a few header keyword values. From
# the FORMAT keyword, determine if the pixel values are written as
# integers, floating point numbers or complex numbers.
if (strlen (FORM(wt)) > 0) {
if (stridxs ("I", FORM(wt)) > 0)
format = INT_FORM
else if (stridxs ("(", FORM(wt)) > 0)
format = CPX_FORM
else
format = FP_FORM
} else
format = UNSET
# The image pixel type is set by the IRAFTYPE keyword value.
if (streq (IRAFTYPE(wt), "SHORT INTEGER"))
IM_PIXTYPE (im) = TY_SHORT
else if (streq (IRAFTYPE(wt), "UNSIGNED SHORT INT"))
IM_PIXTYPE (im) = TY_USHORT
else if (streq (IRAFTYPE(wt), "INTEGER"))
IM_PIXTYPE (im) = TY_INT
else if (streq (IRAFTYPE(wt), "LONG INTEGER"))
IM_PIXTYPE (im) = TY_LONG
else if (streq (IRAFTYPE(wt), "REAL FLOATING"))
IM_PIXTYPE (im) = TY_REAL
else if (streq (IRAFTYPE(wt), "DOUBLE FLOATING"))
IM_PIXTYPE (im) = TY_DOUBLE
else if (streq (IRAFTYPE(wt), "COMPLEX"))
IM_PIXTYPE (im) = TY_COMPLEX
call close (fd_user)
call sfree (sp)
end
# RT_DECODE_CARD -- Decode a FITS format card and return YES when the END
# card is encountered. The decoded value is stored in the image header,
# or in the user area if there is no other place for it. The END card is
# tested only to the first three characters; strictly speaking the END
# card begins with the 8 characters "END ".
int procedure rt_decode_card (wt, im, fd, card)
pointer wt # Pointer to wtextimage keyword structure
pointer im # Pointer to image header being written
int fd # File descriptor of user area
char card[ARB] # Card image read from FITS header
int nchar, ival, i, j, k, ndim
int strmatch(), ctoi()
errchk rt_get_fits_string, putline, putline
begin
i = COL_VALUE
if (strmatch (card, "^END") > 0)
return (YES)
else if (strmatch (card, "^NAXIS ") > 0) {
nchar = ctoi (card, i, ndim)
if (ndim > 0)
IM_NDIM(im) = ndim
} else if (strmatch (card, "^NAXIS") > 0) {
k = strmatch (card, "^NAXIS")
nchar = ctoi (card, k, j)
nchar = ctoi (card, i, IM_LEN(im,j))
} else if (strmatch (card, "^NDIM ") > 0)
nchar = ctoi (card, i, IM_NDIM(im))
else if (strmatch (card, "^LEN") > 0) {
k = strmatch (card, "^LEN")
nchar = ctoi (card, k, j)
nchar = ctoi (card, i, IM_LEN(im,j))
} else if (strmatch (card, "^BITPIX ") > 0) {
nchar = ctoi (card, i, ival)
if (ival != 8)
call error (6, "Not 8-bit ASCII characters")
} else if (strmatch (card, "^FORMAT ") > 0) {
call rt_get_fits_string (card, FORM(wt), SZ_STRING)
} else if (strmatch (card, "^IRAFTYPE") > 0) {
call rt_get_fits_string (card, IRAFTYPE(wt), SZ_STRING)
} else if (strmatch (card, "^OBJECT ") > 0) {
call rt_get_fits_string (card, IM_TITLE(im), SZ_IMTITLE)
} else {
# Putline returns an error if there is no room in the user area
iferr (call putline (fd, card)) {
call eprintf ("Space in user area has been exceeded\n")
return (YES)
}
}
return (NO)
end
# RT_GET_FITS_STRING -- Extract a string from a FITS card and trim trailing
# blanks. The EOS is marked by either ', /, or the end of the card.
# There may be an optional opening ' (FITS standard).
procedure rt_get_fits_string (card, str, maxchar)
char card[ARB] # Input card image containing keyword and value
char str[maxchar] # Output string
int maxchar # Maximum number of characters output
int j, istart, nchar
begin
# Check for opening quote
if (card[COL_VALUE] == '\'')
istart = COL_VALUE + 1
else
istart = COL_VALUE
for (j=istart; (j < LEN_CARD) && (card[j] != '\''); j=j+1)
;
for (j=j-1; (j >= istart) && (card[j] == ' '); j=j-1)
;
nchar = min (maxchar, j - istart + 1)
call strcpy (card[istart], str, nchar)
end
|
