include <ctype.h>
include <fset.h>
include <error.h>
include "rvpackage.h"
include "rvflags.h"
include "rvcont.h"
include "rvsample.h"

# COLON_CMDS  -  Utility file for common colon commands.  Usually, just 
# routines to get/set parameter values.  Task specific stuff is left in
# the appropriate colon command source file.


# CMD_ADD_COMMENT - Add a comment to the output logs.

procedure cmd_add_comment (rv)

pointer	rv					#I RV struct pointer

pointer	sp, buf
int 	i
char	c

begin
	if (RV_TXFD(rv) == NULL) {
	    call rv_errmsg (rv, "No output log yet opened.")
	    return
	}

	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)

	# Now read the line and build up the buffer.
	call scanc (c)
	if (c == '\n' || c == EOS) {
	    call rv_errmsg (rv, "Usage: ':comment <string>'")
	    call sfree (sp)
	    return
	} else {
	    i = 0
	    while (c != '\n' && c != EOS && i < SZ_LINE) {
		Memc[buf+i] = c
		i = i + 1
		call scanc (c)
	    }
	    Memc[buf+i] = '\0'
	    call fprintf (RV_TXFD(rv), "#   %s\n")
		call pargstr (Memc[buf])
	}

	call sfree (sp)
end


# CMD_APLIST - Set/Show the aperture list to process.

procedure cmd_aplist (rv, written)

pointer	rv					#I RV struct pointer
bool	written					#I Data write flag

pointer	sp, buf
int	stat, rv_apnum_range()
errchk	realloc

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)

	call gargstr (Memc[buf], SZ_FNAME)
	if (Memc[buf] != EOS) {
	    call rv_do_save (rv, written)
	    stat = rv_apnum_range (rv, Memc[buf+1])
	    call rv_ppstr (RV_GP(rv), "apertures", Memc[buf+1], "fxcorPars")
	} else {
	    call printf ("Aperture list = `%s'")
		call pargstr (APPARAM(rv))
	}

	call sfree (sp)
end


# CMD_APNUM - Get/Set the APNUM.

procedure cmd_apnum (rv, written)

pointer	rv					#I RV struct pointer
bool	written					#I Data write flag

int	i, ival, found
int	rv_getim(), nscan()

begin
	call gargi (ival)
	if (nscan() == 2) {
	    found = NO				# position the aplist pointer
	    do i = 1, NUMAPS(rv) {
		if (ival == APLIST(rv,i)) {
		    CURAPNUM(rv) = i
		    found = YES
		}
	    }
	    if (found == NO) {			# check if it's legal
		call rv_errmsg (rv, 
		   "Apnum not in current list. Reset list with `:apertures'")
		return
	    }
	    call rv_do_save (rv, written)
	    RV_APNUM(rv) = ival
	} else {
	    call printf ("APNUM = %d")
	        call pargi (RV_APNUM(rv))
	    return
	}

	# Get the new apertures.
	OBJCONT(rv) = NO
	IS_DBLSTAR(rv) = NO
	#SR_COUNT(RV_OSAMPLE(rv)) = ALL_SPECTRUM
	#SR_COUNT(RV_RSAMPLE(rv)) = ALL_SPECTRUM
	if (rv_getim(rv, IMAGE(rv), OBJECT_SPECTRUM, INDEF, INDEF, INDEFI) ==
	    ERR_READ)
	        return
	REFCONT(rv) = NO
	if (rv_getim(rv, RIMAGE(rv), REFER_SPECTRUM, INDEF, INDEF, INDEFI) == 
	    ERR_READ)
	        return

	RV_NEWXCOR(rv) = YES
end


# CMD_APODIZE - Get/Set the apodize percentage.

procedure cmd_apodize (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    RV_APODIZE(rv) = rval
	    RV_NEWXCOR(rv) = YES
	    call rv_pparr (RV_GP(rv), "apodize", rval, "fxcorPars")
	} else {
	    call printf ("Apodize percentage = %g")
	        call pargr (RV_APODIZE(rv))
	}
end


# CMD_AUTODRAW - Set/Show the autodraw flag.

procedure cmd_autodraw (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	nscan(), btoi()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    RV_AUTODRAW(rv) = btoi (bval)
	    call rv_pparb (RV_GP(rv), "autodraw", RV_AUTODRAW(rv), "fxcorPars")
	} else {
	    call printf ("autodraw = `%b'")
	        call pargb (itob(RV_AUTODRAW(rv)))
	}
end


# CMD_AUTOWRITE - Set/Show the autowrite flag.

procedure cmd_autowrite (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	nscan(), btoi()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    RV_AUTOWRITE(rv) = btoi (bval)
	    call rv_pparb (RV_GP(rv), "autowrite", RV_AUTOWRITE(rv),"fxcorPars")
	} else {
	    call printf ("autowrite = `%b'")
	        call pargb (itob(RV_AUTOWRITE(rv)))
	}
end


# CMD_BACKGROUND - Set/Show the fitting background.

procedure cmd_background (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    call rv_erase_fit (rv, false)
	    RV_BACKGROUND(rv) = rval
	    RV_FITDONE(rv) = NO
	    call rv_pparr (RV_GP(rv), "background", rval, "fxcorPars")
	} else {
	    call printf ("Background = %g")
	        call pargr (RV_BACKGROUND(rv))
	}
end


# CMD_CONT - Do the continuum normalization.

