From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- pkg/utilities/nttools/stxtools/sp_util/mkpkg | 16 +++++ pkg/utilities/nttools/stxtools/sp_util/spchag.x | 64 +++++++++++++++++ pkg/utilities/nttools/stxtools/sp_util/spdise.x | 44 ++++++++++++ pkg/utilities/nttools/stxtools/sp_util/spmapt.x | 94 +++++++++++++++++++++++++ pkg/utilities/nttools/stxtools/sp_util/sprote.x | 49 +++++++++++++ pkg/utilities/nttools/stxtools/sp_util/spstry.x | 24 +++++++ pkg/utilities/nttools/stxtools/sp_util/sptras.x | 35 +++++++++ pkg/utilities/nttools/stxtools/sp_util/spw2ld.x | 50 +++++++++++++ pkg/utilities/nttools/stxtools/sp_util/spwcss.x | 90 +++++++++++++++++++++++ 9 files changed, 466 insertions(+) create mode 100644 pkg/utilities/nttools/stxtools/sp_util/mkpkg create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spchag.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spdise.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spmapt.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/sprote.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spstry.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/sptras.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spw2ld.x create mode 100644 pkg/utilities/nttools/stxtools/sp_util/spwcss.x (limited to 'pkg/utilities/nttools/stxtools/sp_util') 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 + sprote.x + spstry.x + sptras.x + spw2ld.x + spwcss.x 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 + +# 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 + +# 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 +include + +#--------------------------------------------------------------------------- +.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 +#--------------------------------------------------------------------------- -- cgit