view release on metacpan or  search on metacpan

lib/App/SourcePlot/Source.pm  view on Meta::CPAN

package App::SourcePlot::Source;

=head1 NAME

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

=head1 SYNOPSIS

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

=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.32';

my $locateBug = 0;

=head1 METHODS

=head2 Constructor

=over 4

=item new

Create a new Source object.

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

Or using an Astro::Coords object.

    $coords = Astro::Coords->new(...);
    $obs = App::SourcePlot::Source->new($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(Astro::Coords->new());
        return;
    }

    my $name = shift;

    if (UNIVERSAL::isa($name, 'Astro::Coords')) {
        $self->coords($name);
    }

lib/App/SourcePlot/Source.pm  view on Meta::CPAN

    $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();

    my $strp = DateTime::Format::Strptime->new(
        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;

    my $strp = DateTime::Format::Strptime->new(
        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;

    # PAL (and so Astro::Coords) can not handle seconds > 59 (used in the case
    # of leap seconds), so replace with 59 seconds when this happens.
    $dt->set_second(59) if $dt->second() > 59;

    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 {