Initial commit

9 files changed, 466 insertions, 0 deletions

diff --git a/pkg/utilities/nttools/stxtools/sp_util/mkpkg b/pkg/utilities/nttools/stxtools/sp_util/mkpkg
new file mode 100644
index 00000000..52a93adb
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/mkpkg
@@ -0,0 +1,16 @@
+# Make the wcslab package
+
+$checkout libpkg.a ../
+$update   libpkg.a
+$checkin  libpkg.a ../
+$exit
+
+libpkg.a:
+	spchag.x
+	spdise.x
+	spmapt.x	<gset.h>
+	sprote.x	<math.h>
+	spstry.x
+	sptras.x
+	spw2ld.x
+        spwcss.x        <ctype.h>
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spchag.x b/pkg/utilities/nttools/stxtools/sp_util/spchag.x
new file mode 100644
index 00000000..f6292a4e
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spchag.x
@@ -0,0 +1,64 @@
+# sp_change_string - Replace a string  with the indicated string.
+#
+# History
+#   1Apr91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_change_string( input, old, new, output, max )
+
+char input[ARB]   # I:  The input string.
+char old[ARB]     # I:  The string segment to be replaced.
+char new[ARB]     # I:  The string to replace the old with.
+char output[ARB]  # O:  The modified input string.
+int  max          # I:  The maximun length of the output string.
+
+# Declarations.
+int after         # Next character position after match.
+int first         # First character position of matched string.
+int ilen          # Length of input.
+int ip            # Pointer into input.
+int last          # Last character position of matched string.
+int old_len       # Length of old.
+int op            # Pointer into output.
+
+# Function declarations.
+int gstrcpy(), strlen(), gstrmatch()
+
+begin
+
+  # Initialize the string pointers.
+  ip = 1
+  op = 1
+  ilen = strlen( input )
+  old_len = strlen( old )
+
+  # Keep going until either the input string has been completely copied
+  # or the output string is full.
+  while( ip < ( ilen + 1 ) && op < ( max + 1 ) ) {
+
+    # Search for the old string.
+    after = gstrmatch( input[ip], old, first, last )
+
+    # If the string is not found, then copy the rest of the input to the
+    # output.
+    if( after == 0 ) {
+      call strcpy( input[ip], output[op], max - op + 1 )
+      ip = ilen + 1
+    }
+
+    # The old string is found, copy the input up to the old string
+    # and replace the old string.
+    else {
+      first = min( first - 1, max - op + 1 )
+      call sp_strncpy( input[ip], first, output[op] )
+      ip = ip + last
+      op = op + first
+      op = op + gstrcpy( new, output[op], max - op + 1 )
+    }
+
+  }
+
+end
+#---------------------------------------------------------------------------
+# End of sp_change_string
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spdise.x b/pkg/utilities/nttools/stxtools/sp_util/spdise.x
new file mode 100644
index 00000000..9985c790
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spdise.x
@@ -0,0 +1,44 @@
+# sp_distanced - Determine the distance between two points.
+#
+# History
+#   4Dec90 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+double procedure sp_distanced( x1, y1, x2, y2 )
+
+double x1, y1, x2, y2
+
+double a, b
+
+begin
+
+  a = x1 - x2
+  b = y1 - y2
+  return( sqrt( ( a * a ) + ( b * b ) ) )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_distanced
+#---------------------------------------------------------------------------
+# sp_distancer - Determine the distance between two points.
+#
+# History
+#   4Dec90 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+real procedure sp_distancer( x1, y1, x2, y2 )
+
+real x1, y1, x2, y2
+
+real a, b
+
+begin
+
+  a = x1 - x2
+  b = y1 - y2
+  return( sqrt( ( a * a ) + ( b * b ) ) )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_distancer
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spmapt.x b/pkg/utilities/nttools/stxtools/sp_util/spmapt.x
new file mode 100644
index 00000000..cef87fed
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spmapt.x
@@ -0,0 +1,94 @@
+include <gset.h>
+
+# Default viewport edges.
+define  EDGE1  0.1
+define  EDGE2  0.9
+define  EDGE3  0.12
+define  EDGE4  0.85
+
+#---------------------------------------------------------------------------
+.help sp_map_viewport Sep92 source
+.ih
+NAME
+sp_map_viewport -- set device viewport for contour plots.
+.endhelp
+#---------------------------------------------------------------------------
+
+procedure sp_map_viewport (gp, ncols, nlines, ux1, ux2, uy1, uy2, pre, perim)
+
+pointer gp                      # I:  pointer to graphics descriptor
+real    ncols, nlines           # I:  size of image area, after block reduction
+real    ux1, ux2, uy1, uy2      # I:  NDC coordinates of requested viewort
+bool    pre                     # I:  Preserve aspect ratio.
+bool    perim                   # I:  draw perimeter
+
+real  xcen, ycen, x, y
+real  aspect_ratio
+real  x1, x2, y1, y2, ext, xdis, ydis
+data    ext /0.0625/
+real  ggetr()
+
+begin
+        # Determine the standard window sizes.
+        if (!pre && !perim) {
+            x1 = 0.0;  x2 = 1.0
+            y1 = 0.0;  y2 = 1.0
+        } else {
+            x1 = EDGE1;  x2 = EDGE2
+            y1 = EDGE3;  y2 = EDGE4
+            
+        }
+        
+        # If any values were specified, then replace them here.
+        if( !IS_INDEFR( ux1 ) )
+            x1 = ux1
+        if( !IS_INDEFR( ux2 ) )
+            x2 = ux2
+        if( !IS_INDEFR( uy1 ) )
+            y1 = uy1
+        if( !IS_INDEFR( uy2 ) )
+            y2 = uy2
+        
+        xdis = x2 - x1
+        ydis = y2 - y1
+        xcen = ( x2 + x1 ) / 2.
+        ycen = ( y2 + y1 ) / 2.
+        
+        # So far, the viewport has been calculated so that equal numbers of
+        # image pixels map to equal distances in NDC space, regardless of 
+        # the aspect ratio of the device.  If preserving aspect ratio,
+        # modify viewport to correctly display the contour aspect.
+        if (pre) {
+            aspect_ratio = ggetr (gp, "ar")
+            if (aspect_ratio == 0.0) {
+                x = ggetr (gp, "xr")
+                y = ggetr (gp, "yr")
+                if ( x != 0.0 && y != 0.0)
+                    aspect_ratio = y / x
+                else
+                    aspect_ratio = 1.0
+            }
+            aspect_ratio = nlines / ncols / aspect_ratio
+            x = ydis / aspect_ratio
+            y = ydis
+            if ( x > xdis) {
+                y = aspect_ratio * xdis
+                x = xdis
+            }
+            xdis = x
+            ydis = y
+        }
+
+        # All set.
+        ux1 = xcen - (xdis / 2.0)
+        ux2 = xcen + (xdis / 2.0)
+        uy1 = ycen - (ydis / 2.0)
+        uy2 = ycen + (ydis / 2.0)
+        
+        call gsview (gp, ux1, ux2, uy1, uy2)
+        call gswind (gp, 1.0, ncols, 1.0, nlines)
+        
+end
+#---------------------------------------------------------------------------
+# End of sp_map_viewport
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/sprote.x b/pkg/utilities/nttools/stxtools/sp_util/sprote.x
new file mode 100644
index 00000000..c9baeb65
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/sprote.x
@@ -0,0 +1,49 @@
+include <math.h>
+
+# The dimensionality.
+define N_DIM 2
+
+# Define some memory management.
+define ONER Memr[$1+$2-1]
+
+# sp_rotate - Rotate a vector.
+#
+# History
+#    8Mar91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_rotate( x, y, npts, angle, nx, ny )
+
+real x[npts], y[npts]    # I:  The vectors to rotate.
+int  npts                # I:  The number of points in the vectors.
+real angle               # I:  The angle to rotate (radians).
+real nx[npts], ny[npts]  # O:  The translated vectors.
+
+# Declarations
+pointer center          # To specify the center.
+pointer mw              # MWCS structure.
+pointer sp              # Stack pointer.
+
+# Function prototypes.
+pointer mw_open(), mw_sctran()
+
+begin
+
+  # Suck some memory.
+  call smark( sp )
+  call salloc( center, N_DIM, TY_REAL )
+
+  mw = mw_open( NULL, N_DIM )
+  ONER(center,1) = 0.
+  ONER(center,2) = 0.
+  call mw_rotate( mw, -DEGTORAD( angle ), ONER(center,1), 3b )
+  call mw_v2tranr( mw_sctran( mw, "physical", "logical", 3b ),
+                  x, y, nx, ny, npts )
+
+  call mw_close( mw )
+  call sfree( sp )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_rotate
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spstry.x b/pkg/utilities/nttools/stxtools/sp_util/spstry.x
new file mode 100644
index 00000000..545b0b06
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spstry.x
@@ -0,0 +1,24 @@
+# sp_strncpy - Counted character copy.
+#
+# History
+#   1Apr91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_strncpy( input, n_chars, output )
+
+char input[ARB]   # I:  The input string to copy to the output.
+int  n_chars      # I:  The number of characters to copy.
+char output[ARB]  # O:  The output string.
+
+# Declarations.
+int i             # Index.
+
+begin
+
+  for( i = 1; i <= n_chars; i = i + 1 )
+    output[i] = input[i]
+
+end
+#---------------------------------------------------------------------------
+# End of sp_strncpy.
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/sptras.x b/pkg/utilities/nttools/stxtools/sp_util/sptras.x
new file mode 100644
index 00000000..f62e9ceb
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/sptras.x
@@ -0,0 +1,35 @@
+# Set the dimensionality
+define N_DIM 2
+
+# sp_trans - Translate the origin to a new center.
+#
+# History
+#   11Mar91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_trans( x, y, npts, center, nx, ny )
+
+real x[npts], y[npts]    # I:  The x, y vectors to translate.
+int  npts                # I:  The number of points in the vectors.
+real center[N_DIM]       # I:  The new coordinate center.
+real nx[npts], ny[npts]  # O:  The translated vectors.
+
+# Declarations
+pointer mw              # MWCS structure.
+
+# Function prototypes.
+pointer mw_open(), mw_sctran()
+
+begin
+
+  mw = mw_open( NULL, N_DIM )
+  call mw_shift( mw, center, 3b )
+  call mw_v2tranr( mw_sctran( mw, "physical", "logical", 3b ),
+                   x, y, nx, ny, npts )
+
+  call mw_close( mw )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_trans
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x b/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x
new file mode 100644
index 00000000..a31ce22d
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spw2ld.x
@@ -0,0 +1,50 @@
+# sp_w2ld - Transform world coordinates to logical coordinates (double).
+#
+# History
+#   24Jun91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_w2ld( wlct, flip, wx, wy, lx, ly, npts )
+
+pointer wlct                # I:  The MWCS coordinate trans. descriptor.
+bool    flip                # I:  True if the axes are transposed.
+double  wx[npts], wy[npts]  # I: The world coordinates.
+double  lx[npts], ly[npts]  # O: The logical coordinates.
+int     npts                # I: The number of points to translate.
+
+begin
+
+  if( flip )
+    call mw_v2trand( wlct, wx, wy, ly, lx, npts )
+  else
+    call mw_v2trand( wlct, wx, wy, lx, ly, npts )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_w2ld
+#---------------------------------------------------------------------------
+# sp_l2wd - Transform logical coordinates to world coordinates (double).
+#
+# History
+#   24Jun91 - Created by Jonathan D. Eisenhamer, STScI.
+#---------------------------------------------------------------------------
+
+procedure sp_l2wd( lwct, flip, lx, ly, wx, wy, npts )
+
+pointer lwct                # I:  The MWCS coordinate trans. descriptor.
+bool    flip                # I:  True if the axes are transposed.
+double  lx[npts], ly[npts]  # I:  The logical coordinates.
+double  wx[npts], wy[npts]  # O:  The world coordinates.
+int     npts                # I:  The number of points to translate.
+
+begin
+
+  if( flip )
+    call mw_v2trand( lwct, ly, lx, wx, wy, npts )
+  else
+    call mw_v2trand( lwct, lx, ly, wx, wy, npts )
+
+end
+#---------------------------------------------------------------------------
+# End of sp_l2wd
+#---------------------------------------------------------------------------
diff --git a/pkg/utilities/nttools/stxtools/sp_util/spwcss.x b/pkg/utilities/nttools/stxtools/sp_util/spwcss.x
new file mode 100644
index 00000000..bb2feb49
--- /dev/null
+++ b/pkg/utilities/nttools/stxtools/sp_util/spwcss.x
@@ -0,0 +1,90 @@
+include <ctype.h>
+include	<imhdr.h>
+
+#---------------------------------------------------------------------------
+.help sp_wcsparams 3Aug95 source
+.ih
+NAME
+sp_wcsparams -- Read the WCS descriptor from the parameters.
+.ih
+DESCRIPTION
+This procedure returns the WCS descriptor created from task parameters
+and the logical space that will be graphed.
+.ih
+BUGS
+This only deals with two axes.
+.endhelp
+#---------------------------------------------------------------------------
+procedure sp_wcsparams( mw, log_x1, log_x2, log_y1, log_y2 )
+
+pointer mw              # O: The MWCS descriptor.
+real    log_x1, log_x2,
+        log_y1, log_y2  # O: The extent of the logical space to graph.
+
+# Declarations.
+pointer	b		# Buffer pointer.
+double	clgetd()	# Get double-valued parameter.
+real	clgetr()	# Get real-valued parameter.
+pointer	im		# Temporary image descriptor.
+pointer	immap()		# Open an image.
+pointer	impl2s()	# Put line in 2d image.
+pointer	imw		# Temporary MWCS descriptor.
+pointer	mw_newcopy()	# Copy MWCS descriptor.
+pointer	mw_openim()	# Get MWCS descriptor from image.
+char	s[SZ_LINE]	# Generic string.
+
+string	tmpimage ".SPWCSS"
+
+begin
+	# Since no one knows how mwcs really works, we cheat.
+	# Create an image and set the header keywords to what
+	# the parameters are.  Then use the image load to get the
+	# mwcs instead of trying to create it from scratch.
+
+	# Create an image.
+	iferr (call imdelete (tmpimage))
+	    ;
+	im = immap (tmpimage, NEW_IMAGE, 20000)
+	IM_NDIM(im) = 2
+	IM_LEN(im,1) = 1
+	IM_LEN(im,2) = 1
+	IM_PIXTYPE(im) = TY_SHORT
+
+	# Now populate the WCS-relevant keywords.
+	call clgstr ("ctype1", s, SZ_LINE)
+	call imastr (im, "ctype1", s)
+	call clgstr ("ctype2", s, SZ_LINE)
+	call imastr (im, "ctype2", s)
+	call imaddd (im, "crpix1", clgetd ("crpix1"))
+	call imaddd (im, "crpix2", clgetd ("crpix2"))
+	call imaddd (im, "crval1", clgetd ("crval1"))
+	call imaddd (im, "crval2", clgetd ("crval2"))
+	call imaddd (im, "cd1_1", clgetd ("cd1_1"))
+	call imaddd (im, "cd1_2", clgetd ("cd1_2"))
+	call imaddd (im, "cd2_1", clgetd ("cd2_1"))
+	call imaddd (im, "cd2_2", clgetd ("cd2_2"))
+
+	# Write a pixel, close and reopen the image.
+	b = impl2s (im, 1)
+	call imunmap (im)
+	im = immap (tmpimage, READ_ONLY, 0)
+
+	# Retrieve the MWCS descriptor.  Make a copy so we can close the
+	# temporary image.
+	imw = mw_openim (im)
+	mw = mw_newcopy (imw)
+
+	# Get the logical workspace.
+	log_x1 = clgetr ("log_x1")
+	log_x2 = clgetr ("log_x2")
+	log_y1 = clgetr ("log_y1")
+	log_y2 = clgetr ("log_y2")
+
+	# That's all folks.
+	call mw_close (imw)
+	call imunmap (im)
+	call imdelete (tmpimage)
+end
+#---------------------------------------------------------------------------
+# End of sp_wcsparams
+#---------------------------------------------------------------------------