File Coverage

blib/lib/App/SourcePlot/Source.pm

Criterion	Covered	Total	%
statement	155	308	50.3
branch	28	128	21.8
condition	6	12	50.0
subroutine	17	47	36.1
pod	24	38	63.1
total	230	533	43.1

package App::SourcePlot::Source;

=head1 NAME

App::SourcePlot::Source - creates a observation source

=head1 SYNOPSIS

 use App::SourcePlot::Source;
 $src = new App::SourcePlot::Source;

=head1 DESCRIPTION

This class will create Source objects that will hold essential
information for any single source.

It is essentially a wrapper around an Astro::Coords object to add
the additional information used to display a source in this
application.

=cut

use 5.004;
use Carp;
use strict;

use Astro::Coords;
use Math::Trig qw/pi/;
use DateTime;
use DateTime::Format::Strptime;

our $VERSION = '1.23';

my $locateBug = 0;

=head1 PUBLIC METHODS

These are the methods avaliable in this class:

=over 4

=item new

Create a new Source object.

  $obs = new App::SourcePlot::Source($planet);
  $obs = new App::SourcePlot::Source($name, $RA, $DEC, $Epoc);

Or using an Astro::Coords object.

  $coords = new Astro::Coords(...);
  $obs = new App::SourcePlot::Source($coords);

=cut

sub new {
  print "Creating a new observation Source object\n" if $locateBug;

  my $proto = shift;
  my $class = ref($proto) || $proto;

  my $self = {};  # Anon hash

  bless($self, $class);
  print "New observation Source object has been blessed: $self\n" if $locateBug;

  $self->configure(@_);

  $self->active(1);

  print "Object created\n" if $locateBug;

  return $self;
}


sub configure {
  my $self = shift;

  # Special case: empty source object.
  unless (@_) {
    $self->coords(new Astro::Coords());
    return;
  }

  my $name = shift;

  if (UNIVERSAL::isa($name, 'Astro::Coords')) {
    $self->coords($name);
  }
  elsif (@_) {
    print "Passed in paramaters are being entered\n" if $locateBug;
    my ($ra, $dec, $epoc, undef) = @_;

    # Prevent Astro::Coords guessing between radians and degrees.
    my $unit = ($ra =~ /:/ or $dec =~ /:/)
             ? 'sexagesimal'
             : 'degrees';

    if ($epoc eq 'RJ') {
      $self->coords(new Astro::Coords(
        name => $name,
        ra => ($unit eq 'degrees') ? ($ra * 15) : $ra,
        dec => $dec,
        type => 'J2000',
        units => $unit,
      ));
    }
    elsif ($epoc eq 'RB') {
      $self->coords(new Astro::Coords(
        name => $name,
        ra => ($unit eq 'degrees') ? ($ra * 15) : $ra,
        dec => $dec,
        type => 'B1950',
        units => $unit,
      ));
    }
    elsif ($epoc eq 'GA') {
      $self->coords(new Astro::Coords(
        name => $name,
        long => $ra,
        lat => $dec,
        type => 'galactic',
        units => $unit,
      ));
    }
    elsif ($epoc eq 'AZ') {
      $self->coords(new Astro::Coords(
        name => $name,
        az => $ra,
        el => $dec,
        units => $unit,
      ));
    }
    else {
      die "App::SourcePlot::Source unknown epoc " . $epoc .
           " for source " . $name;
    }
  }
  else {
    $self->coords(new Astro::Coords(
      planet => $name
    ));
  }
}

############################################################
#  Common data manipulation functions
#
=item name

returns and sets the name of the source

  $name = $obs->name();
  $obs->name('Mars');

=cut

sub name {
  my $self = shift;
  return $self->coords()->name(@_);
}

=item coords

Set or return the corresponding Astro::Coords object.

=cut

sub coords {
  my ($self, $coords, undef) = @_;
  if (defined $coords) {
    die unless UNIVERSAL::isa($coords, 'Astro::Coords');
    $self->{'COORDS'} = $coords;
  }
  return $self->{'COORDS'};
}

=item active

