1 files changed, 121 insertions, 0 deletions
diff --git a/pkg/images/tv/imexamine/ietimexam.x b/pkg/images/tv/imexamine/ietimexam.x
new file mode 100644
index 00000000..869eaa4b
--- /dev/null
+++ b/pkg/images/tv/imexamine/ietimexam.x
@@ -0,0 +1,121 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+
+include	<error.h>
+include	<imhdr.h>
+include	"imexam.h"
+
+
+# IE_TIMEXAM -- Extract a subraster image.
+# This routine does not currently update the WCS but it does clear it.
+
+procedure ie_timexam (ie, x, y)
+ 
+pointer	ie			# IE pointer
+real	x, y			# Center
+
+int	i, x1, x2, y1, y2, nx, ny
+pointer	sp, root, extn, output
+pointer	im, out, data, outbuf, mw
+
+int	clgeti(), fnextn(), iki_validextn(), strlen(), imaccess()
+pointer	ie_gimage(), ie_gdata(), immap(), impl2r(), mw_open()
+errchk	impl2r
+
+begin
+	iferr (im = ie_gimage (ie, NO)) {
+	    call erract (EA_WARN)
+	    return
+	}
+
+	call smark (sp)
+	call salloc (root, SZ_FNAME, TY_CHAR)
+	call salloc (extn, SZ_FNAME, TY_CHAR)
+	call salloc (output, SZ_FNAME, TY_CHAR)
+
+	# Get parameters.
+	call clgstr ("output", Memc[root], SZ_FNAME)
+	nx = clgeti ("ncoutput")
+	ny = clgeti ("nloutput")
+
+	# Strip the extension.
+	call imgimage (Memc[root], Memc[root], SZ_FNAME)
+	if (Memc[root] == EOS)
+	    call strcpy (IE_IMAGE(ie), Memc[root], SZ_FNAME)
+	i = fnextn (Memc[root], Memc[extn+1], SZ_FNAME)
+	Memc[extn] = EOS
+	if (i > 0) {
+	    call iki_init()
+	    if (iki_validextn (0, Memc[extn+1]) != 0) {
+		Memc[root+strlen(Memc[root])-i-1] = EOS
+		Memc[extn] = '.'
+	    }
+	}
+
+	do i = 1, ARB {
+	    call sprintf (Memc[output], SZ_FNAME, "%s.%03d%s")
+		call pargstr (Memc[root])
+		call pargi (i)
+		call pargstr (Memc[extn])
+	    if (imaccess (Memc[output], 0) == NO)
+		break
+	}
+
+	# Set section to be extracted.
+	if (!IS_INDEF(x))
+	    IE_X1(ie) = x
+	if (!IS_INDEF(y))
+	    IE_Y1(ie) = y
+
+	x1 = IE_X1(ie) - (nx - 1) / 2 + 0.5
+	x2 = IE_X1(ie) + nx / 2 + 0.5
+	y1 = IE_Y1(ie) - (ny - 1) / 2 + 0.5
+	y2 = IE_Y1(ie) + ny / 2 + 0.5
+	nx = x2 - x1 + 1
+	ny = y2 - y1 + 1
+
+	# Set output.
+	iferr (out = immap (Memc[output], NEW_COPY, im)) {
+	    call erract (EA_WARN)
+	    return
+	}
+	IM_NDIM(out) = 2
+	IM_LEN(out,1) = nx
+	IM_LEN(out,2) = ny
+
+	# Extract the section.
+	iferr {
+	    do i = y1, y2 {
+	        data = ie_gdata (im, x1, x2, i, i)
+		outbuf = impl2r (out, i-y1+1)
+		call amovr (Memr[data], Memr[outbuf], nx)
+	    }
+	    mw = mw_open (NULL, 2)
+	    call mw_saveim (mw, out)
+	    call imunmap (out)
+	} then {
+	    call imunmap (out)
+	    iferr (call imdelete (Memc[output]))
+		;
+	    call sfree (sp)
+	    call erract (EA_WARN)
+	    return
+	}
+
+	call printf ("%s[%d:%d,%d:%d] -> %s\n")
+	    call pargstr (IE_IMAGE(ie))
+	    call pargi (x1)
+	    call pargi (x2)
+	    call pargi (y1)
+	    call pargi (y2)
+	    call pargstr (Memc[output])
+	if (IE_LOGFD(ie) != NULL) {
+	    call fprintf (IE_LOGFD(ie), "%s[%d:%d,%d:%d] -> %s\n")
+		call pargstr (IE_IMAGE(ie))
+		call pargi (x1)
+		call pargi (x2)
+		call pargi (y1)
+		call pargi (y2)
+	}
+
+	call sfree (sp)
+end