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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
|
include <imio.h>
include <imhdr.h>
include "keyselect.h"
#* HISTORY *
#* B.Simon 12-Mar-92 Original
# GET_KEYWORD -- Get the keyword from the image header
procedure get_keyword (im, name, dtype, value, maxch)
pointer im # i: image descriptor
char name[ARB] # i: keyword name
int dtype # o: keyword data type
char value[ARB] # o: keyword value
int maxch # i: maximum length of value string
#--
include "keyselect.com"
string badname "Warning: header keyword %s not found in %s\n"
int imgftype(), gf_gfind()
begin
# Any name beginning with a $ is a special keyword
if (name[1] == '$') {
call spec_keyword (im, name, dtype, value, maxch)
} else {
# Get the data type of the header keyword
# If the keyword is not found set the data type to
# zero to indicate this and return
iferr {
dtype = imgftype (im, name)
} then {
call eprintf (badname)
call pargstr (name)
call pargstr (IM_HDRFILE(im))
dtype = 0
value[1] = EOS
return
}
if (dtype == TY_SHORT || dtype == TY_LONG)
dtype = TY_INT
if (dtype == TY_CHAR)
dtype = - maxch
# Read header keyword from image. This procedure sets hasgroup
# to true if asked to retrieve a group parameter
call imgstr (im, name, value, maxch)
if (dtype == TY_BOOL) {
if (value[1] == 'T') {
call strcpy ("yes", value, maxch)
} else {
call strcpy ("no", value, maxch)
}
}
if (gf_gfind (im, name) > 0)
hasgroup = true
}
end
# NAME_KEYWORD -- Retrieve the default column name for a special keyword
procedure name_keyword (name, colname, maxch)
char name[ARB] # i: keyword name
char colname[ARB] # o: default column name
int maxch # i: maximum length of column name
#--
int idx, junk
pointer sp, errmsg
string special "group,dir,ext,hdr,pix,root"
string defaults "group,directory,extension,header_file,data_file,rootname"
string badname "Name for special keyword not recognized (%s)"
int word_match(), word_find()
begin
call smark (sp)
call salloc (errmsg, SZ_LINE, TY_CHAR)
if (name[1] != '$') {
call strcpy (name, colname, maxch)
return
}
# Get the index of special keyword name in the list
# The find the corresponding name in the list of defaults
idx = word_match (name[2], special)
if (idx == 0) {
call sprintf (Memc[errmsg], SZ_LINE, badname)
call pargstr (name)
call error (1, Memc[errmsg])
} else {
junk = word_find (idx, defaults, colname, maxch)
}
call sfree (sp)
end
# SPEC_KEYWORD -- Get the value of a special keyword
procedure spec_keyword (im, name, dtype, value, maxch)
pointer im # i: image descriptor
char name[ARB] # i: keyword name
int dtype # o: keyword data type
char value[ARB] # o: keyword value
int maxch # i: maximum length of value string
#--
include "keyselect.com"
int match, ival, junk
pointer sp, image, ldir, root, errmsg, hdr, ext
string int_special "group"
string str_special "dir,ext,hdr,pix,root"
string badname "Name for special keyword not recognized (%s)"
string badimgext "Image extension not recognized (%s)"
bool streq()
int word_match(), fnldir(), fnroot(), itoc()
begin
call smark (sp)
call salloc (image, SZ_FNAME, TY_CHAR)
call salloc (ldir, SZ_FNAME, TY_CHAR)
call salloc (root, SZ_FNAME, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
# Search lists for special keyword
match = - word_match (name[2], int_special)
if (match == 0)
match = word_match (name[2], str_special)
# Data type is determined from which list it is on
if (match < 0) {
dtype = TY_INT
} else if (match > 0) {
dtype = - maxch
} else {
call sprintf (Memc[errmsg], SZ_LINE, badname)
call pargstr (name)
call error (1, Memc[errmsg])
}
# Break image name into its component parts
if (match > 0) {
call imgcluster (IM_HDRFILE(im), Memc[image], SZ_FNAME)
hdr = image + fnldir (Memc[image], Memc[ldir], SZ_FNAME)
ext = hdr + 1 + fnroot (Memc[hdr], Memc[root], SZ_FNAME)
}
# Get value of special keyword
switch (match) {
case -1:
# group number $group
hasgroup = true
ival = max (1, IM_CLINDEX(im))
junk = itoc (ival, value, maxch)
case 0:
# (not used)
;
case 1:
# directory name $dir
call strcpy (Memc[ldir], value, maxch)
case 2:
# extension $ext
call strcpy (Memc[ext], value, maxch)
case 3:
# header file name $hdr
call strcpy (Memc[hdr], value, maxch)
case 4:
# pixel file name $pix
if (Memc[ext+2] != 'h' || Memc[ext+3] != EOS) {
call sprintf (Memc[errmsg], SZ_LINE, badimgext)
call pargstr (Memc[hdr])
call error (1, Memc[errmsg])
}
call strcpy (Memc[root], value, maxch)
if (streq (Memc[ext], "imh")) {
call strcat (".pix", value, maxch)
} else {
Memc[ext+2] = 'd'
call strcat (".", value, maxch)
call strcat (Memc[ext], value, maxch)
}
case 5:
# root name $root
call strcpy (Memc[root], value, maxch)
}
call sfree (sp)
end
# TYPE_KEYWORD -- Retrieve the type of a special keyword
int procedure type_keyword (name)
char name[ARB] # i: special keyword name
#--
int dtype
pointer sp, errmsg
string int_special "group"
string str_special "dir,ext,hdr,pix,root"
string badname "Name for special keyword not recognized (%s)"
int word_match()
begin
call smark (sp)
call salloc (errmsg, SZ_LINE, TY_CHAR)
if (name[1] != '$') {
call sprintf (Memc[errmsg], SZ_LINE, badname)
call pargstr (name)
call error (1, Memc[errmsg])
} else if (word_match (name[2], int_special) > 0) {
dtype = TY_INT
} else if (word_match (name[2], str_special) > 0) {
dtype = TY_CHAR
} else {
call sprintf (Memc[errmsg], SZ_LINE, badname)
call pargstr (name)
call error (1, Memc[errmsg])
}
call sfree (sp)
return (dtype)
end
|
