1 /*============================================================================
2 WCSLIB 7.7 - an implementation of the FITS WCS standard.
3 Copyright (C) 1995-2021, Mark Calabretta
4
5 This file is part of WCSLIB.
6
7 WCSLIB is free software: you can redistribute it and/or modify it under the
8 terms of the GNU Lesser General Public License as published by the Free
9 Software Foundation, either version 3 of the License, or (at your option)
10 any later version.
11
12 WCSLIB is distributed in the hope that it will be useful, but WITHOUT ANY
13 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14 FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
15 more details.
16
17 You should have received a copy of the GNU Lesser General Public License
18 along with WCSLIB. If not, see http://www.gnu.org/licenses.
19
20 Author: Mark Calabretta, Australia Telescope National Facility, CSIRO.
21 http://www.atnf.csiro.au/people/Mark.Calabretta
22 $Id: fitshdr_f.c,v 7.7 2021/07/12 06:36:49 mcalabre Exp $
23 *===========================================================================*/
24
25 #include <stdio.h>
26 #include <stdlib.h>
27 #include <string.h>
28
29 #include <wcsutil.h>
30 #include <fitshdr.h>
31
32 // Fortran name mangling.
33 #include <wcsconfig_f77.h>
34 #define keyidput_ F77_FUNC(keyidput, KEYIDPUT)
35 #define keyidptc_ F77_FUNC(keyidptc, KEYIDPTC)
36 #define keyidget_ F77_FUNC(keyidget, KEYIDGET)
37 #define keyidgtc_ F77_FUNC(keyidgtc, KEYIDGTC)
38 #define keyidgti_ F77_FUNC(keyidgti, KEYIDGTI)
39 #define keyget_ F77_FUNC(keyget, KEYGET)
40 #define keygtc_ F77_FUNC(keygtc, KEYGTC)
41 #define keygtd_ F77_FUNC(keygtd, KEYGTD)
42 #define keygti_ F77_FUNC(keygti, KEYGTI)
43 #define freekeys_ F77_FUNC(freekeys, FREEKEYS)
44
45 #define fitshdr_ F77_FUNC(fitshdr, FITSHDR)
46
47 // Must match the values set in fitshdr.inc.
48 #define KEYID_NAME 100
49 #define KEYID_COUNT 101
50 #define KEYID_IDX 102
51
52 #define KEY_KEYNO 200
53 #define KEY_KEYID 201
54 #define KEY_STATUS 202
55 #define KEY_KEYWORD 203
56 #define KEY_TYPE 204
57 #define KEY_KEYVALUE 205
58 #define KEY_ULEN 206
59 #define KEY_COMMENT 207
60
61 //----------------------------------------------------------------------------
62
keyidput_(int * keyid,const int * i,const int * what,const void * value)63 int keyidput_(int *keyid, const int *i, const int *what, const void *value)
64
65 {
66 const char *cvalp;
67 struct fitskeyid *kidp;
68
69 // Cast pointers.
70 kidp = (struct fitskeyid *)keyid + *i;
71 cvalp = (const char *)value;
72
73 switch (*what) {
74 case KEYID_NAME:
75 // Only eight characters need be given.
76 wcsutil_strcvt(8, ' ', 1, cvalp, kidp->name);
77 wcsutil_null_fill(12, kidp->name);
78 break;
79 default:
80 return 1;
81 }
82
83 return 0;
84 }
85
keyidptc_(int * keyid,const int * i,const int * what,const char * value)86 int keyidptc_(int *keyid, const int *i, const int *what, const char *value)
87 {
88 return keyidput_(keyid, i, what, value);
89 }
90
91 //----------------------------------------------------------------------------
92
keyidget_(const int * keyid,const int * i,const int * what,void * value)93 int keyidget_(const int *keyid, const int *i, const int *what, void *value)
94
95 {
96 char *cvalp;
97 int *ivalp;
98 const struct fitskeyid *keyidp;
99
100 // Cast pointers.
101 keyidp = (const struct fitskeyid *)keyid + *i;
102 cvalp = (char *)value;
103 ivalp = (int *)value;
104
105 switch (*what) {
106 case KEYID_NAME:
107 wcsutil_strcvt(12, ' ', 0, keyidp->name, cvalp);
108 break;
109 case KEYID_COUNT:
110 *ivalp = keyidp->count;
111 break;
112 case KEYID_IDX:
113 *(ivalp++) = keyidp->idx[0];
114 *(ivalp++) = keyidp->idx[1];
115 break;
116 default:
117 return 1;
118 }
119
120 return 0;
121 }
122
keyidgtc_(const int * keyid,const int * i,const int * what,char * value)123 int keyidgtc_(const int *keyid, const int *i, const int *what, char *value)
124 {
125 return keyidget_(keyid, i, what, value);
126 }
127
keyidgti_(const int * keyid,const int * i,const int * what,int * value)128 int keyidgti_(const int *keyid, const int *i, const int *what, int *value)
129 {
130 return keyidget_(keyid, i, what, value);
131 }
132
133 //----------------------------------------------------------------------------
134
135
keyget_(const int * keys,const int * i,const int * what,void * value,int * nc)136 int keyget_(
137 const int *keys,
138 const int *i,
139 const int *what,
140 void *value,
141 int *nc)
142
143 {
144 char *cvalp, text[32];
145 int *ivalp, j;
146 double *dvalp;
147 const struct fitskey *keyp;
148
149 // Cast pointers.
150 keyp = *((const struct fitskey **)keys) + *i;
151 cvalp = (char *)value;
152 ivalp = (int *)value;
153 dvalp = (double *)value;
154
155 *nc = 1;
156 switch (*what) {
157 case KEY_KEYNO:
158 *ivalp = keyp->keyno;
159 break;
160 case KEY_KEYID:
161 *ivalp = keyp->keyid;
162 break;
163 case KEY_STATUS:
164 *ivalp = keyp->status;
165 break;
166 case KEY_KEYWORD:
167 *nc = (int)(strlen(keyp->keyword));
168 wcsutil_strcvt(12, ' ', 0, keyp->keyword, cvalp);
169 break;
170 case KEY_TYPE:
171 *ivalp = keyp->type;
172 break;
173 case KEY_KEYVALUE:
174 switch (abs(keyp->type)%10) {
175 case 1:
176 case 2:
177 // Logical and 32-bit integer.
178 *ivalp = keyp->keyvalue.i;
179 break;
180 case 3:
181 // 64-bit integer.
182 *nc = 3;
183 #ifdef WCSLIB_INT64
184 sprintf(text, "%28.27lld", keyp->keyvalue.k);
185 sscanf(text+1, "%9d%9d%9d", ivalp+2, ivalp+1, ivalp);
186 if (*text == '-') {
187 ivalp[0] *= -1;
188 ivalp[1] *= -1;
189 ivalp[2] *= -1;
190 }
191 #else
192 *(ivalp++) = keyp->keyvalue.k[0];
193 *(ivalp++) = keyp->keyvalue.k[1];
194 *(ivalp++) = keyp->keyvalue.k[2];
195 #endif
196 break;
197 case 4:
198 // Very long integer.
199 *nc = 8;
200 for (j = 0; j < 8; j++) {
201 *(ivalp++) = keyp->keyvalue.l[j];
202 }
203 break;
204 case 5:
205 // Floating point.
206 *dvalp = keyp->keyvalue.f;
207 break;
208 case 6:
209 case 7:
210 // Integer complex and floating point complex.
211 *nc = 2;
212 *(dvalp++) = keyp->keyvalue.c[0];
213 *(dvalp++) = keyp->keyvalue.c[1];
214 break;
215 case 8:
216 // String or part of a continued string.
217 *nc = (int)(strlen(keyp->keyvalue.s));
218 wcsutil_strcvt(72, ' ', 0, keyp->keyvalue.s, cvalp);
219 break;
220 default:
221 // No value.
222 break;
223 }
224 break;
225 case KEY_ULEN:
226 *ivalp = keyp->ulen;
227 break;
228 case KEY_COMMENT:
229 *nc = (int)(strlen(keyp->comment));
230 wcsutil_strcvt(84, ' ', 0, keyp->comment, cvalp);
231 break;
232 default:
233 return 1;
234 }
235
236 return 0;
237 }
238
keygtc_(const int * keys,const int * i,const int * what,char * value,int * nc)239 int keygtc_(
240 const int *keys,
241 const int *i,
242 const int *what,
243 char *value,
244 int *nc)
245 {
246 return keyget_(keys, i, what, value, nc);
247 }
248
keygtd_(const int * keys,const int * i,const int * what,double * value,int * nc)249 int keygtd_(
250 const int *keys,
251 const int *i,
252 const int *what,
253 double *value,
254 int *nc)
255 {
256 return keyget_(keys, i, what, value, nc);
257 }
258
keygti_(const int * keys,const int * i,const int * what,int * value,int * nc)259 int keygti_(
260 const int *keys,
261 const int *i,
262 const int *what,
263 int *value,
264 int *nc)
265 {
266 return keyget_(keys, i, what, value, nc);
267 }
268
269 //----------------------------------------------------------------------------
270
freekeys_(int * keys)271 int freekeys_(int *keys)
272
273 {
274 free(*((struct fitskey **)keys));
275 *keys = 0;
276 return 0;
277 }
278
279 //----------------------------------------------------------------------------
280
fitshdr_(const char header[],const int * nkeyrec,const int * nkeyids,int * keyids,int * nreject,iptr keys)281 int fitshdr_(
282 const char header[],
283 const int *nkeyrec,
284 const int *nkeyids,
285 int *keyids,
286 int *nreject,
287 iptr keys)
288
289 {
290 return fitshdr(header, *nkeyrec, *nkeyids, (struct fitskeyid *)keyids,
291 nreject, (struct fitskey **)keys);
292 }
293