#!/usr/bin/perl

#
# Fix WCS information, when the pointing is off for whatever reason.
#
# (only need to get within a few pixels, 
#  and then imacsreg will do the rest)
#

# History
#  09 Nov 17 MM  created
#
# Detailed help message
#

use Getopt::Long;
use Text::Wrap;


@usage = ("v1.2  MM  17June2008\n\nUsage: imacsfixwcs (OBJECTS) \n\n");
@help = (
         "\t---------------\n ",
         "\tREQUIRED INPUTS\n ",
         "\t---------------\n ",
         "\tOBJECTS is a file containing all of the flat-fielded, \n",
	 "\tsky-subtracted pointings. For example:\n\n",
         "\tssfccd0001\n",
	 "\tssfccd0002\n",
	 "\tssfccd0003\n",
	 "\t...\n\n",
	 "\tEach of these files should have already had IMACSWCS run on it\n",
         "\t------\n ",
         "\tOUTPUT\n ",
         "\t------\n ",
         "\tThe output is an IRAF CL script named 'fixwcs.cl'; run\n",
         "\tthis file at the cl> prompt with the following syntax:\n",
         "\tcl> cl < fixwcs.cl\n\n",
	 "\t--------\n",
	 "\tNOTES\n",
	 "\t--------\n\n",
	 "\tThis program should be run with an open DS9 window\n",
	 "\tin an xterm, to function properly.\n",
         );


if ($#ARGV lt 1) {
    if ($#ARGV eq 0) {
        if ($ARGV[0] eq "--help") {
            print @usage;
	    print @help;
            print "\n\n";
            exit;
        }
    } else {
        die "@usage\For detailed help: imacsfixwcs --help\n\n";
    }
}


open OBJ, $ARGV[0];
@obj = <OBJ>;
close OBJ;

# Proper DETSEC keyword values for each chip.
@detsec = ("[1:2048,1:4096]",
           "[2049:4096,1:4096]",
           "[4097:6144,1:4096]",
           "[6145:8192,1:4096]",
           "[4096:2049,8192:4097]",
           "[2048:1,8192:4097]",
           "[8192:6145,8192:4097]",
           "[6144:4097,8192:4097]");




@fixwcs=();
push @fixwcs, "mscred\n";
foreach (@obj){

    @line=parse($_);

    # Add DETSEC keyword to chip 2 (necessary for msczero)
    push @fixwcs, "hedit $line[0]c2 DETSEC $detsec[$i-1] add+ verify-\n";
    
    # Make catalogue of star positions
    push @fixwcs, "del astrom.pos\n";
    push @fixwcs, "mscgetcat $line[0]c2 astrom.pos magmax=17 magmin=0 catalog=\"NOAO:USNO-A2\" rmin=0.01\n";
    
    # Display positions on ds9 window
    push @fixwcs, "mscdispl $line[0]c2.fits fr=1\n";
    push @fixwcs, "msctvmark astrom.pos 1\n";
    push @fixwcs, "set disable_wcs_maps=\"\"\n";
    push @fixwcs, "flpr\n";

    # Now, find offsets
    push @fixwcs, "print \'Now type \"m\" to bring up positions of stars. Hit \"s\" on a circle, and then \"z\" on the location of the star. Then, hit \"m\" again to bring up corrected positions. When happy, hit \"q\" to finish.\'\n"; 
    push @fixwcs, "msczero $line[0]c2 coords=\"astrom.pos\" update- updcoord+\n";
    # Now, apply offset to all images
    push @fixwcs, "epar mscsetwcs\n";
    push @fixwcs, "mscsetwcs $line[0]c*.fits database=\"\"\n";

}

unlink <fixwcs.cl>; #remove old scripts first
open OUT, ">fixwcs.cl";
print OUT @fixwcs;
close OUT;

print fill("\t","",("Now enter IRAF and run 'fixwcs.cl':\n cl> cl <
fixwcs.cl\n "));
print "\n";



#######################

sub parse {
    my(@parsed);
    @parsed = split(/\s+/,$_[0]);
    chomp(@parsed);
    #remove whitespace at beginning of line, if any
    while ($parsed[0] eq "") {shift(@parsed)}
    return(@parsed);
}

##########################
# @array = PARSECOM($line)
# Parse by commas
# 08feb11  DSNR  created
##########################

sub parsecom {
    my(@parsed);
    @parsed = split(/,+/,$_[0]);
    chomp(@parsed);
    #remove whitespace at beginning of line, if any
    while ($parsed[0] eq "") {shift(@parsed)}
    return(@parsed);
}

sub log10 {
    my $n = shift;
    return log($n)/log(10);
}
