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
|
# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
include <error.h>
include <imhdr.h>
include <imio.h>
include <qpset.h>
include "qpf.h"
# QPF_COPYPARAMS -- Copy parameters from the QPOE datafile header into the
# image header. Only scalar parameters are copied.
procedure qpf_copyparams (im, qp)
pointer im #I image descriptor
pointer qp #I QPOE descriptor
int nelem, dtype, maxelem, flags
pointer sp, param, text, comment, datatype, fl, qpf, mw, io
pointer qp_ofnlu(), qpio_loadwcs()
int qp_gnfn(), qp_queryf(), stridx(), strdic()
errchk qp_ofnlu, qp_gnfn, qp_queryf, imaddi, qp_geti, mw_saveim
bool qp_getb()
short qp_gets()
int qp_geti(), qp_gstr()
real qp_getr()
double qp_getd()
begin
call smark (sp)
call salloc (text, SZ_LINE, TY_CHAR)
call salloc (param, SZ_FNAME, TY_CHAR)
call salloc (comment, SZ_COMMENT, TY_CHAR)
call salloc (datatype, SZ_DATATYPE, TY_CHAR)
qpf = IM_KDES(im)
# Copy QPOE special keywords.
call imaddi (im, "NAXES", qp_geti(qp,"naxes"))
call imaddi (im, "AXLEN1", qp_geti(qp,"axlen[1]"))
call imaddi (im, "AXLEN2", qp_geti(qp,"axlen[2]"))
call imaddr (im, "XBLOCK", QPF_XBLOCK(qpf))
call imaddr (im, "YBLOCK", QPF_YBLOCK(qpf))
# Output the QPOE filter.
iferr (call qpf_wfilter (qpf, im))
call erract (EA_WARN)
# Compute and output any filter attributes.
iferr (call qpf_wattr (qpf, im))
call erract (EA_WARN)
# Copy the WCS, if any.
io = QPF_IO(qpf)
if (io != NULL)
ifnoerr (mw = qpio_loadwcs (io)) {
call mw_saveim (mw, im)
call mw_close (mw)
}
# Copy general keywords.
fl = qp_ofnlu (qp, "*")
while (qp_gnfn (fl, Memc[param], SZ_FNAME) != EOF) {
# Get the next scalar parameter which has a nonnull value.
nelem = qp_queryf (qp, Memc[param], Memc[datatype], maxelem,
Memc[comment], flags)
if (strdic (Memc[param], Memc[text], SZ_LINE, OMIT) > 0)
next
dtype = stridx (Memc[datatype], "bcsilrdx")
# Make entry for a parameter which has no value, or an unprintable
# value.
if (nelem == 0 || (nelem > 1 && dtype != TY_CHAR) ||
dtype < TY_BOOL || dtype > TY_COMPLEX) {
call sprintf (Memc[text], SZ_LINE, "%14s[%03d] %s")
call pargstr (Memc[datatype])
call pargi (nelem)
call pargstr (Memc[comment])
iferr (call imastr (im, Memc[param], Memc[text]))
call erract (EA_WARN)
next
}
# Copy parameter to image header.
iferr {
switch (dtype) {
case TY_BOOL:
call imaddb (im, Memc[param], qp_getb(qp,Memc[param]))
case TY_CHAR:
if (qp_gstr (qp, Memc[param], Memc[text], SZ_LINE) > 0)
call imastr (im, Memc[param], Memc[text])
case TY_SHORT:
call imadds (im, Memc[param], qp_gets(qp,Memc[param]))
case TY_INT, TY_LONG:
call imaddi (im, Memc[param], qp_geti(qp,Memc[param]))
case TY_REAL:
call imaddr (im, Memc[param], qp_getr(qp,Memc[param]))
case TY_DOUBLE:
call imaddd (im, Memc[param], qp_getd(qp,Memc[param]))
case TY_COMPLEX:
; # not supported.
}
} then {
call erract (EA_WARN)
break
}
}
call qp_cfnl (fl)
call sfree (sp)
end
|