procedure cmd_cont (rv)

pointer	rv					#I RV struct pointer

pointer	sp, cmd
int	stat, spc_cursor()

begin
	call smark (sp)
	call salloc (cmd, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[cmd], SZ_FNAME)
	if (Memc[cmd] == EOS) {
	    # The default action (i.e. command is ":cont") is to do
	    # the continuum fitting from both the current bin spectrum
	    # and the current template spectrum.
	    call do_continuum (rv, OBJECT_SPECTRUM)
	    RV_GTYPE(rv) = NORM_PLOT
	    if (RV_CONTINUUM(rv) == TEMP_ONLY || RV_CONTINUUM(rv) == BOTH)
	        call do_continuum (rv, REFER_SPECTRUM)

	} else {
	    # Now parse the argument to find out what to do.
	    switch (Memc[cmd+1]) {
	    case 'o':				# do object only
	        call do_continuum (rv, OBJECT_SPECTRUM)
	    case 't':				# do template only
		call do_continuum (rv, REFER_SPECTRUM)
	    default:
		call rv_errmsg (rv, 
		  "Ambigous argument. Choose one of 'object|template'.")
	    }
	}
	if (RV_INTERACTIVE(rv) == YES)
	    stat = spc_cursor (rv)

	call sfree (sp)
end


# CMD_CONTINUUM - Set/Show which spectra get continuum subtracted.

procedure cmd_continuum (rv)

pointer	rv					#I RV struct pointer

pointer	sp, cont, bp
int	contin, cod_which()

begin
	call smark (sp)
	call salloc (bp, SZ_FNAME, TY_CHAR)
	call salloc (cont, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[cont], SZ_FNAME)	# get a new file name
	if (Memc[cont] != EOS) {
	    contin = cod_which (Memc[cont+1])
	    if (contin == 0) {
		call rv_errmsg (rv, "Unknown value.  Choose one of `%s'")
		    call pargstr ("|both|none|object|template|")
		call sfree (sp)
		return
	    }
	    call rv_ppstr (RV_GP(rv), "continuum", Memc[cont+1], "fxcorPars")
	    RV_CONTINUUM(rv) = contin
	    if (RV_CONTINUUM(rv) == BOTH || RV_CONTINUUM(rv) == OBJ_ONLY)
	        call do_continuum (rv, OBJECT_SPECTRUM)
	    if (RV_CONTINUUM(rv) == BOTH || RV_CONTINUUM(rv) == TEMP_ONLY)
	        call do_continuum (rv, REFER_SPECTRUM)
	    RV_NEWXCOR(rv) = YES
	} else {
	    call nam_which (RV_CONTINUUM(rv), Memc[bp])
	    call printf ("continuum = `%s'")
		call pargstr (Memc[bp])
	}
	call sfree (sp)
end


# CMD_CORRECTION - Compute a velocity correction from a pixel shift.

procedure cmd_correction (rv)

pointer	rv					#I RV struct pointer

double	vobs, vcor, verr, rv_shift2vel()
real	rval, sigma
int	stat, nscan(), rv_rvcorrect()

begin
	call gargr (rval)
	sigma = 0.0
	if (nscan() == 2) {
	    if (RV_DCFLAG(rv) != -1) {
	        stat = rv_rvcorrect (rv, rval, sigma, vobs, vcor, verr)
	        call printf (
		    "Shift = %.4f ==>  vrel = %.4f vobs = %.4f vhelio = %.4f")
		        call pargr (rval)
			call pargd (rv_shift2vel(rv,rval))
		        call pargd (vobs)
		        call pargd (vcor)
	        call flush (STDOUT)
	    } else {
		call rv_errmsg (rv,"No dispersion information for computation.")
	    }
	} else
	    call rv_errmsg (rv, "Usage: ':correction <shift>'")
end


# CMD_DELTAV - Print the velocity dispersion to the screen.

procedure cmd_deltav (rv)

pointer	rv					#I RV struct pointer

begin
	call printf ("Velocity dispersion = %7.2f Km/sec/pixel")
	    call pargr (RV_DELTAV(rv))
end


# CMD_FILTER -  Set/Show the current FFT filter value.
 
procedure cmd_filter (rv)

pointer rv					#I RV struct pointer

pointer	sp, buf, bp
int	tmp, filt
int	rv_chk_filter(), cod_which()

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)
	call salloc (bp, SZ_LINE, TY_CHAR)

	call gargstr (Memc[buf], SZ_FNAME)
	if (Memc[buf] != EOS) {
	    filt = cod_which (Memc[buf+1])
	    if (filt == 0) {
		call rv_errmsg (rv, "Unknown value.  Choose one of `%s'")
		    call pargstr ("|both|none|object|template|")
		call sfree (sp)
		return
	    }
	    call rv_ppstr (RV_GP(rv), "filter", Memc[buf+1], "fxcorPars")
	    tmp = RV_FILTER(rv)
	    RV_FILTER(rv) = filt
	    if (filt == BOTH || filt == OBJ_ONLY) {
	        if (rv_chk_filter(rv,OBJECT_SPECTRUM) != OK) {
	    	        RV_FILTER(rv) = tmp
		        call rv_errmsg (rv, 
			    "Filter values not yet set or ambiguous.")
		        call sfree (sp)
		        return
	        }
	    } else if (filt == BOTH || filt == TEMP_ONLY) {
	        if (rv_chk_filter(rv,REFER_SPECTRUM) != OK) {
	    	        RV_FILTER(rv) = tmp
		        call rv_errmsg (rv, 
			    "Filter values not yet set or ambiguous.")
		        call sfree (sp)
		        return
	        }
	    }
	    RV_FILTER(rv) = filt
	    RV_NEWXCOR(rv) = YES
	} else {
	    call nam_which (RV_FILTER(rv), Memc[bp])
	    call printf ("filter = `%s'")
		call pargstr (Memc[bp])
	}

	call sfree (sp)
