Repatch (from linux) of OSX IRAF

1 files changed, 620 insertions, 0 deletions

diff --git a/noao/rv/rvcursor.x b/noao/rv/rvcursor.x
new file mode 100644
index 00000000..844c72e1
--- /dev/null
+++ b/noao/rv/rvcursor.x
@@ -0,0 +1,620 @@
+include <gset.h>
+include <pkg/gtools.h>
+include <fset.h>
+include "rvpackage.h"
+include "rvflags.h"
+include "rvcont.h"
+include "rvplots.h"
+include "rvfilter.h"
+
+# RV_CURSOR - Get the next command from the user in the input cursor loop
+# and perform the requested function.
+
+procedure rv_cursor (rv, infile, rinfile)
+
+pointer	rv				#I RV struct pointer
+pointer	infile				#I Object input list pointer
+pointer	rinfile				#I Template input list pointer
+
+pointer	sp, cmd, buf, fname
+pointer	gp, gt
+int	wcs, key, nans, i
+int	stat, npts, tmp_int
+real	x, y, x1, x2, dx, max
+char	ans[2*SZ_LINE,4]
+
+pointer open(), gopen()
+int 	rv_colon(), rv_data_check(), scan()
+int	clgcur(), fstati(), fft_cursor(), spc_cursor()
+int	next_spec(), next_temp(), next_ap()
+int	prev_spec(), prev_temp(), prev_ap()
+real	rv_maxpix()
+bool	written, streq()
+errchk	open, gt_init
+
+define	LOG_PROMPT		"Log of Current Results: "
+define	exit_			99
+define	unknown_		98
+define	redo_xcor_		97
+define	replot_			96
+define	refit_			95
+
+begin
+	call smark (sp)				# Allocate some space
+	call salloc (cmd, SZ_LINE, TY_CHAR)
+	call salloc (buf, SZ_LINE, TY_CHAR)
+	call salloc (fname, SZ_FNAME, TY_CHAR)
+
+	# Nab some pointers
+	gp = RV_GP(rv)
+	gt = RV_GT(rv)
+
+	call op_debug (rv)			# Open debugger
+	if (DBG_KEYSTROKE(rv) != 'x')
+	    key = DBG_KEYSTROKE(rv)
+	else
+	    key = 'x'
+	RV_NEWGRAPH(rv) = NO
+	written = false
+	RV_NEWXCOR(rv) = YES
+
+	repeat {
+
+	    RV_CMD(rv) = key
+	    switch (key) { 			# Switch on the keystroke
+	    case '?':				
+	    	# List options
+		call gpagefile (gp, XC_HELP, "FXCOR Task Options: ")
+
+	    case ':':				
+	    	# Colon command
+	    	if (rv_colon(rv,Memc[cmd],written,infile,rinfile,NULL) == QUIT)
+	    	    break
+		if (RV_NEWXCOR(rv) == YES)
+		    goto redo_xcor_
+		if (RV_NEWGRAPH(rv) == YES)
+		    goto replot_
+		if (RV_FITDONE(rv) == NO) {
+		    RV_ERRCODE(rv) = OK
+		    call rv_batch_xcor (rv, RV_TEMPNUM(rv), RV_APNUM(rv), NO, 
+			NO, YES)
+	 	}
+
+	    case '.':
+		# Accelerator for doing continuum normalizations.
+		call cmd_cont (rv)
+		if (RV_NEWXCOR(rv) == YES) {
+		    key = 'x'
+		    goto redo_xcor_
+ 		} else
+		    goto replot_
+
+	    case '-':
+		# Subtract a blend from the CCF.
+		if (RV_FITDONE(rv) == YES) {
+	            x1 = WRKPIXX(rv,1)
+		    x2 = WRKPIXX(rv,RV_CCFNPTS(rv))
+		    dx = 1.
+		    call gctran (gp, x, y, x, y, wcs, 2)
+		    call subblend (rv, gp, WRKPIXY(rv,1), x1, x2, dx, x, y)
+		    goto replot_
+		} else {
+		    call rv_errmsg (
+			"No deblended fit done yet.  Use 'd' to fit.")
+		}
+
+	    case '+':
+		# Toggle status line output for ccf mode.
+		RV_STATLINE(rv) = RV_STATLINE(rv) + 1
+		call rv_writeln (rv, STDOUT)
+
+	    case ',':
+		# Generic Test Command (hidden from users).
+
+	    case 'a':
+		# Do a summary plot of the antisymmetric noise of the CCF.
+		if (IS_DBLSTAR(rv) == YES) {
+		    call rv_errmsg (
+			"Antisymmetric plot invalid for a deblended fit.")
+		} else if (RV_FITFUNC(rv) == CENTER1D) {
+	    	    call rv_errmsg (
+			"Antisymmetric plot unavailable for center1d fit.")
+		} else if (RV_FITFUNC(rv) == SINC &&
+		    IS_INDEF(RV_BACKGROUND(rv))) {
+	    	       call rv_errmsg (
+		       "Must set background for sinc fit antisym. computation.")
+		} else {
+		    call rv_anplot (rv, RV_GP(rv))
+		    call rv_pause ("Hit any key to return to the correlation.")
+		    goto replot_
+		}
+
+	    case 'b':
+		# Set "background" for FWHM calculation.
+		i = RV_WINCENTER(rv) - RV_WINDOW(rv)
+		max = rv_maxpix (WRKPIXY(rv,i), 2*RV_WINDOW(rv))
+		call gctran (gp, x, y, x, y, wcs, 2)
+		if (y >= max) {
+		    call rv_errmsg ("Cannot set background above CCF peak.")
+	 	} else {
+		    if (RV_FITFUNC(rv) == GAUSSIAN || 
+			RV_FITFUNC(rv) == LORENTZIAN ||
+			RV_FITFUNC(rv) == SINC) {
+		            call reset_errcom (rv)
+		            call rv_erase_fit (rv, false)
+	                    RV_BACKGROUND(rv) = y
+		            RV_ERRCODE(rv) = OK
+			    IS_DBLSTAR(rv) = NO
+		            call rv_batch_xcor (rv, RV_TEMPNUM(rv), 
+				RV_APNUM(rv), NO, NO, NO)
+				#RV_APNUM(rv), NO, NO, YES)
+		    } else {
+			call rv_errmsg ("Cannot set background for a %s fit.")
+			if (IS_DBLSTAR(rv) == YES)
+			    call pargstr ("deblended")
+			else if (RV_FITFUNC(rv) == PARABOLA)
+			    call pargstr ("parabolic")
+			else
+			    call pargstr ("center1d")
+		    }
+		}
+
+	    case 'c':				
+		# Read cursor poistion
+		call rv_rdcursor (rv, gp, x, y, wcs)
+
+	    case 'd':				
+		# Fit the peak with up to four Gaussians.
+		call reset_errcom (rv)
+	        x1 = WRKPIXX(rv,1)
+		x2 = WRKPIXX(rv,RV_CCFNPTS(rv))
+		dx = 1.
+		call gctran (gp, x, y, x, y, wcs, 2)
+		call deblend (rv, gp, x1, x2, dx, x, y, WRKPIXY(rv,1), ans, 
+		    nans)
+
+	    case 'e':
+		# Show the summary plot after the fit.
+	        call rv_eplot (rv, gp)
+		call rv_pause ("Hit any key to return to the correlation.")
+		goto replot_
+
+	    case 'f':
+		# Enter the Fourier Mode command stream.
+		stat = fft_cursor(rv)
+		if (RV_NEWXCOR(rv) == YES) {
+		    key = 'x'
+		    goto redo_xcor_
+		} else
+		    goto replot_
+
+	    case 'g':
+	    	# Fit the correlation plot based on the X cursor values
+		call reset_errcom (rv)
+		call gctran (gp, x, y, x, y, wcs, 2)
+		call rv_xfit (rv, x, YES)
+
+	    case 'I':
+		# Fatal interrupt.
+	        call fatal (0, "Interrupt")
+
+	    case 'j':
+		# Residual plot of fit.
+		call rv_plot (rv, RESIDUAL_PLOT)
+
+	    case 'l':
+	    	# Page the logfile. Pointer is closed to be VMS compatable.
+	    	if (RV_TXFD(rv) != NULL) {
+		    if (fstati(RV_TXFD(rv),F_FILESIZE) == 0) 
+			call rv_errmsg ("Nothing yet written to logfile.")
+		    else {
+		        call sprintf (Memc[buf], SZ_FNAME, "%s.txt")
+			    call pargstr (SPOOL(rv))
+		        call flush (RV_TXFD(rv))
+		        call close (RV_TXFD(rv))
+		        call gpagefile (gp, Memc[buf], LOG_PROMPT)
+		        RV_TXFD(rv) = open (Memc[buf], APPEND, TEXT_FILE)
+		    }
+	    	} else
+		    call rv_errmsg ("No output file specified.")
+
+	    case 'm':				
+		# Plot polymarkers of the actual CCF points.
+		call gseti (gp, G_WCS, 2)
+		i = RV_WINCENTER(rv) - RV_WINDOW(rv)
+		npts = 2 * RV_WINDOW(rv)
+		call gpmark (gp,WRKPIXX(rv,i), WRKPIXY(rv,i), npts, 4, 2.0, 2.0)
+		call gflush (gp)
+
+	    case 'n':
+		# Go to the next (template --> aperture --> object) after 
+		# saving results.
+		if (RV_TEMPNUM(rv) < RV_NTEMPS(rv) ||
+		    CURAPNUM(rv) < NUMAPS(rv) ||
+		    RV_IMNUM(rv) < RV_NOBJS(rv))
+		    	call rv_do_save (rv, written)
+
+		# Now do the "next" operation as specified. The logic sequence
+		# is complicated but handles all cases.
+		if (RV_TEMPNUM(rv) < RV_NTEMPS(rv)) {
+		    if (next_temp(rv, rinfile, written) == ERR_READ)
+			call rv_errmsg ("Error reading next template.")
+		    else
+			goto redo_xcor_
+		} else {
+		    # Get the next aperture
+		    if (CURAPNUM(rv) < NUMAPS(rv)) {
+		        if (RV_NTEMPS(rv) > 1) {	# Reset templates
+		            RV_TEMPNUM(rv) = 0
+		            if (next_temp(rv, rinfile, written) == ERR_READ)
+			        call rv_errmsg ("Error reading next template.")
+		        }
+			if (next_ap(rv, written) == ERR_READ)
+			    call rv_errmsg ("Errror reading next aperture.")
+		    	else
+			    goto redo_xcor_
+		    } else {
+			# get the next object
+			if (RV_IMNUM(rv) < RV_NOBJS(rv)) {
+			    if (NUMAPS(rv) > 1) {
+			        CURAPNUM(rv) = 0	# Reset apertures
+			        if (next_ap(rv, written) == ERR_READ) {
+			            call rv_errmsg (
+					"Errror reading next aperture.")
+				}
+			    }
+		            if (RV_NTEMPS(rv) > 1) {
+		                RV_TEMPNUM(rv) = 0	# Reset templates
+		                if (next_temp(rv, rinfile, written) ==ERR_READ){
+			            call rv_errmsg (
+					"Error reading next template.")
+				}
+			    }
+			    if (next_spec(rv, infile, written) == ERR_READ)
+				call rv_errmsg ("Error reading next object.")
+		    	    else
+				goto redo_xcor_
+			} else {
+			    call rv_errmsg ("No more spectra to process.")
+			}
+		    }
+		}
+
+	    case 'o':
+		# Fit or refit the object spectrum continuum for subtraction.
+		tmp_int = CON_INTERACTIVE(rv)
+		CON_INTERACTIVE(rv) = YES
+		call do_continuum (rv, OBJECT_SPECTRUM)
+		CON_INTERACTIVE(rv) = tmp_int
+		RV_FITDONE(rv) = NO
+		RV_NEWXCOR(rv) = YES
+		IS_DBLSTAR(rv) = NO
+		goto redo_xcor_
+
+	    case 'p':
+		# Go to the previous (template --> aperture --> object) after 
+		# saving results.
+		if (RV_TEMPNUM(rv) > 1 || CURAPNUM(rv) > 1 || RV_IMNUM(rv) > 1)
+		    call rv_do_save (rv, written)
+
+		# Now do the "previous" operation as specified. The logic 
+		# sequence is complicated but handles all cases.
+		if (RV_TEMPNUM(rv) > 1 && RV_NTEMPS(rv) > 1) {
+		    if (prev_temp(rv, rinfile, written) == ERR_READ)
+			call rv_errmsg ("Error reading previous template.")
+		    else
+			goto redo_xcor_
+		} else {
+		    # Do previous aperture
+		    if (CURAPNUM(rv) > 1 && NUMAPS(rv) > 1) {
+		        if (RV_NTEMPS(rv) > 1 && RV_TEMPNUM(rv) > 1) {
+		            RV_TEMPNUM(rv) = RV_NTEMPS(rv) + 1 # Reset templates
+		            if (prev_temp(rv, rinfile, written) == ERR_READ) {
+			        call rv_errmsg (
+				    "Error reading previous template.")
+			    }
+		        }
+			if (prev_ap(rv, written) == ERR_READ)
+			    call rv_errmsg ("Errror reading previous aperture.")
+			else
+		            goto redo_xcor_
+		    } else {
+			# Do previous object image
+			if (RV_NOBJS(rv) > 1 && RV_IMNUM(rv) > 1) {
+			    if (NUMAPS(rv) > 1) {
+			        CURAPNUM(rv) = NUMAPS(rv) + 1
+			        if (prev_ap(rv, written) == ERR_READ) {
+			            call rv_errmsg (
+				        "Errror reading previous aperture.")
+			        }
+			    }
+			    if (RV_NTEMPS(rv) > 1) {
+			        RV_TEMPNUM(rv) = RV_NTEMPS(rv) + 1
+		                if (prev_temp(rv, rinfile, written) ==ERR_READ){
+			            call rv_errmsg (
+				        "Error reading previous template.")
+			        }
+			    }
+			    if (prev_spec(rv, infile, written) == ERR_READ)
+				call rv_errmsg("Error reading previous object.")
+			    else
+		                goto redo_xcor_
+			} else {
+			    call rv_errmsg ("At the start of the input list.")
+			}
+		    }
+		}
+		
+	    case 'q': 				
+	    	# Quit, possibly saving results before hand.
+		if (!written || RV_UPDATE(rv) == YES) {
+		    if (RV_AUTOWRITE(rv) == YES && !streq(SPOOL(rv),""))
+		        call cmd_write (rv, written)
+		    else
+		        call rv_query_save (rv, written, QUIT)
+		}
+		break
+
+	    case 'r':				
+	    	# Replot the data.
+replot_	    	call rv_plot (rv, CORRELATION_PLOT)
+	 	if (IS_DBLSTAR(rv) == NO)
+		    call rv_writeln (rv, STDOUT)
+
+	    case 's':				
+	    	# Examine object and template spectra.
+		stat = spc_cursor (rv)
+		if (RV_NEWXCOR(rv) == YES) {
+		    key = 'x'
+		    goto redo_xcor_
+ 		} else
+		    goto replot_
+
+	    case 't': 
+		# Fit or refit the template spectrum continuum for subtraction.
+		tmp_int = CON_INTERACTIVE(rv)
+		CON_INTERACTIVE(rv) = YES
+		call do_continuum (rv, REFER_SPECTRUM)
+		CON_INTERACTIVE(rv) = tmp_int
+		RV_FITDONE(rv) = NO
+		RV_NEWXCOR(rv) = YES
+		IS_DBLSTAR(rv) = NO
+		goto redo_xcor_
+
+	    case 'v':
+		# Suspend graphics and show verbose fit/xcor output.
+		call rv_verbose_fit (rv, STDOUT)
+
+	    case 'w':
+		# Write current correlation results to log file.
+		if (!written || RV_UPDATE(rv) == YES) {
+	            if (RV_TXFD(rv) == NULL) {
+		        call strcpy ("\0", Memc[fname], SZ_FNAME)
+		        while (Memc[fname] == '\0') {
+	    	            call printf ("Root output filename: ")
+	    	            call flush (STDOUT)
+	    	            stat = scan()
+		                call gargstr (Memc[fname], SZ_FNAME)
+		        }
+		        call init_files (rv, DEVICE(rv), Memc[fname], true)
+        	        RV_MGP(rv) = gopen ("stdvdm", APPEND, RV_GRFD(rv))
+			written = false
+	            }
+		    call cmd_write (rv, written)
+		    written = true
+		} else
+		    call rv_query_save (rv, written, NULL)
+
+	    case 'x':				
+	    	# Re-do the correlation and check params.
+		RV_NEWXCOR(rv) = YES
+redo_xcor_	RV_ERRCODE(rv) = OK
+		if (rv_data_check(rv) == OK && RV_NEWXCOR(rv) == YES) {
+		    call rv_batch_xcor (rv, RV_TEMPNUM(rv), RV_APNUM(rv), YES, 
+			YES, YES)
+		} else 
+		    goto replot_
+
+	    case 'y':
+		# Same as 'g' but get endpoints from Y value.
+		i = RV_WINCENTER(rv) - RV_WINDOW(rv)
+		max = rv_maxpix (WRKPIXY(rv,i), 2*RV_WINDOW(rv))
+		call gctran (gp, x, y, x, y, wcs, 2)
+		if (y >= max) {
+		    call rv_errmsg ("Cannot set cursor above CCF peak.")
+	 	} else {
+		    call reset_errcom (rv)
+		    RV_FITHGHT(rv) = y
+		    call rv_yfit (rv, y, YES)
+	 	}
+
+	    case 'z':
+		# Zoom in on a new peak in the entire CCF.
+		RV_ERRCODE(rv) = OK
+		call rv_zplot (rv, gp, x, y, wcs)
+
+	    case '\n', '\r', ' ':
+		# No-op.
+
+	    default:
+	    	# Unknown command
+unknown_	call rv_errmsg ("Type '?' for a list of commands.")
+	    }
+
+	    RV_NEWXCOR(rv) = NO
+	    RV_NEWGRAPH(rv) = NO
+
+	} until (clgcur("cursor",x,y,wcs,key,Memc[cmd],SZ_LINE) == EOF)
+
+exit_	call sfree (sp)
+end
+
+
+# RV_DO_SAVE - Check that a write is called for, and prompt for a filename
+# if necessary.
+
+procedure rv_do_save (rv, written)
+
+pointer	rv				#I RV struct pointer
+bool	written				#U Data write flag
+
+begin
+	if (RV_AUTOWRITE(rv) == YES && (!written || RV_UPDATE(rv) == YES))
+  	    call cmd_write (rv, written)
+	else if (!written || RV_UPDATE(rv) == YES)
+	    call rv_query_save (rv, written, MOVE)
+end
+
+
+# RV_MODE_PROMPT - For a given sub-mode, prompt the user appropriately, giving
+# also the parent mode.
+
+procedure rv_mode_prompt (rv)
+
+pointer	rv				#I RV struct pointer
+
+begin
+	# Switch on the legal modes (i.e. make it simple)
+	switch (RV_MODES(rv)) {
+	case 1:
+	    # No-op
+	case 12:
+	    call printf ("ccf.fft mode: ") 	# CCF -> FFT
+	case 13:
+	    call printf ("ccf.spec mode: ") 	# CCF -> SPEC
+	case 123:
+	    call printf ("ccf.fft.spec mode: ") # CCF -> FFT -> SPEC
+	case 132:
+	    call printf ("ccf.spec.fft mode: ") # CCF -> SPEC -> FFT
+	default:
+	}
+	call flush (STDOUT)
+end
+
+
+# RV_PARENT - Utility to return the parent mode of the current mode.
+
+int procedure rv_parent (rv)
+
+pointer	rv				#I RV struct pointer
+
+begin
+	# Switch on the legal modes (i.e. make it simple)
+	switch (RV_MODES(rv)) {
+	case 123:
+	    return (FFT_MODE)
+	case 132:
+	    return (SPEC_MODE)
+	default:
+	    return (INDEFI)
+	}
+end
+
+
+# RV_QUERY_SAVE - Query the user to save the results, and possibly a file
+# name.
+
+procedure rv_query_save (rv, written, type)
+
+pointer	rv				#I RV struct pointer
+bool	written				#I Results written flag
+int	type				#I Type of prompt
+
+pointer	sp, resp, gopen()
+int	stat, scan()
+bool	answer, streq()
+
+data	answer	/true/
+
+begin
+	call smark (sp)
+	call salloc (resp, SZ_LINE, TY_CHAR)
+
+	# Prompt the user.
+	if (type == QUIT) {
+	    call printf ("Save results before quitting? (%b) ")
+		call pargb (answer)
+	} else if (type == MOVE) {
+	    call printf ("Save results before moving? (%b) ")
+		call pargb (answer)
+	} else {
+	    call printf ("Results already written.  Write again? (%b) ")
+		call pargb (answer)
+	}
+	call flush (STDOUT)
+
+	stat = scan()
+	    call gargstr (Memc[resp], SZ_FNAME)
+	if (Memc[resp] == 'n' || Memc[resp] == 'N')
+	    answer = false
+	else if (Memc[resp] == 'y' || Memc[resp] == 'Y')
+	    answer = true
+
+	if (answer) {
+	    if (RV_TXFD(rv) == NULL) {
+		call strcpy ("\0", Memc[resp], SZ_FNAME)
+		while (Memc[resp] == '\0' && !streq(Memc[resp],"\"\"")) {
+	    	    call printf ("Root output filename: ")
+	    	    call flush (STDOUT)
+	    	    stat = scan()
+		        call gargstr (Memc[resp], SZ_FNAME)
+		}
+		if (!streq(Memc[resp],"\"\"")) {
+		    call init_files (rv, DEVICE(rv), Memc[resp], true)
+        	    RV_MGP(rv) = gopen ("stdvdm", APPEND, RV_GRFD(rv))
+		}
+	    }
+	    if (!streq(Memc[resp],"\"\"")) {
+	        written = false
+	        call cmd_write (rv, written)
+	        answer = true
+	    } else {
+		call printf ("Results not saved.\n")
+	        call sfree (sp)
+		return
+	    }
+
+	} else {
+	    answer = false
+	    call sfree (sp)
+	    return
+	}
+
+	call sfree (sp)
+end
+
+
+# RV_RDCURSOR - Read and print out the current cursor position.  This routine
+# figures out where the user is pointing and print out in the correct WCS.
+
+procedure rv_rdcursor (rv, gp, x, y, wcs)
+
+pointer	rv				#I RV struct pointer
+pointer	gp				#I Graphics pointer
+real	x				#I X cursor position
+real	y				#I Y cursor position
+int	wcs				#I WCS of cursor position
+
+real	x1, y1, vel
+double	rv_shift2vel()
+
+begin
+	# Check for boundary coordinates
+	call gctran (gp, x, y, x1, y1, wcs, 0)
+	if (y1 < 0.725)					# in bottom ccf plot
+	    call gctran (gp, x, y, x1, y1, wcs, 2)
+	else
+	    call gctran (gp, x, y, x1, y1, wcs, 3)
+
+	if (RV_DCFLAG(rv) == -1) {
+	    call printf ("Cursor:  lag = %.3f  y = %.3f\n")
+	        call pargr (x1)
+	        call pargr (y1)
+	} else {
+	    vel = real (rv_shift2vel(rv,x1))
+	    call printf ("Cursor:  lag = %.3f  velocity = %.3f  y = %.3f\n")
+	        call pargr (x1)
+	        call pargr (vel)
+	        call pargr (y1)
+	}
+end