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
|
include <tbset.h>
# TXICPY -- Copy data from single row and column in 3D table to
# 1-D image.
#
#
#
#
# Revision history:
# ----------------
#
# 26-Nov-96 - Task created (I.Busko)
procedure txicpy (itp, im, irow, icp, datatype, size)
pointer itp # i: pointer to descriptor of input table
pointer im # i: pointer to output image
int irow # i: row in input table
pointer icp # i: array of pointers for input columns
int datatype # i: data type
int size # i: array size
#--
int nbuf
pointer sp, bufin, bufout, errmsg, colname
string badtype "Unsupported column data type (%s)"
pointer impl1s(), impl1i(), impl1r(), impl1d()
begin
call smark (sp)
call salloc (bufin, size, datatype)
switch (datatype) {
case TY_SHORT:
call tcs_rdarys (itp, icp, irow, size, nbuf, Mems[bufin])
bufout = impl1s (im)
call amovs (Mems[bufin], Mems[bufout], size)
case TY_INT,TY_LONG:
call tcs_rdaryi (itp, icp, irow, size, nbuf, Memi[bufin])
bufout = impl1i (im)
call amovi (Memi[bufin], Memi[bufout], size)
case TY_REAL:
call tcs_rdaryr (itp, icp, irow, size, nbuf, Memr[bufin])
bufout = impl1r (im)
call amovr (Memr[bufin], Memr[bufout], size)
case TY_DOUBLE:
call tcs_rdaryd (itp, icp, irow, size, nbuf, Memd[bufin])
bufout = impl1d (im)
call amovd (Memd[bufin], Memd[bufout], size)
default:
# Unsupported type, write error message
call salloc (colname, SZ_COLNAME, TY_CHAR)
call salloc (errmsg, SZ_LINE, TY_CHAR)
call tcs_txtinfo (icp, TBL_COL_NAME, Memc[colname], SZ_COLNAME)
call sprintf (Memc[errmsg], SZ_LINE, badtype)
call pargstr (Memc[colname])
call error (1, Memc[errmsg])
}
call sfree (sp)
end
|
