#!/usr/bin/perl
#-------------------------------------------------------------------------------
#Purpose     : determine type of a frame, and in case of objects also which
#              object has been observed
#Author      : Robert Greimel (greimel@uvastro.phys.uvic.ca,greimel@ing.iac.es)
#Last Change : 21-Feb-2000
#-------------------------------------------------------------------------------
# recognizes : flat, bias, arc, object
########################################################################
require Astrometry;
use POSIX;
use Scripts;

#
# setup constants and default values
#
$deg2rad = atan2(1,1)*4/180;
$rad2deg = 1/$deg2rad;
$arc_type = "thar";
# load greek alphabet
@greek = &setup_constellations("greek");
# add common other spellings of greek characters
push @greek,("Mu","Nu");
# convert to lower case (for comparison)
for ($i=0;$i<=$#greek;$i++) {$greek[$i] =~ tr/A-Z/a-z/;}

# full (latin) names of constellations
@const_name = &setup_constellations("full name");
# convert to lower case (for comparison)
for ($i=0;$i<=$#const_name;$i++) {$const_name[$i] =~ tr/A-Z/a-z/;}

# abbreviations of constellations
@const_abbr = &setup_constellations("abbreviation");
# convert to lower case (for comparison)
for ($i=0;$i<=$#const_abbr;$i++) {$const_abbr[$i] =~ tr/A-Z/a-z/;}

##
# make sure directory ends with a "/"
##
$dir = $ARGV[0];
if ($dir !~ m|/$|) {$dir = $dir."/"};

##########
#read generation options
##########
%filenames=();
print "$0: reading filename configuration ... ";
&Scripts::read_filenames(\%filenames,"config.names");
print "done\n";

%options=();
print "$0: reading default options ... ";
( &Scripts::read_options(\%options,$filenames{"default_options"}) ) ? print "successful\n" : print "failed\n" ;

print "$0: reading directory specific options ... ";
( &Scripts::read_options(\%options,$dir.$filenames{"custom_options"}) ) ? print "successful\n" : print "failed\n" ;

if ($options{"directory"} eq "yes")
  {
  print "directory option is on\n";
  $dir_inout=$filenames{"dir_inout"}."/";
  }
else
  {
  print "directory option is off\n";
  $dir_inout="";
  }

#
# read information about stars
#
foreach $sfile ("stars.coo",$dir."addstars.coo")
  {
  if ( -e $sfile ) {&read_star ($sfile);}
  }
# convert to lower case (for comparison)
foreach $i (keys %star_name) {$star_name{$i} =~ tr/A-Z/a-z/;}

#
# read additional frame type information (if available)
#
%add_obstype = ();
%add_last = ();
if ( -e $dir."addframe.type" )
  {
  open ADD,$dir."addframe.type";
  while (<ADD>)
    {
    @add=split;
    $add_obstype{$add[0]} = $add[2];
    $add_last{$add[0]} = $add[-1];
    }
  close ADD;
  }

#####
# open output file
#####
open TYPE,">".$dir.$filenames{"type_file"};

#
# loop over all data files
#
open IN,$dir.$filenames{"header_info"};
while (<IN>)
  {
  chomp;
#END
  if ( /^END$/ )
    {
    $type=guess_type();
    print_info();
    $itime=-1;
    $obstype="";
    $object="";
    $ra=0;
    $dec=0;
    next;
    }
#filename
  if ( ! /=/ )
    {
    $file = $_;
    next;
    }
#integration time
  if (/^EXPTIME =/)
    {
    $tmp = (split "=",$_)[1];
    $tmp = (split "/",$tmp)[0];
    $tmp =~ s/ *//;
    $itime = $tmp;
    }
#observation type
  if (/^OBSTYPE =/)
    {
    $tmp = (split "=",$_)[1];
    $tmp = (split "/",$tmp)[0];
    $tmp =~ s/ *//;
    $tmp =~ s/ *$//;
    $obstype = $tmp;
    }
#object name
  if (/^OBJECT  =/)
    {
    $tmp = (split "=",$_)[1];
    $tmp = (split "/",$tmp)[0];
    $tmp =~ s/ *//;
    $tmp =~ s/ *$//;
    $object = $tmp;
    }
#ra
  if (/^RA      =/)
    {
    $tmp = (split "=",$_)[1];
    $tmp = (split "/",$tmp)[0];
    $tmp =~ s/ *//;
    $tmp =~ s/ *$//;
    $ra = $tmp;
    }
#dec
  if (/^DEC     =/)
    {
    $tmp = (split "=",$_)[1];
    $tmp = (split "/",$tmp)[0];
    $tmp =~ s/ *//;
    $tmp =~ s/ *$//;
    $dec = $tmp;
    }
  }
close IN;

exit;

################################################################################
#                            F U N C T I O N S
################################################################################
sub read_star()
  {
  (my $filename) = @_;
  open STARS,$filename;
  while (<STARS>)
    {
    next if (m/^#/);
    split;
    $star_ra{$_[0]}      = &Astrometry::RA2Deg( $_[1] ) ;
    $star_dec{$_[0]}     = &Astrometry::Dec2Deg( $_[2] );
    $star_cos_ra{$_[0]}  = POSIX::cos( $star_ra{$_[0]}*$deg2rad );
    $star_sin_ra{$_[0]}  = POSIX::sin( $star_ra{$_[0]}*$deg2rad );
    $star_cos_dec{$_[0]} = POSIX::cos( $star_dec{$_[0]}*$deg2rad );
    $star_sin_dec{$_[0]} = POSIX::sin( $star_dec{$_[0]}*$deg2rad );
    $star_name{$_[0]}=join " ",(splice @_,3);
    }
  close STARS;
  }

sub print_info()
  {
  if ( $type eq "unknown" || ( $type eq "object" && $real_object =~ /unknown$/ ) )
    {
    printf TYPE "%-21s: %-s # %s %s %s %s",$file,$type,$object,$ra,$dec,$real_object;
    }
  elsif ( $type eq "object" )
    {
    printf TYPE "%-21s: %-s # %s %s",$file,$type,$object,$real_object;
    }
  elsif ( $type eq "arc" )
    {
    printf TYPE "%-21s: %-s # %s %s",$file,$type,$object,$arc_type;
    }
  else
    {
    printf TYPE "%-21s: %-s # %s",$file,$type,$object;
    }
  printf TYPE "\n";
  }

#-----
# This function does the hard bit - finding out the type from the available
# header information.
#-----
sub guess_type()
  {
  #####
  # define search radius and default type
  #####
#  my $eps=0.08333333; # 5 arcmin
  my $eps=0.16666666; # 10 arcmin
  my $t="unknown";
  #####
  # check if type was specified in addframe.type
  #####
  if ( exists $add_obstype{$file} )
    {
    if ( $add_obstype{$file} =~ /^arc$|^bias$|^flat$|^object$/ )
      {
      $t = $add_obstype{$file};
      if ( $t eq "arc" ) {$arc_type=$add_last{$file};}
      if ( $t eq "object" ) {$real_object=$add_last{$file};}
      goto gt_return;
      }
    }
  #####
  # if exposure time is zero it has to be a bias frame
  #####
  if ( $itime == 0 ) {$t="bias";goto gt_return;}
  #####
  # next, use the observation type from the header if available
  #####
  if ( $obstype eq "flat") {$t="flat";goto gt_return;}
  if ( $obstype eq "comparison") {$t="arc";&guess_arc;goto gt_return;}
  if ( $obstype eq "object")
    {
    $real_object=$object;
    $t="object";
    }
  #####
  # however if the observation type is "object" (or still unknown),
  # check the actual header name string for determining the type.
  # start with the easy possibilities and then work your way through
  # the more obscure (and uncertain) choices.
  #####
  if ( $object =~ /[Bb][Ii][Aa][Ss]/ ) {$t="bias";goto gt_return;}
  if ( $object =~ /[Ff][Ll][Aa][Tt]/ ) {$t="flat";goto gt_return;}
  if ( $object =~ /[Ll][Aa][Mm][Pp]/ ) {$t="flat";goto gt_return;}
  if ( $object =~ /[Aa][Rr][Cc]/ ) {$t="arc";&guess_arc;goto gt_return;}
  if ( $t eq "unknown")
    {
    # check if object string matches arc string without arc
    my $save_arc_type=$arc_type;
    $arc_type="unknown";
    &guess_arc;
    if ($arc_type ne "unknown") {$t="arc";goto gt_return;}
    $arc_type=$save_arc_type;
    # now check for certain star names if no RA or DEC was found in the header
    if ( $ra == 0 && $dec == 0 )
      {
      $go=&guess_object;
      if ( $go ne "unknown")
        {
        $t = "object";
        $real_object = $go;
        goto gt_return;
        }
      }
    }
  #####
  # for objects and unknown find the closest match from the coordinate lists
  #####
  my $ra_deg = &Astrometry::RA2Deg( $ra );
  my $dec_deg= &Astrometry::Dec2Deg( $dec );
  my $ca1 = POSIX::cos( $ra_deg*$deg2rad );
  my $sa1 = POSIX::sin( $ra_deg*$deg2rad );
  my $cd1 = POSIX::cos( $dec_deg*$deg2rad );
  my $sd1 = POSIX::sin( $dec_deg*$deg2rad );
  my $d_min = 360;
  foreach my $star ( keys %star_ra )
    {
    my $ca2 = $star_cos_ra{$star};
    my $sa2 = $star_sin_ra{$star};
    my $cd2 = $star_cos_dec{$star};
    my $sd2 = $star_sin_dec{$star};
    $angle = ($ca1*$cd1*$ca2*$cd2 + $sa1*$cd1*$sa2*$cd2 + $sd1*$sd2);
    if (abs($angle) > 1)
      {
      #print join ";",($object,$angle,POSIX::acos($angle),"\n");
      $angle=$angle/abs($angle);
      }
    my $d_deg=POSIX::acos( $angle ) * $rad2deg;
    if ( $d_deg < $d_min ) {$d_min = $d_deg; $real_object = $star;}
#if ($d_deg < $eps) {print join " ",($star,$ra_deg,$dec_deg,$star_ra{$star},$star_dec{$star},$d_deg);print "\n";}
    }
  if ( $d_min < $eps ) {$t="object";}
  else {$real_object="($real_object=".(sprintf "%8.3f",$d_min).") unknown";}

gt_return:
  return $t;
  }

sub guess_arc()
  {
  my $name=$object;
#to lower case
  $name =~ tr/A-Z/a-z/;
#let's try if we find a two letter abbreviation
  $name =~ m/([a-z]{2})-([a-z]{2})/;
  (my $c1, my $c2) = sort ($1,$2);
  if ( $c1 eq "cd" && $c2 eq "ne" ) {$arc_type="cdne";return;}
  if ( $c1 eq "ar" && $c2 eq "fe" ) {$arc_type="fear";return;}
  if ( $c1 eq "ar" && $c2 eq "th" ) {$arc_type="thar";return;}
#ok, maybe without a dash ...
  if ( $name =~ m/cdne|necd/ ) {$arc_type="cdne";return;}
  if ( $name =~ m/fear|arfe/ ) {$arc_type="fear";return;}
  if ( $name =~ m/thar|arth/ ) {$arc_type="thar";return;}
  }

sub guess_object()
  {
  my $o="unknown";
  my $name=$object;
  #to lower case
  $name =~ tr/A-Z/a-z/;
  $name =~ s/'//g;

  #-1-first the easy check - is the full name recogniced'
  my $test = $name;
  $test =~ s/ //g;
  foreach $i (keys %star_name)
    {
    my $comp = $star_name{$i};
    $comp =~ s/ //g;
    if ( $test eq $comp ) {return $i;}
    }

  #-2-maybe we can find the short version
  foreach $i (keys %star_name)
    {
    my $comp = $i;
    if ( $test eq $comp ) {return $i;}
    }

  #-3-try to match constellation names or abbreviations and a greek letter
  @test=split " ",$name;
  if ($#test == 0) {goto back;}
  my $part1="";
  my $part2="";
  for ($i=0;$i<=$#greek;$i++)
    {
    if ( $test[0] eq $greek[$i] ) {$part1.="g".$i."|";}
    if ( $test[1] eq $greek[$i] ) {$part2.="g".$i."|";}
    }
  for ($i=0;$i<=$#greek;$i++)
    {
    if (length $greek[$i] <= 3) {next;}
    $comp = substr $greek[$i],0,3;
    if ( $test[0] eq $comp ) {$part1.="r".$i."|";}
    if ( $test[1] eq $comp ) {$part2.="r".$i."|";}
    }
  for ($i=0;$i<=$#const_name;$i++)
    {
    if ( $test[0] eq $const_name[$i] ) {$part1.="c".$i."|";}
    if ( $test[1] eq $const_name[$i] ) {$part2.="c".$i."|";}
    }
  for ($i=0;$i<=$#const_abbr;$i++)
    {
    if ( $test[0] eq $const_abbr[$i] ) {$part1.="a".$i."|";}
    if ( $test[1] eq $const_abbr[$i] ) {$part2.="a".$i."|";}
    }
  #phew - finally, we can start to make some decisions
  my @part1=split /\|/,$part1;
  my @part2=split /\|/,$part2;
  $part1="";
  $part2="";
  if ($#part1 == 0 && $#part2 == 0)
    {
    if ($part1[0] =~ /[gr]([0-9]*)/) {$part1=$1;}
    if ($part2[0] =~ /[gr]([0-9]*)/) {$part1=$1;}
    if ($part1[0] =~ /[ca]([0-9]*)/) {$part2=$1;}
    if ($part2[0] =~ /[ca]([0-9]*)/) {$part2=$1;}
    if ($part1 eq "" || $part2 eq "") {goto back;}
    my $sn=(substr $greek[$part1],0,3).$const_abbr[$part2];
#print "part1:",$part1,"\n";
#print "part2:",$part2,"\n";
#print "sn   :",$sn,"\n";
    if ( exists $star_name{$sn} )
      {
      return $sn;
      }
    }

#print "part1:",$part1,"\n";
#print "part2:",$part2,"\n";

  back:
  return "unknown";
  }

sub setup_constellations()
  {
  my $what=@_[0];
  if ($what eq "full name")
    {
    return (
           "Andromeda","Antlia","Apus","Aquarius","Aquila",
           "Ara","Aries","Auriga","Bootes","Caelum",
           "Camelopardus","Cancer","Canes venatici","Canis maior","Canis Minor",
           "Capricornus","Carina","Cassiopeia","Centaurus","Cepheus",
           "Cetus","Chamaeleon","Circinus","Columba","Coma Berenices",
           "Corona austrina","Corona borealis","Corvus","Crater","Crux",
           "Cygnus","Delphinus","Dorado","Draco","Equuleus",
           "Eridanus","Fornax","Gemini","Grus","Hercules",
           "Horologium","Hydra","Hydrus","Indus","Lacerta",
           "Leo","Leo minor","Lepus","Libra","Lupus",
           "Lynx","Lyra","Mensa","Microscopium","Monoceros",
           "Musca","Norma","Octans","Ophiuchus","Orion",
           "Pavo","Pegasus","Perseus","Phoenix","Pictor",
           "Pisces","Piscis austrinus","Puppis","Pyxis","Reticulum",
           "Sagitta","Sagittarius","Scorpius","Sculptor","Scutum",
           "Serpens","Sextans","Taurus","Telescopium","Triangukum australe",
           "Triangulum","Tucana","Ursa maior","Ursa minor","Vela",
           "Virgo","Volans","Vulpecula"
           );
    }
  if ($what eq "abbreviation")
    {
    return (
           "And","Ant","Aps","Aqr","Aql","Ara","Ari","Aur",
           "Boo","Cae","Cam","Cnc","CVn","CMa","CMi","Cap",
           "Car","Cas","Cen","Cep","Cet","Cha","Cir","Col",
           "Com","CrA","CrB","Crv","Crt","Cru","Cyg","Del",
           "Dor","Dra","Equ","Eri","For","Gem","Gru","Her",
           "Hor","Hya","Hyi","Ind","Lac","Leo","LMi","Lep",
           "Lib","Lup","Lyn","Lyr","Men","Mic","Mon","Mus",
           "Nor","Oct","Oph","Ori","Pav","Peg","Per","Phe",
           "Pic","Psc","PsA","Pup","Pyx","Ret","Sge","Sgr",
           "Sco","Scl","Sct","Ser","Sex","Tau","Tel","TrA",
           "Tri","Tuc","UMa","UMi","Vel","Vir","Vol","Vul"
           );
    }
  if ($what eq "greek")
    {
    return (
           "Alpha","Beta","Gamma","Delta","Epsilon","Zeta","Eta",
           "Theta","Iota","Kappa","Lambda","My","Ny","Xi","Omikron",
           "Pi","Rho","Sigma","Tau","Ypsilon","Phi","Chi","Psi","Omega"
           );
    }
  }