aboutsummaryrefslogtreecommitdiff
path: root/pkg/utilities/nttools/threed/txtable/txtone.x
blob: d286523d49d40a24d5579f83b320cf169f49760d (plain) (blame)
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
include	<tbset.h>

#  TXTONE  --  Extract 2D tables from a single input 3D table.
#
#
#  This code is adapted from B.Simon's 04-Nov-94 version of tcopy.
#
#
#
#  Revision history:
#  ----------------
#
#  22-Nov-1996  -  Task created (I.Busko)
#  16-Dec-1996  -  Add ORIG_ROW keyword (IB).
#  03-Jan-1997  -  Revised after code review (IB)
#  17-Mar-1997  -  Added selrows call (IB)
#   8-Apr-1999  -  Call tbfpri (Phil Hodge)
#   8-Apr-2002  -  Remove the call to whatfile (P. Hodge)


procedure txtone (input, output, verbose, compact)

char	input[ARB]	# i: input table name
char	output[ARB]	# i: output table name
bool	compact		# i: put scalars in header ?
bool	verbose		# i: print operations ?
#--
int     numrow, numcol, numptr, type, irow, nrows
int	phu_copied	# set by tbfpri and ignored
pointer	sp, root, extend, rowselect, colselect, colname, colunits, colfmt
pointer errmsg, itp, otp, colptr, newcol, pcode 
pointer	newname
bool	suffix

string	nosect  "Sections not permitted on output table name (%s)"
string	nocols  "Column names not found (%s)"

errchk	tbfpri, tbtopn, tctexp, tbracket, trsopen, trseval

bool	trseval(), streq()
int	tbpsta(), selrows()
pointer	tbtopn(), trsopen()

