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
|
include <tbset.h>
define USRERR 1
# GETTABDAT -- Read an element from a table into a string
#
# B.Simon 17-Aug-1987 First Code
# Phil Hodge 15-May-2002 Add 'format' argument. ctowrd is a function.
procedure gettabdat (hd, colname, rownum, maxch, format, value, undef, eltype)
pointer hd # i: Table descriptor
char colname[ARB] # i: Table column name
int rownum # i: Table row number
int maxch # i: Maximum length of element value
bool format # i: Format the value using table print format?
char value[ARB] # o: Table element value
bool undef # o: Is table element undefined?
int eltype # o: Type of table element
bool nullbuf[1]
int lendata, ip
pointer colptr[1]
pointer sp, errtxt, valbuf
double dval[1]
real rval[1]
int ival[1]
bool bval[1]
string badnamerr "Column name not found in table (%s)"
string unknown_type "Unknown data type in table"
int tbcigi()
int junk, ctowrd()
begin
# Allocate dynamic memory to hold strings
call smark (sp)
call salloc (errtxt, SZ_LINE, TY_CHAR)
call salloc (valbuf, maxch, TY_CHAR)
# Get the column pointer from the column name
call tbcfnd (hd, colname, colptr, 1)
# If the pointer is NULL, the column was not found
if (colptr[1] == NULL) {
call sprintf (Memc[errtxt], SZ_LINE, badnamerr)
call pargstr (colname)
call error (USRERR, Memc[errtxt])
}
# Get the column data type. Store in eltype
eltype = tbcigi (colptr[1], TBL_COL_DATATYPE)
if (eltype < 0) {
lendata = - eltype
eltype = TY_CHAR
}
# Get the table element as a text string
if (format || eltype == TY_CHAR) {
call tbrgtt (hd, colptr, Memc[valbuf], nullbuf, maxch, 1, rownum)
} else {
switch (eltype) {
case TY_BOOL :
call tbrgtb (hd, colptr, bval, nullbuf, 1, rownum)
if (bval[1])
call strcpy ("yes", Memc[valbuf], maxch)
else
call strcpy ("no", Memc[valbuf], maxch)
case TY_SHORT,TY_INT :
call tbrgti (hd, colptr, ival, nullbuf, 1, rownum)
call sprintf (Memc[valbuf], maxch, "%d")
call pargi (ival)
case TY_REAL :
call tbrgtr (hd, colptr, rval, nullbuf, 1, rownum)
call sprintf (Memc[valbuf], maxch, "%15.7g")
call pargr (rval)
case TY_DOUBLE :
call tbrgtd (hd, colptr, dval, nullbuf, 1, rownum)
call sprintf (Memc[valbuf], maxch, "%25.16g")
call pargd (dval)
default :
call error (1, unknown_type)
}
}
if (eltype == TY_CHAR) {
# Just do a straight copy if the element is a string
call strcpy (Memc[valbuf], value, maxch)
} else{
# Otherwise, strip whitespace from element value
ip = 1
junk = ctowrd (Memc[valbuf], ip, value, maxch)
}
undef = nullbuf[1]
call sfree (sp)
return
end
|
