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
|
include <tbset.h>
# T_TBKEYCOL -- For all the rows of a list of ST tables, copy the values of
# selected table keywords into new columns of the same name. If the columns
# already exist no action is taken.
procedure t_tbkeycol ()
int tlist # the tables list descriptor
int klist # the keywords list descriptor
bool bval
double dval
int i, keytype, keyptr, nrows, keylength, ival
pointer sp, table, keyword, keyvalue, format, tp, colptr
real rval
bool itob()
int clpopnu(), clgfil(), clplen(), tbpsta(), strlen(), access()
int ctoi(), ctor(), ctod()
pointer tbtopn()
errchk tbtopn()
begin
# Open the lists of tables and keywords.
tlist = clpopnu ("tables")
if (clplen (tlist) <= 0)
return
klist = clpopnu ("keywords")
if (clplen (klist) <= 0)
return
# Allocate working space.
call smark (sp)
call salloc (table, SZ_FNAME, TY_CHAR)
call salloc (keyword, SZ_KEYWORD, TY_CHAR)
call salloc (keyvalue, SZ_PARREC, TY_CHAR)
call salloc (format, SZ_COLFMT, TY_CHAR)
# Loop over the list of ST tables.
while (clgfil (tlist, Memc[table], SZ_FNAME) != EOF) {
# If the file is not an ST table go to the next file in the list.
if (access(Memc[table], 0, TEXT_FILE) == YES)
next
iferr (tp = tbtopn (Memc[table], READ_WRITE, 0))
next
if (tbpsta (tp, TBL_WHTYPE) == TBL_TYPE_TEXT)
next
# Loop over the keywords.
while (clgfil (klist, Memc[keyword], SZ_FNAME) != EOF) {
# If a column named keyword already exists in the table
# skip to the next keyword.
call tbcfnd (tp, Memc[keyword], colptr, 1)
if (colptr != NULL)
next
# If keyword does not exist in the table skip to the
# next keyword.
call tbhfkr (tp, Memc[keyword], keytype, Memc[keyvalue],
keyptr)
if (keyptr == 0)
next
nrows = tbpsta (tp, TBL_NROWS)
# Decode the header value and copy it into all the rows
# of the table.
i = 1
switch (keytype) {
case TY_BOOL:
call tbcdef (tp, colptr, Memc[keyword], "undefined",
"%-3.3b", keytype, 1, 1)
if (ctoi (Memc[keyvalue], i, ival) <= 0)
ival = NO
bval = itob (ival)
do i = 1, nrows
call tbrptb (tp, colptr, bval, 1, i)
case TY_CHAR:
keylength = strlen (Memc[keyvalue])
call sprintf (Memc[format], SZ_COLFMT, "%*.*s")
call pargi (-keylength)
call pargi (keylength)
call tbcdef (tp, colptr, Memc[keyword], "undefined",
Memc[format], -keylength, 1, 1)
do i = 1, nrows
call tbrptt (tp, colptr, Memc[keyvalue], keylength,
1, i)
case TY_INT:
keylength = ctoi (Memc[keyvalue], i, ival)
if (keylength <= 0) {
ival = INDEFI
keylength = 6
}
call sprintf (Memc[format], SZ_COLFMT, "%%%d.%dd")
call pargi (-keylength)
call pargi (keylength)
call tbcdef (tp, colptr, Memc[keyword], "undefined",
Memc[format], keytype, 1, 1)
do i = 1, nrows
call tbrpti (tp, colptr, ival, 1, i)
case TY_REAL:
keylength = ctor (Memc[keyvalue], i, rval)
if (keylength <= 0) {
rval = INDEFR
keylength = 6
}
call sprintf (Memc[format], SZ_COLFMT, "%%%dg")
call pargi (-keylength)
call tbcdef (tp, colptr, Memc[keyword], "undefined",
Memc[format], keytype, 1, 1)
do i = 1, nrows
call tbrptr (tp, colptr, rval, 1, i)
case TY_DOUBLE:
keylength = ctod (Memc[keyvalue], i, dval)
if (keylength <= 0) {
dval = INDEFD
keylength = 6
}
call sprintf (Memc[format], SZ_COLFMT, "%%%dg")
call pargi (-keylength)
call tbcdef (tp, colptr, Memc[keyword], "undefined",
Memc[format], keytype, 1, 1)
do i = 1, nrows
call tbrptd (tp, colptr, dval, 1, i)
}
}
call tbtclo (tp)
call clprew (klist)
}
call clpcls (klist)
call clpcls (tlist)
call sfree (sp)
end
|
