Added new FitsOps commands

	Added some extra FitsOps commands for shift, scale, row data dump and
	listing statistics of fits images.

FitsOps.tcl

@@ -37,6 +37,195 @@ proc FitsOps:ValidFitsFile {filename} {
     }
 }
 
+#******************************************************************************
+#
+# Provide basic statistics about the main image of a given fitsfile.
+#
+#
+# Arguments
+#   filename - FITS filename
+#
+# Optional Args:
+#   -np   - Do not print to standard out in nice format
+# Returns:
+#     list: min max mean sd median
+#
+
+proc FitsOps:StatImage {fitsfile args} {
+
+    set fob [fits open $fitsfile 0]
+    set imgdim   [$fob info imgdim]
+    set dim1     [lindex $imgdim 0]
+    set dim2     [lindex $imgdim 1]
+
+    # load image data into memory and get address pointer
+    set ptr [$fob load iblock -- 1 $dim1 1 $dim2]
+
+    # Calculate each statistic using the vexpr command
+    set min   [lindex [vexpr -use FitsOps:getPtrData "min(ptr)"] 0]
+    set max   [lindex [vexpr -use FitsOps:getPtrData "max(ptr)"] 0]
+    set mean  [lindex [vexpr -use FitsOps:getPtrData "average(ptr)"] 0]
+    set stdev [lindex [vexpr -use FitsOps:getPtrData "stddev(ptr)"] 0]
+    set medi  [lindex [vexpr -use FitsOps:getPtrData "median(ptr)"] 0]
+
+    # Free the pointer and fob handle
+    fits free [lindex $ptr 0]
+    $fob close
+
+    # If not -np option (no print) then print the results
+    if {[lsearch $args "-np"]==-1} {
+	puts "\nStats for $fitsfile:"
+	puts "\tRange = \[$min , $max\]"
+	puts "\tMean  = $mean \t SD = $stdev"
+	puts "\tMedian= $medi\n"
+    }
+
+    # return the statlist
+    return [list $min $max $mean $stdev $medi]
+	
+}
+
+#******************************************************************************
+#
+# Creates a new fits file based on supplied fits file with the image data
+# scaled by supplied factor.
+#
+#
+# Arguments
+#   inpfitsfile         - Intput FITS filename 
+#   scale_factor        - Factor to scale the image by
+#   outfitsfilefilename - Output FITS filename
+#
+#
+
+proc FitsOps:Scale {inpfitsfile scale_factor outfitsfile} {
+
+    if {[file exists $outfitsfile]} {file delete $outfitsfile} 
+
+    set fob1 [fits open $inpfitsfile 0];# Read only
+    set fob2 [fits open $outfitsfile 2];# Write only
+
+    # Get the input image dimensions
+    set imgdim   [$fob1 info imgdim]
+    set dim1     [lindex $imgdim 0]
+    set dim2     [lindex $imgdim 1]
+
+    # load image data into memory and get address pointer
+    set img [$fob1 get image]
+
+    # Calculate each statistic using the vexpr command
+    set outimg [vexpr "$scale_factor * img"]
+
+    # put difference into output file
+    $fob2 insert image -32 2 $imgdim
+    $fob2 put image 1 $outimg
+
+    # Free the  fob handles
+    $fob1 close
+    $fob2 close
+
+    # release image lists
+    unset img
+    unset outimg
+
+     # copy input file header info into output file
+    FitsOps:CopyHeader $inpfitsfile $outfitsfile
+
+}
+
+#******************************************************************************
+#
+# Creates a new fits file based on supplied fits file with the image data
+# shifted by supplied value.
+#
+#
+# Arguments
+#   inpfitsfile         - Intput FITS filename 
+#   shift_factor        - Value to shift the image by
+#   outfitsfilefilename - Output FITS filename
+#
+#
+
+proc FitsOps:Shift {inpfitsfile shift_factor outfitsfile} {
+
+    if {[file exists $outfitsfile]} {file delete $outfitsfile} 
+
+    set fob1 [fits open $inpfitsfile 0];# Read only
+    set fob2 [fits open $outfitsfile 2];# Write only
+
+    # Get the input image dimensions
+    set imgdim   [$fob1 info imgdim]
+    set dim1     [lindex $imgdim 0]
+    set dim2     [lindex $imgdim 1]
+
+    # load image data into memory and get address pointer
+    set img [$fob1 get image]
+
+    # Calculate each statistic using the vexpr command
+    set outimg [vexpr "$shift_factor + img"]
+
+    # put difference into output file
+    $fob2 insert image -32 2 $imgdim
+    $fob2 put image 1 $outimg
+
+    # Free the  fob handles
+    $fob1 close
+    $fob2 close
+
+    # release image lists
+    unset img
+    unset outimg
+
+     # copy input file header info into output file
+    FitsOps:CopyHeader $inpfitsfile $outfitsfile
+
+}
+
+#******************************************************************************
+#
+# Dumps the pixel values of a specified row of the main image of a specified 
+# fitsfile into a specified text file.
+#
+# Arguments
+#   inpfitsfile   - Intput FITS filename 
+#   row_no        - Row no to extract from
+#   outfile       - Output text filename
+#
+
+proc FitsOps:DumpRow {inpfitsfile row_no outfile} {
+
+    # Open output text file
+    if {[file exists $outfile]} {file delete $outfile}
+    set fid [open $outfile w]
+
+    # Open fits file
+    set fob [fits open $inpfitsfile 0];# Read only
+
+    # Load image into pointer
+    set myRow [$fob load irows $row_no $row_no]
+
+    # Close the fits file
+    $fob close
+
+    # Convert pointer to tcl list
+    set lst [eval "ptr2lst $myRow"]
+
+    # Output tcl list to text file
+    set idx 1
+    foreach itm $lst {
+	puts $fid "$idx $itm"
+	incr idx 1
+    }
+
+    # Close text file
+    close $fid
+
+    # Free pointer allocation and data list
+    fits free [lindex $myRow 0]
+    unset lst
+
+}
+
 #******************************************************************************
 #
 # Create a new FITS file by subtracting the image data from two FITS files.

