Repatch (from linux) of OSX IRAF

1 files changed, 98 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/threed/titable/tirows.gx b/pkg/utilities/nttools/threed/titable/tirows.gx
new file mode 100644
index 00000000..161b39ce
--- /dev/null
+++ b/pkg/utilities/nttools/threed/titable/tirows.gx
@@ -0,0 +1,98 @@
+include	<tbset.h>
+
+#
+# TIROWS  --  Expand row selector into array and copy it into output 
+#             table cell.
+#
+#
+#
+#
+#  Revision history:
+#  ----------------
+#  20-Jan-1997  -  Task created (I.Busko)
+#   7-Feb-2000  -  For datatype = 'c', make buf an array of strings (P.Hodge)
+
+
+$if (datatype == c)
+procedure tirowst  (itp, icp, otp, ocp, rowsel, orow, maxch, len, buf)
+$else
+procedure tirows$t (itp, icp, otp, ocp, rowsel, orow, len, buf)
+$endif
+
+pointer	itp		# i: input table descriptor
+pointer	icp		# i: input column descriptor
+pointer	otp		# i: output table descriptor
+pointer	ocp		# i: output column descriptor
+char	rowsel[ARB]	# i: row selector
+int	orow		# i: row in output table where to write into
+$if (datatype == c)
+int	maxch		# i: max length of string
+$endif
+int	len		# i: buffer length
+$if (datatype == c)
+char	buf[maxch,ARB]	# i: work buffer
+$else
+PIXEL	buf[ARB]
+$endif
+#--
+double	undefd
+real	undefr
+pointer	pcode
+int	undefi, i, nelem, irow, numrow, alength
+short	undefs
+
+pointer	trsopen()
+int	tbpsta(), tbalen()
+bool	trseval()
+
+begin
+	# Loop over selected rows on input table.
+	pcode  = trsopen (itp, rowsel)
+	numrow = tbpsta (itp, TBL_NROWS)
+	nelem = 0
+	do irow = 1, numrow {
+	    if (trseval (itp, irow, pcode)) {
+	        nelem = nelem + 1
+	        if (nelem > len) {
+	            nelem = len
+	            break
+	        }
+	        # Get element and store in buffer.
+	        $if (datatype == c)
+	        call tbegtt  (itp, icp, irow, buf[1,nelem], maxch)
+	        $else
+	        call tbegt$t (itp, icp, irow, buf[nelem])
+	        $endif
+	    }
+	}
+	call trsclose (pcode)
+
+	# Write buffer into array cell element.
+	$if (datatype == c)
+	call tbaptt  (otp, ocp, orow, buf, maxch, 1, nelem)
+	$else
+	call tbapt$t (otp, ocp, orow, buf, 1, nelem)
+	$endif
+
+	# If number of selected rows in current input table
+	# is smaller than output table array length, fill
+	# remaining array elements with INDEF.
+	alength = tbalen (ocp)
+	if (alength > nelem) {
+	    undefd = INDEFD
+	    undefr = INDEFR
+	    undefi = INDEFI
+	    undefs = INDEFS
+	    do i = nelem+1, alength {
+	        $if (datatype == c)
+	        call tbaptt  (otp, ocp, orow, "", maxch, i, 1)
+	        $endif
+	        $if (datatype == b)
+	        call tbaptb  (otp, ocp, orow, false, i, 1)
+	        $endif
+	        $if (datatype == dris)
+	        call tbapt$t (otp, ocp, orow, undef$t, i, 1)
+	        $endif
+	    }
+	}
+end