Initial commit

1 files changed, 134 insertions, 0 deletions

diff --git a/sys/qpoe/qprlmerge.gx b/sys/qpoe/qprlmerge.gx
new file mode 100644
index 00000000..410bb952
--- /dev/null
+++ b/sys/qpoe/qprlmerge.gx
@@ -0,0 +1,134 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include <mach.h>
+include "../qpex.h"
+
+# QP_RLMERGE -- Merge (AND) two range lists.  Only ranges which are
+# common to both range lists are output.  The number of ranges in the
+# output range list is returned as the function value.
+
+int procedure qp_rlmerge$t (os,oe,olen, xs,xe,nx, ys,ye,ny)
+
+pointer	os, oe			#U output range list
+int	olen			#U allocated length of OS, OE arrays
+
+PIXEL	xs[ARB], xe[ARB]	#I range list to be merged with
+int	nx			#I number of ranges in X list
+PIXEL	ys[ARB], ye[ARB]	#I range list to be merged with X
+int	ny			#I number of ranges in Y list
+
+PIXEL	o1, o2
+int	nx_out, xi, yi, i
+PIXEL	qp_minval$t(), qp_maxval$t()
+bool	qp_lessthan$t()
+errchk	realloc
+
+begin
+	nx_out = 0
+	if (nx <= 0 || ny <= 0)
+	    return (0)
+
+	xi = 1
+	yi = 1
+
+	do i = 1, ARB {
+	    # Find a pair of ranges which intersect.
+	    repeat {
+		if (qp_lessthan$t (xe[xi], ys[yi])) {
+		    if (xi >= nx)
+			return (nx_out)
+		    else
+			xi = xi + 1
+		} else if (qp_lessthan$t (ye[yi], xs[xi])) {
+		    if (yi >= ny)
+			return (nx_out)
+		    else
+			yi = yi + 1
+		} else
+		    break
+	    }
+
+	    # Compute the intersection.
+	    o1 = qp_maxval$t (xs[xi], ys[yi])
+	    o2 = qp_minval$t (xe[xi], ye[yi])
+
+	    # Output the range.
+	    if (nx_out + 1 > olen) {
+		olen = max (DEF_XLEN, olen * 2)
+		call realloc (os, olen, TY_PIXEL)
+		call realloc (oe, olen, TY_PIXEL)
+	    }
+
+	    Mem$t[os+nx_out] = o1
+	    Mem$t[oe+nx_out] = o2
+	    nx_out = nx_out + 1
+
+	    # Advance to the next range.
+	    if (xi < nx && qp_lessthan$t (xe[xi], ye[yi]))
+		xi = xi + 1
+	    else if (yi < ny)
+		yi = yi + 1
+	    else
+		break
+	}
+
+	return (nx_out)
+end
+
+
+# QP_MINVAL -- Return the lesser of two values, where either value can
+# be an open range.
+
+PIXEL procedure qp_minval$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+bool	qp_lessthan$t()
+
+begin
+	if (qp_lessthan$t (x, y))
+	    return (x)
+	else
+	    return (y)
+end
+
+
+# QP_MAXVAL -- Return the greater of two values, where either value can
+# be an open range.
+
+PIXEL procedure qp_maxval$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+bool	qp_lessthan$t()
+
+begin
+	if (qp_lessthan$t (x, y))
+	    return (y)
+	else
+	    return (x)
+end
+
+
+# QP_LESSTHAN -- Test if X is less than Y, where X and Y can be open
+# range values.
+
+bool procedure qp_lessthan$t (x, y)
+
+PIXEL	x			#I first value
+PIXEL	y			#I second value
+
+begin
+	if (IS_LEFT$T(x))
+	    return (!IS_LEFT$T(y))
+	else if (IS_RIGHT$T(x))
+	    return (false)
+	else if (IS_LEFT$T(y))
+	    return (false)
+	else if (IS_RIGHT$T(y))
+	    return (true)
+	else
+	    return (x < y)
+end