#!/usr/bin/perl

# Write IRAF scripts to bias-subtract and flatfield IMACS data.

# History
#  2008feb11  DSNR  created

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

#
# Detailed help message
#
@usage = ("v1.0  DSNR  12mar2008\n\nUsage: imacsbf (BIASES) (DATA/FLATS) [--help] [--bias] [--flats] [--steps] [--mask] [--verbose]\n\n");
@help = (
	 "---------------\n ",
	 "REQUIRED INPUTS\n ",
	 "---------------\n ",
	 "BIASES is a file containing the bias exposures, one per line.\n ",
	 "DATA/FLATS is a file containing the science exposures, one per line, followed on each line by a comma-separated list of the flatfield exposures pertaining to that science exposure.  The flatfields on each line are summed into a single, combined flat.  If the flatfields column is empty on any line, the program assumes that the flatfields are the same as for the previous exposure.\n ",
	 "------\n ",
	 "OUTPUT\n ",
 	 "------\n ",
	 "The output is an IRAF CL script named 'biasflat.cl'; run this file at the cl> prompt with the following syntax:\n cl> cl < biasflat.cl\n The IRAF script returns images prepended by a 'b' or an 'f' to signify which reduction steps have been performed.  The combined bias and flats reside in the files 'biasc1.fits', 'biasc2.fits', ... , 'flat1c1.fits', 'flat1c2.fits', ... , 'flat2c1.fits', etc. \n ",
	 "--------\n ",
	 "SWITCHES\n ",
	 "--------\n ",
	 "--bias: If this is turned on, the program assumes that the bias has already been prepared and combined.  The combined bias is assumed to reside in the files 'biasc1.fits', 'biasc2.fits', etc.\n ",
	 "--flats: If this is turned on, the program assumes that the flats have already been prepared and combined.  The appropriate processed flats should then be listed next to the science exposures to which they correspond, according to the instructions above.\n ",
	 "--steps: Instead of producing a single CL script, the program produces a script for each discrete reduction step (as 'bias1.cl', 'bias2.cl', ... , 'flat1.cl', etc.).  This allows the user to examine the data after each step.\n ",
	 "--mask: Apply a mask to block scattered light at 60-degrees from horizontal in chips 3 and 5\n",
	 "--verbose: Provide more informative output.\n",
	 "--help: Return this help file.\n ",
	 );

#
# Check command-line options
#
if ($#ARGV lt 1) {
    if ($#ARGV eq 0) {
	if ($ARGV[0] eq "--help") {
	    print @usage;
	    print fill("\t","",@help);
	    print "\n\n";
	    exit;
	}
    } else {
	die "@usage\For detailed help: imacsbf --help\n\n";
    }
}
$biasdone = '';
$flatsdone = '';
$steps = '';
$domask = '';
$verbose = '';
GetOptions ('bias' => \$biasdone,
	    'flats' => \$flatsdone,
	    'mask' => \$domask,
	    'verbose' => \$verbose,
	    'steps' => \$steps);

#
# Misc. variable definitions
#
$biasname="bias";

#
# Open input files
#
if ($biasdone ne '') {
    if (-e $ARGV[0]) {
	open OBJFL,$ARGV[0];
	@objfl = <OBJFL>;
	close OBJFL;
    } else {
	die "  Exiting: Can't find file $ARGV[0].\n";
    }
} else {
    if (-e $ARGV[0]) {
	open BIAS,$ARGV[0];
	@bias = <BIAS>;
	close BIAS;
	chomp @bias;
    } else {
	die "  Exiting: Can't find file $ARGV[0].\n";
    }
    if (-e $ARGV[1]) {
	open OBJFL,$ARGV[1];
	@objfl = <OBJFL>;
	close OBJFL;
    } else {
	die "  Exiting: Can't find file $ARGV[1].\n";
    }
}

#
# Initialize arrays to hold IRAF commands
#
@imtype=();
@xoscan=();
@bcomb=();
@bsub=();
@fcomb=();
@yoscan = ("noao\n",
	   "imred\n",
	   "ccdred\n",
	   "ccdproc.ccdtype=\"\"\n",
	   "ccdproc.overscan=yes\n",
	   "ccdproc.trim=yes\n",
	   "ccdproc.zerocor=no\n",
	   "ccdproc.flatcor=no\n",
	   "ccdproc.fixpix=no\n",
	   "ccdproc.darkcor=no\n",
	   "ccdproc.readaxis=\"column\"\n",
	   "ccdproc.biassec=\"[*,4097:4160]\"\n",
	   "ccdproc.trimsec=\"[1:2048,1:4096]\"\n",
	   "ccdproc.function=\"spline3\"\n",
	   "ccdproc.order=5\n",
	   "ccdproc.niterate=2\n"
	   );