end


# CMD_FITFUNC -  Set/Show the current correlation fitting function.

procedure cmd_fitfunc (rv)

pointer	rv					#I RV struct pointer

pointer	sp, buf, bp
int	func, strdic()

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)
	call salloc (bp, SZ_LINE, TY_CHAR)

	call gargstr (Memc[buf], SZ_FNAME)
	if (Memc[buf] != EOS) {
	    func = strdic(Memc[buf+1],Memc[buf+1], SZ_FNAME, RV_CFTYPES)
	    if (func == 0) {
		call rv_errmsg (rv, "Unknown function.  Choose one of `%s'")
		    call pargstr ("|gaussian|lorentzian|parabola|center1d|")
		call sfree (sp)
		return
	    }
	    call rv_ppstr (RV_GP(rv), "function", Memc[buf+1], "fxcorPars")
	    call rv_erase_fit (rv, false)
	    RV_FITFUNC(rv) = func
	    RV_FITDONE(rv) = NO
	    call rv_erase_fit (rv, true)
	} else {
	    call nam_fitfunc (rv, Memc[bp])
	    call printf ("Fitting Function = `%s'")
	       call pargstr (Memc[bp])
	}
	call sfree (sp)
end


# CMD_HEIGHT - Get/Set the fitting height.

procedure cmd_height (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    call rv_erase_fit (rv, false)
	    RV_FITHGHT(rv) = rval
	    RV_FITDONE(rv) = NO
	    call rv_pparr (RV_GP(rv), "height", rval, "fxcorPars")
	} else {
	    call printf ("Height = %g")
	        call pargr (RV_FITHGHT(rv))
	}
end


# CMD_IMUPDATE - Set/Show the image header update flag.

procedure cmd_imupdate (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	nscan(), btoi()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    RV_IMUPDATE(rv) = btoi (bval)
	    call rv_pparb (RV_GP(rv), "imupdate", RV_IMUPDATE(rv), "fxcorPars")
	} else {
	    call printf ("imupdate = `%b'")
	        call pargb (itob(RV_IMUPDATE(rv)))
	}
end


# CMD_LINECOLOR - Set/Show the overlay vector line color.

procedure cmd_linecolor (rv)

pointer	rv					#I RV struct pointer

int	ival, nscan()

begin
	call gargi (ival)
	if (nscan() == 2) {
	    RV_LINECOLOR(rv) = ival
	    RV_NEWGRAPH(rv) = YES
	} else {
	    call printf ("Line color = %d")
	        call pargi (RV_LINECOLOR(rv))
	}
end


# CMD_MAXWIDTH - Get/Set the maximum fitting width.

procedure cmd_maxwidth (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    if (rval > RV_CCFNPTS(rv)) {
		call rv_errmsg (rv, "Maxwidth must be less than %d.")
		    call pargi (RV_CCFNPTS(rv))
	    } else {
		call rv_erase_fit (rv, false)
	        RV_MAXWIDTH(rv) = rval
		RV_FITDONE(rv) = NO
	        call rv_pparr (RV_GP(rv), "maxwidth", rval, "fxcorPars")
	    }
	} else {
	    call printf ("maxwidth = %g")
	        call pargr (RV_MAXWIDTH(rv))
	}
end


# CMD_MINWIDTH - Get/Set the minimum fitting width.

procedure cmd_minwidth (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    if (rval < 3.) {
		call rv_errmsg (rv, "Minwidth must be greater than 3.")
	    } else {
		call rv_erase_fit (rv, false)
	        RV_MINWIDTH(rv) = rval
		RV_FITDONE(rv) = NO
	        call rv_pparr (RV_GP(rv), "minwidth", rval, "fxcorPars")
	    }
	} else {
	    call printf ("minwidth = %g")
	        call pargr (RV_MINWIDTH(rv))
	}
end


# CMD_NEXT - Get the next input spectrum.

int procedure cmd_next (rv, infile, rinfile, written, cmdstr)

pointer	rv					#I RV struct pointer
pointer	infile,	rinfile				#I File list pointers
bool	written					#I Have data been written?
char	cmdstr[SZ_FNAME]			#I Command string

pointer	sp, cmd
int	code
int	next_ap(), next_spec(), next_temp()

define	exit_			99

begin
	call smark (sp)
	call salloc (cmd, SZ_LINE, TY_CHAR)
	code = OK

	call sscan (cmdstr)
	call gargwrd (Memc[cmd], SZ_LINE)

	call gargstr (Memc[cmd], SZ_FNAME)
	switch (Memc[cmd+1]) {
	case 'a':				# next aperture
	    call rv_do_save (rv, written)
	    code = next_ap (rv, written)
	case 'o':				# next object spectrum
	    call rv_do_save (rv, written)
	    code = next_spec (rv, infile, written)
	case 't':				# next template spectrum
	    call rv_do_save (rv, written)
	    code = next_temp (rv, rinfile, written)
	default:
	    call rv_errmsg (rv, "Please specify 'aperture|object|template'.")
	}