begin
	# Allocate memory for temporary strings.
	call smark (sp)
	call salloc (root,      SZ_FNAME,    TY_CHAR)
	call salloc (newname,   SZ_FNAME,    TY_CHAR)
	call salloc (extend,    SZ_FNAME,    TY_CHAR)
	call salloc (rowselect, SZ_FNAME,    TY_CHAR)
	call salloc (colselect, SZ_FNAME,    TY_CHAR)
        call salloc (colname,   SZ_COLNAME,  TY_CHAR)
        call salloc (colunits,  SZ_COLUNITS, TY_CHAR)
        call salloc (colfmt,    SZ_COLFMT,   TY_CHAR)
	call salloc (errmsg,    SZ_LINE,     TY_CHAR)

	# Selectors are forbbiden on output.
	call rdselect (output, Memc[root], Memc[rowselect], 
                       Memc[colselect], SZ_FNAME)
	if (Memc[rowselect] != EOS || Memc[colselect] != EOS) {
	    call sprintf (Memc[errmsg], SZ_LINE, nosect)
	    call pargstr (output)
	    call error (1, Memc[errmsg])
	}

	# Break input file name into bracketed selectors.
	call rdselect (input, Memc[root], Memc[rowselect], 
                       Memc[colselect], SZ_FNAME)

	# Open input table and get some info about it.
	itp = tbtopn (Memc[root], READ_ONLY, NULL)
	numrow = tbpsta (itp, TBL_NROWS)
	numcol = tbpsta (itp, TBL_NCOLS)

	# Find how many rows were requested by row selector.
	# If only one, turn off suffixing. Also do it in case
	# ASCII output was requested.
	nrows = selrows (itp, Memc[rowselect])
	if (nrows == 1)
	    suffix = false
	else
	    suffix = true
	if (streq (output, "STDOUT"))
	    suffix = false

	# Create array of column pointers from column selector.
	call malloc (colptr, numcol, TY_INT)
	call malloc (newcol, numcol, TY_INT)
	call tcs_open (itp, Memc[colselect], Memi[colptr], numptr, numcol)

	# Take an error exit if no columns were matched.
	if (numptr == 0) {
	    call sprintf (Memc[errmsg], SZ_LINE, nocols)
	        call pargstr (input)
	        call error (1, Memc[errmsg])
	}

	# Loop over selected rows on input table, creating
	# a 2D output table for each row.
	pcode = trsopen (itp, Memc[rowselect])
	do irow = 1, numrow {
	    if (trseval (itp, irow, pcode)) {

	        # Append suffix to output name.
	        if (suffix)
	            call txtsuff (output, Memc[newname], irow)
	        else
	            call strcpy (output, Memc[newname], SZ_FNAME)

		if (verbose) {
		    call printf ("%s row=%d  -> %s\n")
			call pargstr (input)
			call pargi (irow)
			call pargstr (Memc[newname])
	                call flush (STDOUT)
		}

	        # Open output table and set its type.
		call tbfpri (Memc[root], Memc[newname], phu_copied)
	        otp = tbtopn (Memc[newname], NEW_FILE, NULL)
	        type = tbpsta (itp, TBL_WHTYPE)
	        if (streq (output, "STDOUT"))   # ASCII output.
	            type = TBL_TYPE_TEXT
	        call tbpset (otp, TBL_WHTYPE, type)

	        # Copy column information from input to output.
	        call txtcpyco (otp, colptr, newcol, numptr, colname, 
                              colunits, colfmt, compact)

	        # Create table and copy header.
	        call tbtcre (otp)
	        call tbhcal (itp, otp)

	        # Copy row number into header.
	        call tbhadi (otp, "ORIG_ROW", irow)

	        # Copy scalar columns into header.
	        if (compact)
	            call txtcpysc (otp, colptr, newcol, numptr, colname, 
                                   colunits, colfmt)

	        # Copy number of columns into header. This is used
	        # by task that reads back 2D tables into 3D format.
	        if (compact)
	            call tbhadi (otp, "TCTOTAL", numptr)

	        # Copy data to output table.
	        call txtcpy (itp, otp, irow, Memi[colptr], Memi[newcol],
                             numptr, compact)

	        # Close output.
	        call tbtclo (otp)
	    }
	}

	# Free arrays associated with columns.
	call tcs_close (Memi[colptr], numptr)
	call mfree (newcol, TY_INT)
	call mfree (colptr, TY_INT)

	# Close row selector structure and input table.
	call trsclose (pcode)
	call tbtclo (itp)

	call sfree (sp)
end




#  Appends sufix to output file name.

procedure txtsuff (filename, newname, row)

char	filename[ARB]	# i: output table name
char	newname[ARB]	# o: output table name with suffix
int	row		# i: row number

pointer	sp, ext, suffix
int	dot, i, j

int	strcmp(), strldxs()

begin
	call smark (sp)
	call salloc (suffix, SZ_LINE, TY_CHAR)
	call salloc (ext,    SZ_LINE, TY_CHAR)

	# Get rid of any appendages except the extension.
	call imgcluster (filename, newname, SZ_FNAME)

	# Valid extensions are .tab, .fit and .fits
	# Everything else is part of the root file name.

	# Detect extension.
	Memc[ext] = EOS
	dot = strldxs (".", newname)
	if (dot != 0) {
	    i = dot
	    j = 0
	    while (newname[i] != EOS) {
	        Memc[ext+j] = newname[i]
	        j = j + 1
	        i = i + 1
	    }
	    Memc[ext+j] = EOS
	}

	# If valid extension, remove it from name.
	if ( (strcmp (Memc[ext], ".tab")  == 0) ||
	     (strcmp (Memc[ext], ".fit")  == 0) ||
	     (strcmp (Memc[ext], ".fits") == 0) ) 
	    newname[dot] = EOS
	else
	    Memc[ext] = EOS

	# Build suffix.
	call sprintf (Memc[suffix], SZ_LINE, "_r%04d")
	    call pargi (row)

	# Append suffix and extension to root name.
	call strcat (Memc[suffix], newname, SZ_FNAME)
	call strcat (Memc[ext],    newname, SZ_FNAME)

	call sfree (sp)
end