returns and sets whether the source is active

  $on = $obs->active();
  $obs->active(0);

=cut

sub active {
  my $self = shift;
  $self->{ACTIVE} = shift if @_;
  return $self->{ACTIVE} if defined $self->{ACTIVE};
  return '';
}

=item color

returns and sets the source color

  $col = $obs->color();
  $obs->color('black');

=cut

sub color {
  my $self = shift;
  $self->{COLOR} = shift if @_;
  return $self->{COLOR} if defined $self->{COLOR};
  return '';
}

=item lineWidth

returns and sets the sources thickness

  $LW = $obs->lineWidth();
  $obs->lineWidth(2);

=cut

sub lineWidth {
  my $self = shift;
  $self->{LINEWIDTH} = shift if @_;
  return $self->{LINEWIDTH} if defined $self->{LINEWIDTH};
  return 1;
}

=item index

returns and sets the sources window index

  $index = $obs->index();
  $obs->index(1234);

=cut

sub index {
  my $self = shift;
  $self->{INDEX} = shift if @_;
  return $self->{INDEX} if defined $self->{INDEX};
  return -1;
}

=item ra

Returns the RA of the source, or other coordinate type
in systems other than RJ / RB.

  $ra = $obs->ra();

=cut

sub ra {
  my $self = shift;
  if (@_) {
    die 'App::SourcePlot::Source cannot change ra';
  }
  my $native_method = $self->coords()->native();
  my ($ra, undef) = $self->coords()->$native_method();
  return sprintf('%.4f', $ra->degrees()) if $self->epoc() eq 'GA';
  return $ra->in_format('sexagesimal');
}

=item dec

Returns the declination of the source, or other coordinate
type in systems other than RJ / RB.

  $dec = $obs->dec();

=cut

sub dec {
  my $self = shift;
  if (@_) {
    die 'App::SourcePlot::Source cannot change dec';
  }
  my $native_method = $self->coords()->native();
  my (undef, $dec) = $self->coords()->$native_method();
  return sprintf('% .4f', $dec->degrees()) if $self->epoc() eq 'GA';
  return $dec->in_format('sexagesimal');
}

=item ra2000

returns the ra of the source in J2000 in radians

  $ra2000 = $obs->ra2000();

=cut

sub ra2000 {
  my $self = shift;
  if (@_) {
    die 'App::SourcePlot::Source cannot change ra2000';
  }
  return $self->coords()->ra(format => 'r');
}

=item dec2000

returns dec of the source in J2000 in radians

  $dec2000 = $obs->dec2000();

=cut

sub dec2000 {
  my $self = shift;
  if (@_) {
    die 'App::SourcePlot::Source cannot change dec';
  }
  return $self->coords()->dec(format => 'r');
}

=item epoc

returns the epoch of the source

  $epoc = $obs->epoc();

=cut

sub epoc {
  my $self = shift;
  my $native_method = $self->coords()->native;

  return 'RJ' if $native_method eq 'radec';
  return 'RB' if $native_method eq 'radec1950';
  return 'GA' if $native_method eq 'glonglat';
  return 'AZ' if $native_method eq 'azel';
  return '??';
}

=item elevation

returns the current elevation of the source at the ut time
in degrees

  $ele = $obs->elevation();

=cut

sub elevation {
  my $self = shift;
  if (@_) {
    die 'App::SourcePlot::Source cannot set elevation';
  }
  return $self->coords()->el(format => 'd');
}

=item is_blank

Returns true if the source information is "blank".  This is the
default state for an object constructed with no arguments,
and is represented by the Astro::Coords default type -- a
Calibration object.

=cut

sub is_blank {
    my $self = shift;

    return $self->coords()->type() eq 'CAL';
}

=item NameX

returns and sets the current x position of name label

  $x = $obs->NameX();
  $obs->NameX(6.5);

=cut

sub NameX {
  my $self = shift;
  $self->{NAMEX} = shift if @_;
  return $self->{NAMEX} if defined $self->{NAMEX};
  return '';
}

=item NameY

returns and sets the current y position of name label

  $y = $obs->NameY();
  $obs->NameY(6.5);

