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
|
include <chars.h> # for SQUOTE, ESCAPE, etc
include <tbset.h>
include "tbtables.h"
define LOCN_BEGIN 11 # location of beginning of keyword value
define LOCN_END 30 # location of end of keyword value
# tbfgnp -- get Nth parameter from FITS table
# Get the keyword and value string of header parameter number parnum.
#
# Phil Hodge, 6-Jul-1995 Subroutine created
# Phil Hodge, 27-Nov-1995 Add comment to calling sequence.
procedure tbfgnp (tp, parnum, keyword, dtype, str, comment, maxch)
pointer tp # i: pointer to table descriptor
int parnum # i: number of the parameter to be gotten
char keyword[SZ_KEYWORD] # o: keyword for the parameter
int dtype # o: data type (TY_CHAR, etc)
char str[maxch] # o: string to contain the value of the param.
char comment[maxch] # o: string to contain comment, if any
int maxch # i: max size of str
#--
pointer sp
pointer rec # scratch for header record
pointer value # scratch for value
pointer cmt # scratch for comment
int i, j # loop indexes
int status # zero is OK
int strlen()
bool tbhisc()
errchk tbferr
begin
call smark (sp)
call salloc (rec, SZ_LINE, TY_CHAR)
call salloc (value, SZ_LINE, TY_CHAR)
call salloc (cmt, SZ_LINE, TY_CHAR)
status = 0
# Get the Nth header record.
call fsgrec (TB_FILE(tp), parnum, Memc[rec], status)
if (status != 0)
call tbferr (status)
# Copy the keyword to output and append EOS.
do i = 1, SZ_KEYWORD {
if (Memc[rec+i-1] == BLANK) { # stop at first blank
keyword[i] = EOS
break
}
keyword[i] = Memc[rec+i-1]
}
keyword[SZ_KEYWORD+1] = EOS
# Parse the value and comment.
call fspsvc (Memc[rec], Memc[value], Memc[cmt], status)
# The FITSIO interface puts the contents of a HISTORY or COMMENT
# record in the comment portion, but I prefer it to be the value.
if (tbhisc (keyword)) {
call strcpy (Memc[cmt], Memc[value], maxch)
Memc[cmt] = EOS
# Remove equal sign, quotes, and /, if they are present.
j = strlen (Memc[value])
i = 0 # i is zero indexed
while (Memc[value+i] == BLANK)
i = i + 1
if (Memc[value+i] == '=')
Memc[value+i] = BLANK # replace '=' with blank
while (Memc[value+i] == BLANK)
i = i + 1
if (Memc[value+i] == SQUOTE) {
Memc[value+i] = BLANK # replace quote with blank
while (i < j) { # look for trailing quote
if (Memc[value+i] == SQUOTE) {
if (Memc[value+i-1] != ESCAPE) {
Memc[value+i] = EOS
break
}
}
i = i + 1
}
}
}
# Check for (and remove) quotes enclosing the value.
if (Memc[value] == SQUOTE) {
j = strlen (Memc[value])
Memc[value+j-1] = EOS # clobber close quote
do i = 1, j-1 # shift left one character
Memc[value+i-1] = Memc[value+i]
}
# Trim trailing blanks from keyword value.
do i = strlen (Memc[value]), 1, -1 {
if (Memc[value+i-1] == BLANK)
Memc[value+i-1] = EOS
else
break
}
# Trim trailing blanks from comment.
do i = strlen (Memc[cmt]), 1, -1 {
if (Memc[cmt+i-1] == BLANK)
Memc[cmt+i-1] = EOS
else
break
}
# Copy the value and comment to output.
call strcpy (Memc[value], str, maxch)
call strcpy (Memc[cmt], comment, maxch)
# Determine the data type.
call strupr (Memc[rec])
do i = 1, SZ_LINE {
# Fill out the buffer from the comment on (or from EOS).
if (Memc[rec+i-1] == '/' || Memc[rec+i-1] == EOS) {
do j = i, SZ_LINE
Memc[rec+j-1] = EOS
break
}
}
if (tbhisc (keyword)) {
dtype = TY_CHAR
} else if (Memc[rec+LOCN_BEGIN-1] == SQUOTE) {
dtype = TY_CHAR
} else if (Memc[rec+LOCN_END-1] == 'T' ||
Memc[rec+LOCN_END-1] == 'F') {
dtype = TY_BOOL
} else {
dtype = TY_INT # may be reset below
do i = LOCN_BEGIN, LOCN_END {
if (Memc[rec+i-1] == EOS)
break
if (Memc[rec+i-1] == '.' ||
Memc[rec+i-1] == 'E' || Memc[rec+i-1] == 'D') {
dtype = TY_DOUBLE
break
}
}
# We should also check whether there's an imaginary part.
}
call sfree (sp)
end
|