@ffield = ("noao\n",
	   "imred\n",
	   "ccdred\n",
	   "ccdproc.ccdtype=\"\"\n",
	   "ccdproc.overscan=no\n",
	   "ccdproc.trim=no\n",
	   "ccdproc.zerocor=no\n",
	   "ccdproc.flatcor=yes\n",
	   "ccdproc.fixpix=no\n",
	   "ccdproc.darkcor=no\n"
	   );

#
# Get current time for file labelling
#
$now = time();
$nowp1 = $now+1;
$nowp2 = $now+2;
$tmp1 = "tmp$now.fits";
$tmp2 = "tmp$nowp1.fits";

#
# Populate science data and flatfield arrays/hashes
#
@obj=(); # science data only
@fl=(); # flats only
%flhash=(); # hash connecting combined flats with component exposures
%whichfl=(); # hash connecting data with proper flats
@fl1old=(); # flat array from previous science exposure
$i=0; # combined flat index
foreach (@objfl) {
    @line = parse($_);
    $obj1 = $line[0];
    if ($line[1] ne '') {
	@fl1 = parsecom($line[1]);
	@fl1old = @fl1;
    } elsif ($fl1old[0] eq '') {
	die "  Exiting: Failure to specify flats for first exposure.\n";
    } else {
	@fl1 = @fl1old;
    }
    # Connect science exposures with proper flats
    # Create new combined flats if necessary
    $oldflatkey='';
    foreach (keys %flhash ) {
	$are_equal=compare_arrays(\@{$flhash{$_}},\@fl1);
	if ($are_equal) {$oldflatkey=$_}
    }
    if ($oldflatkey ne '') {
	$whichfl{$obj1} = $oldflatkey;
    } else {
	if ($flatsdone eq '') {
	    $i++;
	    $newflat = "flat$i";
	} else {
	    if ($#fl1 ne 0) {die "  Exiting: More than 1 processed flat listed for science exposure $obj1.\n"}
	    $newflat = $fl1[0];
	}
	$flhash{$newflat} = [@fl1];
	$whichfl{$obj1} = $newflat;
    }
    # Populate arrays of data, flats, and all exposures
    push @obj, $obj1;
    for $i (0..$#fl1) {
	$oldflat=0;
	for $j (0..$#fl) {
	    if ($fl1[$i] eq $fl[$j]) {$oldflat=1}
	}
	unless ($oldflat) {
	    push @fl, $fl1[$i];
	}
    }
}

#
# Create processing commands for biases
#
if ($biasdone eq '') {
    foreach (@bias) {
	if (-e $_."c1.fits") {
	    for $i (1..8) {
		$img = $_."c$i.fits";
		$bimg = "b$img";
		push @imtype, "imcopy $img $bimg\n";
		push @imtype, "hedit $bimg imagetyp zero add+ ver-\n";
                if ($verbose ne '') {push @xoscan, "print \'Removing X-overscan from $bimg\'\n"}
		push @xoscan, "imrepl $bimg 65535 lower=65536\n";
		push @xoscan, "imrepl $bimg -65535 upper=-65536\n";
		push @xoscan, "imexpr \"mean(a,3)\" $tmp1 a=$bimg\[2049:2112,*\] intype=\"real\"\n";
		push @xoscan, "blkrep $tmp1 $tmp2 2048 1\n";
		push @xoscan, "imarith $bimg\[1:2048,*\] - $tmp2 $bimg\n";
		push @xoscan, "imdel $tmp1,$tmp2\n";
	    }
	} else {
	    die "  Exiting: Can't find file $_"."c1.fits.\n";
	}
    }
    for $i (1..8) {
	push @bcomb, "imcombine ";
	for $j (0..$#bias) {
	    $img = "$bias[$j]c$i.fits";
	    $bimg = "b$img";
	    push @bcomb, "$bimg";
	    if ($j != $#bias) {push @bcomb, ","}
	}
	push @bcomb, " $biasname"."c$i.fits comb=\"average\" reject=\"avsigclip\" scale- grow=2\n";
    }
}

#
# Create processing commands for flats
#
if ($flatsdone eq '') {
    foreach (@fl) {
	if (-e $_."c1.fits") {
	    for $i (1..8) {
		$img = $_."c$i.fits";
		$bimg = "b$img";
		push @imtype, "imcopy $img $bimg\n";
		push @imtype, "hedit $bimg imagetyp flat add+ ver-\n";
                if ($verbose ne '') {push @xoscan, "print \'Removing X-overscan from $bimg\'\n"}
		push @xoscan, "imrepl $bimg 65535 lower=65536\n";
		push @xoscan, "imrepl $bimg -65535 upper=-65536\n";
		push @xoscan, "imexpr \"mean(a,3)\" $tmp1 a=$bimg\[2049:2112,*\] intype=\"real\"\n";
		push @xoscan, "blkrep $tmp1 $tmp2 2048 1\n";
		push @xoscan, "imarith $bimg\[1:2048,*\] - $tmp2 $bimg\n";
		push @xoscan, "imdel $tmp1,$tmp2\n";
                if ($verbose ne '') {push @yoscan, "print \'Removing Y-overscan from $bimg\'\n"}
		push @yoscan, "ccdproc $bimg inter-\n";
                if ($verbose ne '') {push @bsub, "print \'Subtracting bias from $bimg\'\n"}
		push @bsub, "imarith $bimg - $biasname"."c$i.fits $bimg\n";
	    }
	} else {
	    die "  Exiting: Can't find file $_"."c1.fits.\n";
	}
    }
    foreach (keys %flhash) {
	if ($#{$flhash{$_}} gt 0) {
            if ($verbose ne '') {push @fcomb, "print \'Making average flat field.\'\n"}
	    for $i (1..8) {
		push @fcomb, "imcomb ";
		for $j (0..$#{$flhash{$_}}) {
		    $img = ${$flhash{$_}}[$j]."c$i.fits";
		    $bimg = "b$img";
		    push @fcomb,"$bimg";
		    if ($j ne $#{$flhash{$_}}) {push @fcomb,","}
		}
		push @fcomb, " $_"."c$i.fits comb=\"average\" reject=\"avsigclip\" scale=\"median\" statsec=\"\[10:109,3988:4087\]\" grow=2\n";
	    }
	} else {
	    for $i (1..8) {
		$img = ${$flhash{$_}}[0]."c$i.fits";
		$bimg = "b$img";
		push @fcomb, "imcopy $bimg $_"."c$i\n";
	    }
	}
	push @fcomb, "imstat $_"."c3\[10:109,3988:4087\] fields=\"midpt\" format- | scan (x)\n";
	for $i (1..8) {
	    push @fcomb, "hedit $_"."c$i.fits CCDMEAN (x) add+ ver-\n";
	    push @fcomb, "hedit $_"."c$i.fits CCDMEANT del+ ver-\n";
	}
    }
}


#
# Remove scattered light, if needed
#
if ($domask ne '') {

    @mask=();
    @maskfile=();

    ## Design mask ##
    for $j (0..504)    # Col nums
    {
	$xs=56+(8*$j);
	$xe=$xs+7;
	$xm=$xs+3;
	$ye=4500. - (0.56*$xm);
	
	$ys=$ye-850.;
	
	if ($ye>4039) {$ye=4039}
	push @maskfile, "$xs $xe $ys $ye\n";
    }
    ## Write MASK ##
    unlink <scltmask.txt>;
    open OUT, ">scltmask.txt";
    print OUT @maskfile;
    close OUT;
    
    ## Remove scattered light signature ##

    $maskmade=-1;
    foreach (keys %flhash) {
	if ($maskmade<0){
	    push @mask, "noao\nimred\nccdred\n";
	    push @mask, "badpiximage scltmask.txt $_"."c3 scltmask badvalue=1 goodvalue=0\n";
	    push @mask, "bye\nbye\nbye\n";
	    $maskmade=1;
	}
	if ($verbose ne '') {push @mask, "print \'Removing scattered light from $_ .\'\n"}	    
	push @mask, "fixpix $_"."c3.fits scltmask.fits verbose+ pixels- cinterp=1\n";
	push @mask, "fixpix $_"."c5.fits scltmask.fits verbose+ pixels- cinterp=1\n";
    }

}


#
# Create processing commands for science data
#
foreach (@obj) {
    if (-e $_."c1.fits") {
	for $i (1..8) {
	    $img = $_."c$i.fits";
	    $bimg = "b$img";
	    $fimg = "f$img";
	    push @imtype, "imcopy $img $bimg\n";
	    push @imtype, "hedit $bimg imagetyp object add+ ver-\n";
            if ($verbose ne '') {push @xoscan, "print \'Removing X-overscan from $bimg\'\n"}
	    push @xoscan, "imrepl $bimg 65535 lower=65536\n";
	    push @xoscan, "imrepl $bimg -65535 upper=-65536\n";
	    push @xoscan, "imexpr \"mean(a,3)\" $tmp1 a=$bimg\[2049:2112,*\] intype=\"real\"\n";
	    push @xoscan, "blkrep $tmp1 $tmp2 2048 1\n";
	    push @xoscan, "imarith $bimg\[1:2048,*\] - $tmp2 $bimg\n";
	    push @xoscan, "imdel $tmp1,$tmp2\n";
            if ($verbose ne '') {push @yoscan, "print \'Removing Y-overscan from $bimg\'\n"}
	    push @yoscan, "ccdproc $bimg inter-\n";
            if ($verbose ne '') {push @bsub, "print \'Subtracting bias from $bimg\'\n"}
	    push @bsub, "imarith $bimg - $biasname"."c$i.fits $bimg\n";
            if ($verbose ne '') {push @ffield, "print \'Dividing $bimg by flat field.\'\n"}
	    push @ffield, "ccdproc $bimg output=\"$fimg\" flat=\"$whichfl{$_}c$i\"\n";
	}
    } else {
	die "  Exiting: Can't find file $_"."c1.fits.\n";
    }
}

#
# Print to CL scripts
#
# 1 script
if ($steps eq '') {
    unlink <biasflat.cl>; # remove old scripts first
    open OUT, ">biasflat.cl";
    print OUT @imtype;
    print OUT @xoscan;
    print OUT @bcomb;
    print OUT @bsub;
    print OUT @yoscan;
    print OUT @fcomb;
    print OUT @mask;
    print OUT @ffield;
    close OUT;
#
    print fill("\t","",("Now enter IRAF and run 'biasflat.cl':\n cl> cl < biasflat.cl\n "));
    print "\n";
# multiple scripts, 1 for each step
} else {
    unlink <bias?.cl flat?.cl>; # remove old scripts first
    open OUT, ">bias1.cl";
    print OUT @imtype;
    close OUT;
    open OUT, ">bias2.cl";
    print OUT @xoscan;
    close OUT;
    if ($biasdone ne '') {
	open OUT, ">bias3.cl";
	print OUT @bsub;
	close OUT;
	open OUT, ">bias4.cl";
	print OUT @yoscan;
	close OUT;
    } else {
	open OUT, ">bias3.cl";
	print OUT @bcomb;
	close OUT;
	open OUT, ">bias4.cl";
	print OUT @bsub;
	close OUT;
	open OUT, ">bias5.cl";
	print OUT @yoscan;
	close OUT;
    }
    if ($flatsdone ne '') {
	open OUT, ">flat1.cl";
	print OUT @ffield;
	close OUT;
    } else {
	open OUT, ">flat1.cl";
	print OUT @fcomb;
	close OUT;
	open OUT, ">flat2.cl";
	print OUT @ffield;
	close OUT;
    }
#
    print fill("\t","",("Now enter IRAF and run each step:\n cl> cl < bias1.cl\n cl> cl < bias2.cl\n ...\n cl> cl < flat?.cl\n "));
    print "\n";
}

#######################
# @array = PARSE($line)
# Parse line of data into an array
# Assumes data separator is whitespace
# ??/??/02  DSR  created
# 09/04/02  DSR  changed "if" statement to "while"
# 08/04/03  DSR  removed $line variable
#######################

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);
}

##############################################
# $are_equal = COMPARE_ARRAYS(\@frogs,\@toads)
# Test whether two arrays are the same.
# Copied from http://perl.active-venture.com/pod/perlfaq4-dataarrays.html
# 08feb13  DSNR  copied
##############################################

sub compare_arrays {
    my ($first, $second) = @_;
    no warnings;  # silence spurious -w undef complaints
    return 0 unless @$first == @$second; # compare number of elements
    for (my $i = 0; $i < @$first; $i++) {
	return 0 if $first->[$i] ne $second->[$i];
    }
    return 1;
}