=cut

sub NameY {
  my $self = shift;
  $self->{NAMEY} = shift if @_;
  return $self->{NAMEY} if defined $self->{NAMEY};
  return '';
}

=item AzElOffsets

returns the amount in the current system to offset to draw the
Elevation and Azimuth axes

  ($elex, $eley, $azx, $azy) = $obs->AzElOffsets();
  $obs->AzElOffsets(.5, 4, .3, 2);

=cut

sub AzElOffsets {
  my $self = shift;
  if (@_) {
    $self->{ELEX} = shift;
    $self->{ELEY} = shift;
    $self->{AZX} = shift;
    $self->{AZY} = shift;
  }
  return ($self->{ELEX}, $self->{ELEY}, $self->{AZX}, $self->{AZY}) if defined $self->{ELEX};
  return (undef, undef, undef, undef);
}

=item timeDotX

returns and sets the current position of the time dot on
the x axis

  $x = $obs->timeDotX();
  $obs->timeDotX('15.122');

=cut

sub timeDotX {
  my $self = shift;
  $self->{TIMEDOTX} = shift if @_;
  return $self->{TIMEDOTX} if defined $self->{TIMEDOTX};
  return '';
}

=item timeDotY

returns and sets the current position of the time dot on
the y axis

  $y = $obs->timeDotY();
  $obs->timeDotY('15.122');

=cut

sub timeDotY {
  my $self = shift;
  $self->{TIMEDOTY} = shift if @_;
  return $self->{TIMEDOTY} if defined $self->{TIMEDOTY};
  return '';
}

=item time_ele_points

These functions return an array of comparative points for different
characteristics of this source.  The avaliable comparisons are:

  time_ele_points       - time vs elevation
  time_az_points       - time vs azimuth
  time_pa_points       - time vs parallactic angle
  ele_time_points       - elevation vs time
  ele_az_points       - elevation vs azimuth
  ele_pa_points       - elevation vs parallactic angle
  az_time_points       - azimuth vs time
  az_ele_points       - azimuth vs azimuth
  az_pa_points       - azimuth vs parallactic angle
  pa_time_points       - parallactic angle vs time
  pa_ele_points       - parallactic angle vs elevation
  pa_az_points       - parallactic angle vs azimuth

  Example syntax:

  @time_ele_points = $obs->time_ele_points();

=cut

sub time_ele_points {
  my $self = shift;
  return @{$self->{TIME_ELE_POINTS}} if defined $self->{TIME_ELE_POINTS};
  return ();
}

sub time_az_points {
  my $self = shift;
  return @{$self->{TIME_AZ_POINTS}} if defined $self->{TIME_AZ_POINTS};
  return ();
}

sub time_pa_points {
  my $self = shift;
  return @{$self->{TIME_PA_POINTS}} if defined $self->{TIME_PA_POINTS};
  return ();
}

sub ele_time_points {
  my $self = shift;
  return @{$self->{ELE_TIME_POINTS}} if defined $self->{ELE_TIME_POINTS};
  return ();
}

sub ele_az_points {
  my $self = shift;
  return @{$self->{ELE_AZ_POINTS}} if defined $self->{ELE_AZ_POINTS};
  return ();
}

sub ele_pa_points {
  my $self = shift;
  return @{$self->{ELE_PA_POINTS}} if defined $self->{ELE_PA_POINTS};
  return ();
}

sub az_time_points {
  my $self = shift;
  return @{$self->{AZ_TIME_POINTS}} if defined $self->{AZ_TIME_POINTS};
  return ();
}

sub az_ele_points {
  my $self = shift;
  return @{$self->{AZ_ELE_POINTS}} if defined $self->{AZ_ELE_POINTS};
  return ();
}

sub az_pa_points {
  my $self = shift;
  return @{$self->{AZ_PA_POINTS}} if defined $self->{AZ_PA_POINTS};
  return ();
}

sub pa_time_points {
  my $self = shift;
  return @{$self->{PA_TIME_POINTS}} if defined $self->{PA_TIME_POINTS};
  return ();
}

