From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001
From: Joseph Hunkeler <jhunkeler@gmail.com>
Date: Wed, 8 Jul 2015 20:46:52 -0400
Subject: Initial commit

---
 pkg/utilities/nttools/threed/titable/tirows.gx | 98 ++++++++++++++++++++++++++
 1 file changed, 98 insertions(+)
 create mode 100644 pkg/utilities/nttools/threed/titable/tirows.gx

(limited to 'pkg/utilities/nttools/threed/titable/tirows.gx')

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
-- 
cgit