fitsprep_tclshrc.tcl

@@ -18,6 +18,29 @@
 # to the true homedir and then call tclsh.
 # -------------------------------------------------------------------------
 
+# Define a command matching routine to be used below.
+proc fitsprep_CmdMatch {cmdstr} {
+
+    set poss_list ""
+
+    # Check if this string does match with a command
+    if {[info command $cmdstr]!=""} {lappend poss_list $cmdstr}
+
+    # Now look for FitsOps: procs with postfix that match (ignoring case)
+    set match_prefix "FitsOps:"
+    set idx [string length $match_prefix]
+    set lcase_cmdstr [string tolower $cmdstr]
+    set fitsops_cmds [info commands "${match_prefix}*"]
+
+    foreach cmd $fitsops_cmds {
+	set idname [string range $cmd $idx end]
+	set idname [string tolower $idname]
+	if {$idname==$lcase_cmdstr} {lappend poss_list $cmd}
+    }
+
+    return $poss_list
+}
+
 
 # Set the tcl HOME env var to the true HOME directory
 if {[info exists env(FITSPREP_USERHOME)]} {
@@ -60,13 +83,14 @@ if {$arg0==""} {return}
 
 # If arg0 begins with a "-" then assume that is to call a tcl procedure
 if {[string range $arg0 0 0]=="-"} {
-    set procname [string range $arg0 1 end]
-    
-    #Check that this proc exists
-    if {[info proc $procname]==""} {
-	puts "Invalid command $arg0"
-	exit
-    }
+    set cmdname [string range $arg0 1 end]
+    
+    # Check that this command exists
+    set cmd_matches [fitsprep_CmdMatch $cmdname]
+    set n_matches [llength $cmd_matches]
+    if {$n_matches==0} {puts "Invalid command $arg0"; exit}
+    if {$n_matches>1}  {puts "Command $cmdname too ambiguous: $cmd_matches ?";exit}
+    set procname [lindex $cmd_matches 0]
 	
     # Evaluate this proc, but catch any errors
     if {[catch {eval "$procname $argv"} result]} {