sub pa_ele_points {
  my $self = shift;
  return @{$self->{PA_ELE_POINTS}} if defined $self->{PA_ELE_POINTS};
  return ();
}

sub pa_az_points {
  my $self = shift;
  return @{$self->{PA_AZ_POINTS}} if defined $self->{PA_AZ_POINTS};
  return ();
}

############################################################
#  Some needed methods - not calculations but info gluers
#
=item dispLine

returns the line to display - presentation use

  $line = $obs->dispLine();

=cut

sub dispLine {
  my $self = shift;
  my $line;
  unless (UNIVERSAL::isa($self->coords(), 'Astro::Coords::Planet')) {
    $line = sprintf(' %-4d  %-16s  %-12s  %-13s  %-4s',
                   ($self->index() + 1), $self->name(),
                   $self->ra(), $self->dec(), $self->epoc());
  }
  else {
    $line = sprintf(' %-4d  %-16s  Planet',
                    ($self->index() + 1),
                    ucfirst($self->name()));
  }
  return $line;
}

=item copy

returns a copy of this object

  $cp = $obs->copy();

=cut

sub copy {
  my $self = shift;
  my $source = $self->new($self->coords());
  return $source;
}

=item calcPoints

Calculations the Elevation, Azimeth, etc. points
$MW is the main window widget.  Required for
progress bar

  $obs->calcPoints($date, $time, $num_points, $MW, $tel);

=cut

sub calcPoints {
  my $self = shift;
  my $DATE = shift;
  my $TIME = shift;
  my $numPoints = shift;
  my $MW = shift;
  my $tel = shift;
  my $timeBug = 0;

  my $coords = $self->coords();
  $coords->telescope($tel);
  my $dt_save = $coords->datetime();

  $DATE =~ s/\/$//;

  my $strp = new DateTime::Format::Strptime(
                 pattern => '%Y/%m/%d %H:%M:%S',
                 time_zone => 'UTC',
                 on_error => 'croak');

  my $dt = $strp->parse_datetime($DATE . ' ' .  $TIME);

  my $dt_running = $dt->clone();

  my $tlen = @{$self->{TIME_ELE_POINTS}} if defined $self->{TIME_ELE_POINTS};
  if (defined $tlen && $tlen > 0) {
    return;
  }

  $dt_running->subtract(hours => 2);
  my $lst_prev = undef;

  for (my $h = 0; $h < $numPoints; $h ++) {
    $MW->update;
    my ($lst, $ele, $az, $pa, undef) = $self->_calcPoint($dt_running);

    if (defined $lst_prev and $lst < $lst_prev) {
      $lst += 2 * pi;

      # Allow a second wrap around in case LST is just under 2 pi at the
      # start (eg on March 5th at JCMT with (default) 1:30:00 center time.
      # This is necessary because we generate points over a full day,
      # and then convert to LST so there is always one wrap-around, with
      # a potential for a second for certain date / location /center time
      # configurations!
      if ($lst < $lst_prev) {
          $lst += 2 * pi;
      }
    }
    $lst_prev = $lst;

    push (@{$self->{TIME_ELE_POINTS}}, $lst);
    push (@{$self->{TIME_ELE_POINTS}}, $ele);

    push (@{$self->{TIME_AZ_POINTS}}, $lst);
    push (@{$self->{TIME_AZ_POINTS}}, $az);

    push (@{$self->{TIME_PA_POINTS}}, $lst);
    push (@{$self->{TIME_PA_POINTS}}, $pa);

    push (@{$self->{ELE_TIME_POINTS}}, $ele);
    push (@{$self->{ELE_TIME_POINTS}}, $lst);

    push (@{$self->{ELE_AZ_POINTS}}, $ele);
    push (@{$self->{ELE_AZ_POINTS}}, $az);

    push (@{$self->{ELE_PA_POINTS}}, $ele);
    push (@{$self->{ELE_PA_POINTS}}, $pa);

    push (@{$self->{AZ_TIME_POINTS}}, $az);
    push (@{$self->{AZ_TIME_POINTS}}, $lst);

    push (@{$self->{AZ_ELE_POINTS}}, $az);
    push (@{$self->{AZ_ELE_POINTS}}, $ele);

    push (@{$self->{AZ_PA_POINTS}}, $az);
    push (@{$self->{AZ_PA_POINTS}}, $pa);

    push (@{$self->{PA_TIME_POINTS}}, $pa);
    push (@{$self->{PA_TIME_POINTS}}, $lst);

    push (@{$self->{PA_ELE_POINTS}}, $pa);
    push (@{$self->{PA_ELE_POINTS}}, $ele);

    push (@{$self->{PA_AZ_POINTS}}, $pa);
    push (@{$self->{PA_AZ_POINTS}}, $az);

    $dt_running->add(seconds => 24 * 3600 / ($numPoints - 1));
  }

  $coords->datetime($dt_save);
}