exit_	call sfree (sp)
	return (code)
end


# CMD_OBJECTS - Set/Show the [new] object input list.

int procedure cmd_objects (rv, infile, written)

pointer	rv					#I RV struct pointer
pointer	infile					#I input list pointer
bool	written					#I data write flag

pointer	sp, buf, ap, obj
char 	imname[SZ_FNAME]
int	ip
pointer	imtopen()
int	get_spec(), imtrgetim(), rv_verify_aps(), rv_apnum_range()
errchk	imtopen

begin
	call smark (sp)
	call salloc (ap, SZ_FNAME, TY_CHAR)
	call salloc (buf, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[buf], SZ_FNAME)
	for (ip=0; IS_WHITE(Memc[buf+ip]); ip=ip+1)
	          ;

	obj = infile
	if (Memc[buf] != EOS) {
	    if (obj != NULL) {
	        call rv_do_save (rv, written)
	        call imtclose (obj)
	    }

	    if (obj != NULL && RV_TEMPLATES(rv) != NULL) {
	        RV_NEWXCOR(rv) = YES			# update data flags
	    } else {
	        RV_NEWXCOR(rv) = NO
	        RV_NEWGRAPH(rv) = NO
	    }
	    RV_FITDONE(rv) = NO
	    OBJCONT(rv) = NO

	    RV_OBJECTS(rv) = imtopen (Memc[buf+ip])
	    obj = RV_OBJECTS(rv)
	    RV_IMNUM(rv) = 1
	    if (imtrgetim (obj, RV_IMNUM(rv), imname, SZ_FNAME) != EOF && 
	        obj != NULL) {
	            if (get_spec(rv, imname, OBJECT_SPECTRUM) == ERR_READ) {
		        call sfree (sp)
	    	        return (ERR_READ)
		    }
		    if (infile == NULL) {
		        call clgstr ("apertures", Memc[ap], SZ_FNAME)
		        if (rv_apnum_range (rv, Memc[ap]) != OK) {
		            call sfree (sp)
	    	            return (ERR_READ)
			}
		    } else if (rv_verify_aps (rv, APPARAM(rv), APLIST(rv,1), 
		        NUMAPS(rv)) == ERR_READ) {
		            call sfree (sp)
		 	    return (ERR_READ)
		    }
	    } else {
	        call rv_errmsg (rv, "Error reading image from list.\n")
	        call sfree (sp)
	        return (ERR_READ)
	    }
	    written = false
            call gmsgi (RV_GP(rv), "wasWritten", 0)
	    call rv_ppstr (RV_GP(rv), "objects", Memc[buf+ip], "fxcorPars")
            if (RV_TEMPLATES(rv) != NULL)
		call gmsgi (RV_GP(rv), "ready", OK)

	} else {
	    if (RV_OBJECTS(rv) != NULL) {
	        call printf ("Current object image name = `%s'")
	            call pargstr (IMAGE(rv))
	    } else 
		call printf ("No object image specified!")
	}

	call sfree (sp)
	return (OK)
end


# CMD_OUTPUT - Change/Show the output log file name. 

procedure cmd_output (rv)

pointer	rv					#I RV struct pointer

pointer	sp, fn
bool	streq()
pointer	gopen()
errchk  gopen

begin
	call smark (sp)
	call salloc (fn, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[fn], SZ_FNAME)	# get new file name
	if (Memc[fn] == EOS) {
	    call printf ("Output file name = `%s'")
		call pargstr (SPOOL(rv))
	} else {
	    # Close existing log file - if any
	    if (RV_TXFD(rv) != NULL)
	        call close (RV_TXFD(rv))
	    if (RV_GRFD(rv) != NULL)
	        call close (RV_GRFD(rv))

	    # Open the graphics pointer and file descriptors.
	    if (streq("",Memc[fn+1]) || streq(" ",Memc[fn+1]) || 
		Memc[fn+1] == '"') {
	            RV_TXFD(rv) = NULL
	            RV_GRFD(rv) = NULL
	    } else if (streq("STDOUT",Memc[fn+1])) {
	        RV_TXFD(rv) = STDOUT
	        RV_GRFD(rv) = NULL
	    } else {
	        # Open the files
		if (!streq(Memc[fn+1],"\"\"")) {
		    call init_files (rv, DEVICE(rv), Memc[fn+1], true)
        	    RV_MGP(rv) = gopen ("stdvdm", APPEND, RV_GRFD(rv))
		}
	    }

	    if (streq("",Memc[fn+1]) || streq(" ",Memc[fn+1]) || 
		Memc[fn+1] == '"') {
	        call strcpy ("", SPOOL(rv), SZ_FNAME)
	    } else
	        call strcpy (Memc[fn+1], SPOOL(rv), SZ_FNAME)
	    call rv_ppstr (RV_GP(rv), "output", SPOOL(rv), "fxcorPars")
	}

	call sfree (sp)
end


# CMD_OUT_TYPE - CCF output type.

procedure cmd_out_type (rv)

pointer	rv					#I RV struct pointer

