aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/tbhad.x
blob: 2ca4d0384becd6695a506d85867e6f8af6f51fb2 (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
include <tbset.h>
include "tbtables.h"
include "tblerr.h"

# Add a keyword and value into the table header.  If the keyword already
# exists the value will be replaced; otherwise, a new keyword will be added.
#
# Phil Hodge,  7-Aug-1987  Subroutine created.
# Phil Hodge, 28-Dec-1987  Different data types combined into one file.
# Phil Hodge,  9-Mar-1989  Change dtype from char to int.
# Phil Hodge, 21-Jul-1992  Change format in tbhadd to %25.16g.
# Phil Hodge,  3-Apr-1995  Set TB_MODIFIED to true.
# Phil Hodge, 14-Jun-1995  Modify for FITS tables.

# tbhadd -- add double header parameter

procedure tbhadd (tp, keyword, value)

pointer tp			# i: Pointer to table descriptor
double	value			# i: Value of parameter
char	keyword[ARB]		# i: Name of parameter
#--
pointer sp
pointer	par			# buffer for header record for parameter
int	dtype			# data type
int	parnum			# parameter number (> 0 if found)
bool	tbhisc()
errchk	tbhfkw, tbhpnp, tbhanp, tbfhpd

begin
	if (TB_READONLY(tp))
	    call error (ER_TBREADONLY, "can't write to table; it's readonly")
	if (tbhisc (keyword))
	    call error (ER_TBDTYPECONFLICT,
		"tbhadd:  can't put numeric parameter as comment or history")

	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
	    call tbfhpd (tp, keyword, value)
	    TB_MODIFIED(tp) = true
	    return
	}

	dtype = TY_DOUBLE
	call smark (sp)
	call salloc (par, SZ_PARREC, TY_CHAR)
	call sprintf (Memc[par], SZ_PARREC, "%-25.16g")
	    call pargd (value)
	call tbhfkw (tp, keyword, parnum)			# find keyword
	if (parnum > 0)
	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
	else
	    call tbhanp (tp, keyword, dtype, Memc[par], parnum)	# add new param.

	TB_MODIFIED(tp) = true

	call sfree (sp)
end

# tbhadr -- add real header parameter

procedure tbhadr (tp, keyword, value)

pointer tp			# i: Pointer to table descriptor
real	value			# i: Value of parameter
char	keyword[ARB]		# i: Name of parameter
#--
pointer sp
pointer	par			# buffer for header record for parameter
int	dtype			# data type
int	parnum			# parameter number (> 0 if found)
bool	tbhisc()
errchk	tbhfkw, tbhpnp, tbhanp, tbfhpr

begin
	if (TB_READONLY(tp))
	    call error (ER_TBREADONLY, "can't write to table; it's readonly")
	if (tbhisc (keyword))
	    call error (ER_TBDTYPECONFLICT,
		"tbhadr:  can't put numeric parameter as comment or history")

	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
	    call tbfhpr (tp, keyword, value)
	    TB_MODIFIED(tp) = true
	    return
	}

	dtype = TY_REAL
	call smark (sp)
	call salloc (par, SZ_PARREC, TY_CHAR)
	call sprintf (Memc[par], SZ_PARREC, "%-15.7g")
	    call pargr (value)
	call tbhfkw (tp, keyword, parnum)			# find keyword
	if (parnum > 0)
	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
	else
	    call tbhanp (tp, keyword, dtype, Memc[par], parnum)	# add new param.

	TB_MODIFIED(tp) = true

	call sfree (sp)
end

# tbhadi -- add integer header parameter

procedure tbhadi (tp, keyword, value)

pointer tp			# i: Pointer to table descriptor
int	value			# i: Value of parameter
char	keyword[ARB]		# i: Name of parameter
#--
pointer sp
pointer	par			# buffer for header record for parameter
int	dtype			# data type
int	parnum			# parameter number (> 0 if found)
bool	tbhisc()
errchk	tbhfkw, tbhpnp, tbhanp, tbfhpi

begin
	if (TB_READONLY(tp))
	    call error (ER_TBREADONLY, "can't write to table; it's readonly")
	if (tbhisc (keyword))
	    call error (ER_TBDTYPECONFLICT,
		"tbhadi:  can't put numeric parameter as comment or history")

	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
	    call tbfhpi (tp, keyword, value)
	    TB_MODIFIED(tp) = true
	    return
	}

	dtype = TY_INT
	call smark (sp)
	call salloc (par, SZ_PARREC, TY_CHAR)
	call sprintf (Memc[par], SZ_PARREC, "%-11d")
	    call pargi (value)
	call tbhfkw (tp, keyword, parnum)			# find keyword
	if (parnum > 0)
	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
	else
	    call tbhanp (tp, keyword, dtype, Memc[par], parnum)	# add new param.

	TB_MODIFIED(tp) = true

	call sfree (sp)
end

# tbhadb -- add Boolean header parameter

procedure tbhadb (tp, keyword, value)

pointer tp			# i: Pointer to table descriptor
bool	value			# i: Value of parameter
char	keyword[ARB]		# i: Name of parameter
#--
pointer sp
pointer	par			# buffer for header record for parameter
int	dtype			# data type
int	parnum			# parameter number (> 0 if found)
int	intval			# buffer for writing value into string
bool	tbhisc()
errchk	tbhfkw, tbhpnp, tbhanp, tbfhpb

begin
	if (TB_READONLY(tp))
	    call error (ER_TBREADONLY, "can't write to table; it's readonly")
	if (tbhisc (keyword))
	    call error (ER_TBDTYPECONFLICT,
		"tbhadb:  can't put Boolean parameter as comment or history")

	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
	    call tbfhpb (tp, keyword, value)
	    TB_MODIFIED(tp) = true
	    return
	}

	dtype = TY_BOOL
	call smark (sp)
	call salloc (par, SZ_PARREC, TY_CHAR)
	if (value)
	    intval = YES
	else
	    intval = NO
	call sprintf (Memc[par], SZ_PARREC, "%-11d")
	    call pargi (intval)
	call tbhfkw (tp, keyword, parnum)			# find keyword
	if (parnum > 0)
	    call tbhpnp (tp, parnum, keyword, dtype, Memc[par])	# put Nth param.
	else
	    call tbhanp (tp, keyword, dtype, Memc[par], parnum)	# add new param.

	TB_MODIFIED(tp) = true

	call sfree (sp)
end

# tbhadt -- add character header parameter

procedure tbhadt (tp, keyword, text)

pointer tp			# i: Pointer to table descriptor
char	keyword[ARB]		# i: Name of parameter
char	text[ARB]		# i: Value of parameter
#--
int	dtype			# data type
int	parnum			# parameter number (> 0 if found)
bool	tbhisc()		# true if keyword is comment or history
errchk	tbhfkw, tbhpnp, tbhanp, tbfhpt

begin
	if (TB_READONLY(tp))
	    call error (ER_TBREADONLY, "can't write to table; it's readonly")

	if (TB_TYPE(tp) == TBL_TYPE_FITS) {
	    call tbfhpt (tp, keyword, text)
	    TB_MODIFIED(tp) = true
	    return
	}

	dtype = TY_CHAR

	if (tbhisc (keyword)) {				# comment or history?
	    call tbhanp (tp, keyword, dtype, text, parnum)	# then add new
	} else {
	    call tbhfkw (tp, keyword, parnum)			# find keyword
	    if (parnum > 0)
		call tbhpnp (tp, parnum, keyword, dtype, text)	# put Nth param.
	    else
		call tbhanp (tp, keyword, dtype, text, parnum)	# add new param.
	}

	TB_MODIFIED(tp) = true
end