=item calcPoint

Returns the time in decimal, elevation, azimuth, and parallactic angle
for a given source at a particular time and date.

  ($lst, $ele, $az, $pa) = $obs->calcPoint($date, $time, $tel);

=cut

sub calcPoint {
  my $self = shift;
  my $DATE = shift;
  my $TIME = shift;
  my $tel = shift;

  $DATE =~ s/\/$//;

  my $strp = new DateTime::Format::Strptime(
                 pattern => '%Y/%m/%d %H:%M:%S',
                 time_zone => 'UTC',
                 on_error => 'croak');

  my $dt = $strp->parse_datetime($DATE . ' ' .  $TIME);

  $dt->add(hours => 10);

  return $self->_calcPoint($dt, $tel);
}

sub _calcPoint {
  my $self = shift;
  my $dt = shift;
  my $tel = shift;

  my $coords = $self->coords();
  $coords->datetime($dt) if defined $dt;
  $coords->telescope($tel) if defined $tel;

  my $pa = $coords->pa(format => 'r');
  my ($elex, $eley) = _axis_direction($pa, 0, 30);
  my ($azx, $azy) = _axis_direction($pa, 30, 0);

  return ($coords->_lst()->radians(),
          $coords->el(format => 'd'),
          $coords->az(format => 'd'),
          $coords->pa(format => 'd'),
          $elex, $eley, $azx, $azy);
}

# Based on the AzToRa function from the old
# Astro::Instrument::SCUBA::Array module
# by Casey Best (University of Victoria).
sub _axis_direction {
  my $pa = shift;
  my $daz = shift;
  my $del = shift;

  my $x = -$daz * cos($pa) + $del * sin($pa);
  my $y = $daz * sin($pa) + $del * cos($pa);
  return ($x, $y);
}


=item erasePoints

Erases all of the plotting points.  Needed when new coords put in.

  $obs->erasePoints();

=cut

sub erasePoints {
  my $self = shift;
  $self->{TIME_ELE_POINTS} = ();
  $self->{TIME_AZ_POINTS} = ();
  $self->{TIME_PA_POINTS} = ();
  $self->{ELE_TIME_POINTS} = ();
  $self->{ELE_AZ_POINTS} = ();
  $self->{ELE_PA_POINTS} = ();
  $self->{AZ_TIME_POINTS} = ();
  $self->{AZ_ELE_POINTS} = ();
  $self->{AZ_PA_POINTS} = ();
  $self->{PA_TIME_POINTS} = ();
  $self->{PA_ELE_POINTS} = ();
  $self->{PA_AZ_POINTS} = ();
  $self->{TIMEDOTX} = undef;
  $self->{TIMEDOTY} = undef;
}

=item eraseTimeDot

Erases the time dot coordinates

  $obs->eraseTimeDot();

=cut

sub eraseTimeDot {
  my $self = shift;
  $self->{TIMEDOTX} = undef;
  $self->{TIMEDOTY} = undef;
}

=back

=head1 AUTHOR

Casey Best

=head1 COPYRIGHT

Copyright (C) 2012-2014 Science and Technology Facilities Council.
Copyright (C) 1998, 1999 Particle Physics and Astronomy Research
Council. All Rights Reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program. If not, see .

=cut

1;