pointer	sp, buf

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)

	call gargstr (Memc[buf], SZ_FNAME)
	if (Memc[buf] != EOS) {
	    if (Memc[buf+1] == 'i') {
	        RV_CCFTYPE(rv) = OUTPUT_IMAGE
	    } else if (Memc[buf+1] == 't') {
	        RV_CCFTYPE(rv) = OUTPUT_TEXT
	    } else
		call rv_errmsg (rv, "Choose one of 'image|text'.")
	    call rv_ppstr (RV_GP(rv), "ccftype", Memc[buf+1], "fxcorPars")
	} else {
	    call printf ("ccftype = `%s'")
	        if (RV_CCFTYPE(rv) == OUTPUT_IMAGE)
	            call pargstr ("image")
	        else
	            call pargstr ("text file")
	}

	call sfree (sp)
end


# CMD_PEAK - Is peak height a normalized correlation?

procedure cmd_peak (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	nscan(), btoi()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    call rv_erase_fit (rv, false)
	    RV_PEAK(rv) = btoi (bval)
	    RV_FITDONE(rv) = NO
	    call rv_pparb (RV_GP(rv), "peak", RV_PEAK(rv), "fxcorPars")
	} else {
	    call printf ("peak = `%b'")
	        call pargb (itob(RV_PEAK(rv)))
	}
end


# CMD_PIXCORR - Do a pixel-only correlation?

procedure cmd_pixcorr (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	stat, nscan(), btoi(), rv_getim()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    if (btoi(bval) != RV_PIXCORR(rv)) {
	        RV_PIXCORR(rv) = btoi (bval)
	        RV_FITDONE(rv) = NO
	        RV_NEWXCOR(rv) = YES
		call printf ("Re-reading images....")
		call flush (STDOUT)
                stat = rv_getim (rv, IMAGE(rv), OBJECT_SPECTRUM, INDEF,
		    INDEF, INDEFI)
                stat = rv_getim (rv, RIMAGE(rv), REFER_SPECTRUM, INDEF,
		    INDEF, INDEFI)
		call printf ("\n")
		call flush (STDOUT)
            }
	    call rv_pparb (RV_GP(rv), "pixcorr", RV_PIXCORR(rv), "fxcorPars")
	} else {
	    call printf ("pixcorr = `%b'")
	        call pargb (itob(RV_PIXCORR(rv)))
	}
end


# CMD_PREVIOUS - Get the previous input spectrum.

int procedure cmd_previous (rv, infile, rinfile, written, cmdstr)

pointer	rv					#I RV struct pointer
pointer	infile,	rinfile				#I file list pointers
bool	written					#I have data been written?
char	cmdstr[SZ_FNAME]			#I command string

pointer	sp, cmd
int	code
int	prev_ap(), prev_spec(), prev_temp()

define	exit_			99

begin
	call smark (sp)
	call salloc (cmd, SZ_LINE, TY_CHAR)
	code = OK

	call sscan (cmdstr)
	call gargwrd (Memc[cmd], SZ_LINE)

	call gargstr (Memc[cmd], SZ_FNAME)
	switch (Memc[cmd+1]) {
	case 'a':				# previous aperture
	    call rv_do_save (rv, written)
	    code = prev_ap (rv, written)
	case 'o':				# previous object spectrum
	    call rv_do_save (rv, written)
	    code = prev_spec (rv, infile, written)
	case 't':				# previous template spectrum
	    call rv_do_save (rv, written)
	    code = prev_temp (rv, rinfile, written)
	default:
	    call rv_errmsg (rv, "Please specify 'aperture|object|template'.")
	}

exit_	call sfree (sp)
	return (code)
end


# CMD_PRINTZ - Toggle output of Z values

procedure cmd_printz (rv)

pointer	rv					#I RV struct pointer

bool	bval, itob()
int	nscan(), btoi()

begin
	call gargb (bval)
	if (nscan() == 2) {
	    RV_PRINTZ(rv) = btoi (bval)
	} else {
	    call printf ("Z output = `%b'")
	        call pargb (itob(RV_PRINTZ(rv)))
	}
end


# CMD_PRTDISP - Print the rebinned dispersion info for the user.

procedure cmd_prtdisp (rv)

pointer	rv						#I RV struct pointer

int	nscan()

begin
	if (nscan() > 1) {
	    call rv_errmsg (rv, "Syntax: ':disp'.")
	} else {
	    if (RV_DCFLAG(rv) != -1) {
		call printf ("Object W0 = %.5f  Template W0 = %.5f  WPC = %g\n")
		    call pargr (RV_OW0(rv))
		    call pargr (RV_RW0(rv))
	            call pargr (RV_OWPC(rv))
	    } else {
	        call printf (
		  "No dispersion information present. (Pixel correlation only)")
	    }
	}
end


# CMD_REBIN - Set/Show the rebin parameter.

procedure cmd_rebin (rv)

pointer	rv					#I RV struct pointer

pointer	sp, rb
int	rebin, cod_rebin()

begin
	call smark (sp)
	call salloc (rb, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[rb], SZ_FNAME)
	if (Memc[rb] != EOS) {
            rebin = cod_rebin (Memc[rb])
            if (rebin == ERR) {
                call rv_errmsg (rv, 
		   "`rebin' must be one of `smallest|largest|object|template'")
		call sfree (sp)
		return
	    }
	    RV_REBIN(rv) = rebin
	    call rv_ppstr (RV_GP(rv), "rebin", Memc[rb+1], "fxcorPars")
	} else {
	    call nam_verbose (rv, Memc[rb])
	    call printf ("rebin = `%s'")
	        call pargstr (Memc[rb])
	}
end


# CMD_REFSPEC - Set/Show the [new] reference spectrum.

int procedure cmd_refspec (rv, rinfile, written)

pointer	rv					#I RV struct pointer
pointer	rinfile					#U image list pointer
bool	written					#I data write flag

pointer	sp, buf, tmp
pointer	imtopen()
int	ip
int	read_template_list(), rv_verify_aps()
errchk	imtopen

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)

        call gargstr (Memc[buf], SZ_FNAME)
        for (ip=0; IS_WHITE(Memc[buf+ip]); ip=ip+1)
                  ;

	if (Memc[buf] != EOS) {
            if (rinfile != NULL)
                call rv_do_save (rv, written)

	    tmp = imtopen (Memc[buf+ip])
            if (tmp != NULL && RV_OBJECTS(rv) != NULL) {
                RV_NEWXCOR(rv) = YES                    # update data flags
            } else {
                RV_NEWXCOR(rv) = NO
                RV_NEWGRAPH(rv) = NO
            }
            RV_FITDONE(rv) = NO
            REFCONT(rv) = NO

	    if (read_template_list(rv,tmp) == ERR_READ) {
		call rv_errmsg (rv, "Null list specified for templates.")
		call sfree (sp)
		return (ERR_READ)
	    } else {
                if (rinfile != NULL)
	            call imtclose (rinfile)
	        RV_TEMPLATES(rv) = tmp
		if (rv_verify_aps (rv, APPARAM(rv), APLIST(rv,1), 
		    NUMAPS(rv)) == ERR_READ)
		 	return (ERR_READ)
	    }

	    call rv_tempcodes (rv, RV_TXFD(rv))		# write out new codes
	    written = false
            call gmsgi (RV_GP(rv), "wasWritten", 0)
	    call rv_ppstr (RV_GP(rv), "templates", Memc[buf+ip], "fxcorPars")
            if (RV_OBJECTS(rv) != NULL)
		call gmsgi (RV_GP(rv), "ready", OK)

	} else {
	    if (RV_TEMPLATES(rv) != NULL) {
	        call printf ("Current template image name = `%s'")
	            call pargstr (RIMAGE(rv))
	    } else 
		call printf ("No object image specified!")
	}

	call sfree (sp)
	return (OK)
end


# CMD_REGIONS -  Set/Show the current selected regions list.

int procedure cmd_regions (rv, ssp)

pointer	rv					#I RV struct pointer
pointer	ssp					#I Sample struct pointer

pointer	sp, buf
int	rv_load_sample()

begin
	call smark (sp)
	call salloc (buf, SZ_LINE, TY_CHAR)
	call aclrs (Memc[buf], SZ_FNAME)

	call gargstr (Memc[buf], SZ_FNAME)
	if (Memc[buf] != EOS) {
	    call rv_erase_regions (ssp, RV_GP(rv))
	    if (Memc[buf+1] == '*')
	        SR_COUNT(ssp) = ALL_SPECTRUM
	    else {
	        if (rv_load_sample(ssp, Memc[buf+1]) == ERR_CORREL) {
		    call sfree (sp)
	            return (ERR_CORREL)
		}
	    }
	    RV_NEWXCOR(rv) = YES
	    if (RV_OSAMPLE(rv) == ssp)
		call rv_ppstr (RV_GP(rv), "osample", Memc[buf+1], "fxcorPars")
	    else if (RV_RSAMPLE(rv) == ssp)
		call rv_ppstr (RV_GP(rv), "rsample", Memc[buf+1], "fxcorPars")

	    if (SR_COUNT(ssp) != ALL_SPECTRUM)
	        call rv_mark_regions (ssp, RV_GP(rv))
	    SR_MODIFY(ssp) = YES
	} else {
	    call rv_make_range_string (ssp, Memc[buf])
	    call printf ("Sample regions selected: `%s'")
	        call pargstr (Memc[buf])
	    call flush (STDOUT)
	}

	call sfree (sp)
	return (OK)
end


# CMD_RESULT - Page the logfile of results.

procedure cmd_result (rv)

pointer	rv					#I RV struct pointer

pointer	sp, cmd, buf, gp
int	open(), fstati()
errchk	open

begin
	gp = RV_GP(rv)
	if (gp == NULL)
	    return

	call smark (sp)
	call salloc (buf, SZ_FNAME, TY_CHAR)
	call salloc (cmd, SZ_FNAME, TY_CHAR)

    	# Page the logfile. Pointer is closed to be VMS compatible.
	call gargstr (Memc[cmd], SZ_FNAME)
	if (Memc[cmd] == EOS) {
    	    if (RV_TXFD(rv) != NULL) {
	        if (fstati(RV_TXFD(rv),F_FILESIZE) == 0) 
	    	    call rv_errmsg (rv, "Nothing yet written to logfile.")
	        else {
	            call sprintf (Memc[buf], SZ_FNAME, "%s.txt\0")
	    	        call pargstr (SPOOL(rv))
	            call flush (RV_TXFD(rv))
	            call close (RV_TXFD(rv))
	            call gpagefile (gp, Memc[buf], "Log File of Results:")
	            RV_TXFD(rv) = open (Memc[buf], APPEND, TEXT_FILE)
	        }
    	    } else
	        call rv_errmsg (rv, "No output file specified.")
	} else {
	    call sprintf (Memc[buf], SZ_FNAME, "%s.txt\0")
	        call pargstr (Memc[cmd])
	    call gpagefile (gp, Memc[buf], "Log File of Results:")
	}

	call sfree (sp)
end


# CMD_TEMPVEL - Set/show the known template velocity.

procedure cmd_tempvel (rv, tnum)

pointer	rv					#I RV struct pointer
int	tnum					#I Template number

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    TEMPVEL(rv,tnum) = rval
	    RV_NEWXCOR(rv) = YES
	} else {
	    call printf ("Template velocity = %g km/sec")
	        call pargr (TEMPVEL(rv,tnum))
	}
end


# CMD_TNUM - Get the specified template spectrum

int procedure cmd_tnum (rv, rinfile, written, cmdstr)

pointer rv                                      #I RV struct pointer
pointer rinfile                         	#I File list pointers
bool    written                                 #I Have data been written?
char    cmdstr[SZ_FNAME]                        #I Command string

pointer sp, cmd
int     i, tn, t1, t2, code
int	strlen(), get_spec(), imtrgetim()

define  exit_                   99

begin
        call smark (sp)
        call salloc (cmd, SZ_LINE, TY_CHAR)
        code = OK

        call sscan (cmdstr)
        call gargwrd (Memc[cmd], SZ_LINE)

	# Now get the requested template number.
        call gargstr (Memc[cmd], SZ_FNAME)
	for (i=0; IS_WHITE(Memc[cmd+i]); i=i+1)
	    ;
	if (IS_DIGIT(Memc[cmd+i])) {
	    call sscan (Memc[cmd+i])
	        call gargi (tn)
	    #RV_TEMPNUM(rv) = tn
	} else {
	    if (strlen(Memc[cmd+i]) == 1) {
	        tn = int (Memc[cmd+i])
	        if (IS_LOWER(tn)) tn = TO_UPPER(tn)
	        tn = tn - 'A' + 1
	    } else if (strlen(Memc[cmd+i]) == 2) {
		if (Memc[cmd+i] == ' ')
		    t1 = 0
		else {
		    t1 = int (Memc[cmd+i])
                    if (IS_LOWER(t1)) t1 = TO_UPPER(t1)
                    t1 = t1 - 'A' + 1
		}
		t2 = int (Memc[cmd+i])
                if (IS_LOWER(t2)) t2 = TO_UPPER(t2)
                t2 = t2 - 'A' + 1
		tn = t1 * 26 + t2
	    }
	}

	# Optimize.
	if (RV_TEMPNUM(rv) == tn) {
	    call nam_tempcode (tn, Memc[cmd])
	    call rv_errmsg (rv, "Current template is already template `%s'.\n")
		call pargstr (Memc[cmd])
	    call sfree (sp)
	    return
	}

	# Check for the data write.
	call rv_do_save (rv, written)
 
	# Do the read on the template
	RV_TEMPNUM(rv) = tn
	if (imtrgetim(rinfile, RV_TEMPNUM(rv), RIMAGE(rv), SZ_FNAME) != EOF) {
	    if (get_spec (rv, RIMAGE(rv), REFER_SPECTRUM) == ERR_READ)
	        call error (0, "Error reading next template.")
	    call rv_imtitle (RIMAGE(rv), TEMPNAME(rv), SZ_FNAME)
	    written = false
            call gmsgi (RV_GP(rv), "wasWritten", 0)
	    RV_TEMPCODE(rv) = TEMPCODE(rv,RV_TEMPNUM(rv))
	    call amovkr (0.0, COEFF(rv,1), 4)
	    RV_FITDONE(rv) = NO
	    RV_NEWXCOR(rv) = YES
	    IS_DBLSTAR(rv) = NO
	} else
	    call rv_errmsg (rv, "Error getting the requested template.")

exit_   call sfree (sp)
        return (code)
end


# CMD_TEXTCOLOR - Set/Show the text color.

procedure cmd_textcolor (rv)

pointer rv                                      #I RV struct pointer

int     ival, nscan()

begin
        call gargi (ival)
        if (nscan() == 2) {
            RV_TXTCOLOR(rv) = ival
        } else {
            call printf ("Text color = %d")
                call pargi (RV_TXTCOLOR(rv))
        }
end


# CMD_VERBOSE - Set/Show the verbose output flag.

procedure cmd_verbose (rv)

pointer	rv					#I RV struct pointer

pointer	sp, bp, op
int	verbose
int	cod_verbose()

begin
	call smark (sp)
	call salloc (bp, SZ_FNAME, TY_CHAR)
	call salloc (op, SZ_FNAME, TY_CHAR)

	call gargstr (Memc[bp], SZ_FNAME)
	if (Memc[bp] != EOS) {
            verbose = cod_verbose (Memc[bp])
            if (verbose == ERR) {
                call rv_errmsg (rv, 
		    "`verbose' must be one of `short|long|nogki|nolog|txtonly'")
		call sfree (sp)
		return
	    }
	    RV_VERBOSE(rv) = verbose
	    call rv_ppstr (RV_GP(rv), "verbose", Memc[bp+1], "fxcorPars")
	} else {
	    call nam_verbose (rv, Memc[op])
	    call printf ("verbose = `%s'")
	        call pargstr (Memc[op])
	}

	call sfree (sp)
end


# CMD_VERSION - Development debug to print IRAF/RV version numbers.

procedure cmd_version ()

begin
	call printf ("RV Version: %s")
	    call pargstr (RV_VERSION)
end


# CMD_WEIGHTS - Get/Set the fitting weights.

procedure cmd_weights (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    call rv_erase_fit (rv, false)
	    RV_WEIGHTS(rv) = rval
	    RV_FITDONE(rv) = NO
	    call rv_pparr (RV_GP(rv), "weights", rval, "fxcorPars")
	} else {
	    call printf ("weights = %g")
	        call pargr (RV_WEIGHTS(rv))
	}
end


# CMD_WIDTH - Get/Set the fitting width.

procedure cmd_width (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    if (!IS_INDEF(rval)) {
	        if (int(rval) > RV_CCFNPTS(rv)) {
		    call rv_errmsg (rv,"Width is greater than npts in the ccf.")
		    return
	        }
	    }
	    call rv_erase_fit (rv, false)
	    RV_FITWIDTH(rv) = rval
	    RV_FITDONE(rv) = NO
	    call rv_pparr (RV_GP(rv), "width", rval, "fxcorPars")
	} else {
	    call printf ("width = %g")
	        call pargr (RV_FITWIDTH(rv))
	}
end


# CMD_WINCENTER - Get/Set the window center.

procedure cmd_wincenter (rv)

pointer	rv					#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    RV_WINCENPAR(rv) = rval
	    call rv_batch_xcor (rv, RV_TEMPNUM(rv), RV_APNUM(rv), NO, YES, YES)
	    call rv_pparr (RV_GP(rv), "wincenter", rval, "fxcorPars")
	} else {
	    if (RV_DCFLAG(rv) == -1 || RV_PIXCORR(rv) == YES) {
	        call printf ("wincenter = %d lags")
		    if (IS_INDEF(RV_WINPAR(rv)))
	                call pargi (INDEFI)
		    else
	                call pargi (int(RV_WINCENPAR(rv)))
	    } else {
	        call printf ("wincenter = %.2f Km/sec")
	            call pargr (RV_WINCENPAR(rv))
	    }
	}
end


# CMD_WINDOW - Set/show the current width of the peak window.

procedure cmd_window (rv)

pointer	rv						#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    RV_WINPAR(rv) = rval
	    call rv_batch_xcor (rv, RV_TEMPNUM(rv), RV_APNUM(rv), NO, YES, YES)
	    call rv_pparr (RV_GP(rv), "window", rval, "fxcorPars")
	} else {
	    if (RV_DCFLAG(rv) == -1 || RV_PIXCORR(rv) == YES) {
	        call printf ("window = %d pixels")
		    if (IS_INDEF(RV_WINPAR(rv)))
	                call pargi (INDEFI)
		    else
	                call pargi (int(RV_WINPAR(rv)))
	    } else {
	        call printf ("window = %.2f Km/sec")
	            call pargr (RV_WINPAR(rv))
	    }
	}
end
 

# CMD_WRITE - Write results to logfile and/or header.

procedure cmd_write (rv, written)

pointer	rv					#I RV struct pointer
bool	written					#I data write flag

pointer	sp, fname
pointer	gopen()
int	stat, nscan(), scan()
bool	streq()
errchk	gopen

begin
	if (written && RV_UPDATE(rv) == NO)
	    return

	call smark (sp)
	call salloc (fname, SZ_FNAME, TY_CHAR)

	# Make sure we have an output file.
        if (RV_TXFD(rv) == NULL) {
            call strcpy ("\0", Memc[fname], SZ_FNAME)
            while (Memc[fname] == '\0' && !streq(Memc[fname],"\"\"")) {
                call printf ("Root output filename: ")
                call flush (STDOUT)
                stat = scan()
                    call gargstr (Memc[fname], SZ_FNAME)
            }
            if (nscan() == 1 && !streq(Memc[fname],"\"\"")) {
                call init_files (rv, DEVICE(rv), Memc[fname], true)
                RV_MGP(rv) = gopen ("stdvdm", APPEND, RV_GRFD(rv))
            }
        }
 
        if (!streq(Memc[fname],"\"\"")) {
	    call printf ("Writing current results to `%s.txt'....")
	        call pargstr (SPOOL(rv))
	    call flush (STDOUT)

	    call rv_write (rv, RV_RECORD(rv))
	    call rv_eplot (rv, RV_MGP(rv))
	    call rv_verbose_fit (rv, RV_VBFD(rv))
	    RV_RECORD(rv) = RV_RECORD(rv) + 1
	    written = true
	    call flush (STDOUT)

            call gmsgi (RV_GP(rv), "wasWritten", 0)
	    RV_UPDATE(rv) = NO
	} else
	    call printf ("Results not saved.\n")

	call flush (STDOUT)
	call sfree (sp)
end


# CMD_YMAX - Set/show the top of the ccf plot window.

procedure cmd_ymax (rv)

pointer	rv						#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    RV_Y2(rv) = rval
	    RV_NEWGRAPH(rv) = YES
	} else {
	    call printf ("Ymax = %f")
	        call pargr (RV_Y2(rv))
	}
end


# CMD_YMIN - Set/show the bottom of the ccf plot window.

procedure cmd_ymin (rv)

pointer	rv						#I RV struct pointer

real	rval
int	nscan()

begin
	call gargr (rval)
	if (nscan() == 2) {
	    RV_Y1(rv) = rval
	    RV_NEWGRAPH(rv) = YES
	} else {
	    call printf ("Ymin = %f")
	        call pargr (RV_Y1(rv))
	}
end