DateTime results from the CPAN

DateTime

App-SourcePlot

view release on metacpan or search on metacpan

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

package App::SourcePlot;

=head1 NAME

App::SourcePlot - Implements Souce Plot application

=head1 SYNOPSIS

    use App::SourcePlot;
    App::SourcePlot::run_sourceplot_gui();

=head1 DESCRIPTION

This module contains the implementation of the Source Plot application,
which can be launched using the L<sourceplot> command.

Source Plot is a simple astronomical source plotter designed to
display a plot of astronomical sources on adjustable axes.

=cut

use strict;
#use warnings;

our $VERSION = '1.32';

use Config::IniFiles;
use Tk;
use Tk::Balloon;
use Tk::FileSelect;
use App::SourcePlot::Plotter::Tk;
use DateTime;
use DateTime::Format::Strptime;
use App::SourcePlot::Source;
use File::HomeDir;
use File::ShareDir qw/dist_file/;
use File::Spec;
use Tk::AstroCatalog;
use Astro::PAL;
use Astro::Telescope;
use Math::Trig;
use Astro::Coords::Planet 0.05;

#global variables that will be used....

my $locateBug = 0;

my $MW;
my $TIME;
my @SOURCE_LIST = ();
my @planets = map {ucfirst($_)} Astro::Coords::Planet::planets();

my $CATALOG_OPEN;
my $EDIT_OPEN;

my $LAST_COMMAND;
my @UNDO_LIST;
my $undoBut;
my $cBut;
my $TimeLap = 30000;    # time between white dot updates
my $dotSizeX = 4;
my $dotSizeY = 4;

my @axes = (
    'Time',
    'Elevation',
    'Air Mass',
    'Azimuth',
    'Parallactic Angle',
);

my %defaults = (
    TEL => 'JCMT',
    XAXIS => 'Time',
    YAXIS => 'Elevation',
    TIME => '1:30:00'
);

my $plotter;
my $TEL;
my $X_AXIS;
my $Y_AXIS;
my $DATE;
my $telObject;
my ($minX, $minY);
my ($maxX, $maxY);
my $TELPOSN = undef;

my $NUM_POINTS = 97;
my $BUSY = 0;

my $TIMER;
my @COLOR_LIST = qw/#ffaaaa #00ff00 #ff55ff #ffff00 #00ffff #ff00ff #ffffff #ff5555 #55ff55 #55ffff #ffff55/;

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

    my @temp;
    my $flag = 0;

    for (my $index = 0; $index < $len; $index ++) {
        if ($element->coords()->summary() eq $$array[$index]->coords()->summary()) {
            $flag = -1;
        }
        else {
            $temp[$index + $flag] = $$array[$index];
        }
    }

    @$array = @temp;
}

=item B<update_status>

Invokes the update method of the main window.

=cut

sub update_status {
    $MW->update;
}

=item B<changeDate>

Changes the date to a new date.

=cut

sub changeDate {
    $dateBut->configure(-state => 'disabled');

    my @months = qw/
        January February March April May June July August
        September October November December/;

    my $name;

    my $Top = $MW->Toplevel;
    $Top->title('Source Plot UT Date');
    $Top->resizable(0, 0);
    my $topFrame = $Top->Frame(
        -relief => 'groove',
        -borderwidth => 2,
    )->pack(-padx => 10, -pady => 10);

    # create the day entry
    $topFrame->Label(-text => "Day:")->grid(-column => 0, -row => 0);
    my $dayEnt = $topFrame->Entry(
        -relief => 'sunken',
        -width => 10,
    )->grid(-column => 1, -row => 0, -padx => 10, -pady => 5);

    # create the month menu button
    $topFrame->Label(
        -text => "Month:",
    )->grid(-column => 0, -row => 1, -padx => 5, -pady => 5);

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

    my $dt = $strp->parse_datetime($DATE);
    my $monthEnt = $months[$dt->month() - 1];

    my $mb = $topFrame->Menubutton(
        -text => $monthEnt,
        -relief => 'raised',
        -width => 10);

    foreach $name (@months) {
        $mb->command(
            -label => $name,
            -command => sub {
                $mb->configure(-text => $name);
                $monthEnt = $name;
            },
        );
    }
    $mb->grid(-column => 1, -row => 1, -padx => 10, -pady => 5, -sticky => 'w');

    # create the year entry
    $topFrame->Label(
        -text => 'Year:',
    )->grid(-column => 0, -row => 2, -padx => 5, -pady => 5);

    my $yearEnt = $topFrame->Entry(
        -relief => 'sunken',
        -width => 10,
    )->grid(-column => 1, -row => 2, -padx => 10, -pady => 5);
    $yearEnt->bind('<KeyPress-Return>' => sub {
        my $strp = DateTime::Format::Strptime->new(
            pattern => '%Y %B %d',
            on_error => 'croak');

        my $dt = $strp->parse_datetime(
            $monthEnt
            . ' ' . $dayEnt->get()
            . ' ' . $yearEnt->get());

        $DATE = $dt->strftime('%Y/%m/%d');

        destroy $Top;
    });

    # create the update subroutine
    my $complete = sub {
        my $strp = DateTime::Format::Strptime->new(
            pattern => '%B %d %Y',
            on_error => 'croak');

        my $dt = $strp->parse_datetime(
            $monthEnt
            . ' ' . $dayEnt->get()
            . ' ' . $yearEnt->get());

        $DATE = $dt->strftime('%Y/%m/%d');

        foreach my $source (@SOURCE_LIST) {
            $source->erasePoints();
        }

        plot();
    };

    # create the apply button
    my $F = $Top->Frame->pack();
    my $buttonF = $F->Frame->pack(-side => 'left', -padx => 5, -pady => 10);
    my $okBut = $buttonF->Button(
        -text => 'Apply',
        -command => $complete,
    )->pack(-side => 'left');
    $okBut->bind('<KeyPress-Return>' => $complete);

    # create the accept button
    $buttonF = $F->Frame->pack(-side => 'right', -padx => 5, -pady => 10);
    my $okBut = $buttonF->Button(
        -text => 'Accept',
        -command => sub {
            &$complete;
            destroy $Top;
        },
    )->pack(-side => 'right');
    $okBut->bind('<KeyPress-Return>' => sub {
        &$complete;
        destroy $Top;
    });

    # create the cancel button
    my $canBut = $buttonF->Button(
        -text => 'Cancel',
        -command => sub {
            destroy $Top;
        },
    )->pack(-side => 'right');
    $canBut->bind('<KeyPress-Return>' => sub {
        destroy $Top;
    });

    # Closing the window should reset $dateBut.
    $Top->bind('<Destroy>', sub {
        my $widget = shift;
        return unless $widget == $Top;
        $dateBut->configure(-state => 'normal');
    });

    $dayEnt->insert(0, $dt->day());
    $yearEnt->insert(0, $dt->year());

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

                            }
                            $T->tag(
                                'configure',
                                'd' . $source->index(),
                                -foreground => 'blue',
                            );
                        }
                        @$selected = ();
                        if ($EDIT_OPEN) {
                            fillWithSourceList($EditWin, 'full');
                        }
                        plot();
                        $BUSY = 0;
                    },
                );
            }
        }
    }

    $T->mark('set', insert => '1.0');

    # Disable access to infobox
    $T->configure(-state => 'disabled');
}

=item B<plot>

Plots the graphs, including axis.

=cut

sub plot {
    print "Entered plot\n" if $locateBug;
    my $xplot = $plotter->width;
    my $yplot = $plotter->height;
    $plotter->usingWorld(0);
    $plotter->worldCenter($xborder, $yplot - $yborder);
    $plotter->usingWorld(1);
    my ($xworldRatio, $yworldRatio);
    my $debug = 0;
    $TIME =~ s/^\s+//;
    $TIME =~ s/\s+$//;
    $TIME =~ s/\s+/:/g;
    my ($timeH, $min, $sec) = split /:/, $TIME, 3;
    my $XSpaceForTime = 0;
    my $YSpaceForTime = 0;
    my $special = 0;
    my $lstDiffX;
    my $lstDiffY;

    $XSpaceForTime = $xborder if $Y_AXIS =~ /time/i;
    $YSpaceForTime = $yborder if $X_AXIS =~ /time/i;
    $timeH += $min / 60 + $sec / 3600;

    #clear the plot
    $plotter->clean();

    # calc the world coords
    print "    Calculating the world coordinate system\n" if $locateBug;
    if ($X_AXIS =~ /time/i) {
        my $strp = DateTime::Format::Strptime->new(
            pattern => '%Y/%m/%d %H:%M:%S',
            on_error => 'croak');

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

        $dt->subtract(hours => 2);

        my ($lst, $mjd) = ut2lst(
            $dt->year(), $dt->month(), $dt->day(),
            $dt->hour(), $dt->minute(), $dt->second(),
            $telObject->long_by_rad());

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

        my ($lst2, $mjd2) = ut2lst(
            $dt->year(), $dt->month(), $dt->day(),
            $dt->hour(), $dt->minute(), $dt->second(),
            $telObject->long_by_rad());

        if ($lst2 < $lst) {
            $lst2 += 2 * pi;
        }

        $lstDiffX = $lst2 - $lst;
        $xworldRatio = (24 * $lstDiffX) / ($xplot - $xborder * 2 - $XSpaceForTime);
        $minX = $lst;
        $maxX = $lst + 24 * $lstDiffX;
        print "x-axis is time\n" if $debug;
    }
    elsif ($X_AXIS =~ /air mass/i) {
        $xworldRatio = 90 / ($xplot - $xborder * 2 - $XSpaceForTime);
        $minX = 0;
        $maxX = 90;
        print "x-axis is ele\n" if $debug;
    }
    elsif ($X_AXIS =~ /elevation/i) {
        $xworldRatio = 90 / ($xplot - $xborder * 2 - $XSpaceForTime);
        $minX = 0;
        $maxX = 90;
        print "x-axis is ele\n" if $debug;
    }
    elsif ($X_AXIS =~ /azimuth/i) {
        $xworldRatio = 360 / ($xplot - $xborder * 2 - $XSpaceForTime);
        $minX = 0;
        $maxX = 360;
        print "x-axis is pa\n" if $debug;
    }
    elsif ($X_AXIS =~ /parallactic angle/i) {
        $xworldRatio = 360 / ($xplot - $xborder * 2 - $XSpaceForTime);
        $minX = -180;
        $maxX = 180;
        print "x-axis is az\n" if $debug;
    }
    else {
        print "ERROR:  X axis undefined!!\n\n";
        $minX = 0;
        $maxX = 0;
    }
    if ($Y_AXIS =~ /time/i) {
        my $strp = DateTime::Format::Strptime->new(
            pattern => '%Y/%m/%d %H:%M:%S',
            on_error => 'croak');

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

        $dt->subtract(hours => 2);

        my ($lst, $mjd) = ut2lst(
            $dt->year(), $dt->month(), $dt->day(),
            $dt->hour(), $dt->minute(), $dt->second(),
            $telObject->long_by_rad());

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

        my ($lst2, $mjd2) = ut2lst(
            $dt->year(), $dt->month(), $dt->day(),
            $dt->hour(), $dt->minute(), $dt->second(),
            $telObject->long_by_rad());

        if ($lst2 < $lst) {
            $lst2 += 2 * pi;
        }

        $lstDiffY = $lst2 - $lst;
        $yworldRatio = (-24 * $lstDiffY) / ($yplot - $yborder * 2 - $YSpaceForTime);
        $maxY = $lst + 24 * $lstDiffY;
        $minY = $lst;
        print "y-axis is time\n" if $debug;
    }
    elsif ($Y_AXIS =~ /air mass/i) {
        $yworldRatio = -90 / ($yplot - $yborder * 2 - $YSpaceForTime);
        $maxY = 90;
        $minY = 0;
        print "y-axis is ele\n" if $debug;
    }
    elsif ($Y_AXIS =~ /elevation/i) {
        $yworldRatio = -90 / ($yplot - $yborder * 2 - $YSpaceForTime);
        $maxY = 90;
        $minY = 0;
        print "y-axis is ele\n" if $debug;
    }
    elsif ($Y_AXIS =~ /azimuth/i) {
        $yworldRatio = -360 / ($yplot - $yborder * 2 - $YSpaceForTime);
        $minY = 0;
        $maxY = 360;
        print "y-axis is az\n" if $debug;
    }
    elsif ($Y_AXIS =~ /parallactic angle/i) {
        $yworldRatio = -360 / ($yplot - $yborder * 2 - $YSpaceForTime);
        $minY = -180;
        $maxY = 180;
        print "y-axis is pa\n" if $debug;
    }
    else {
        print "ERROR:  Y axis undefined!!\n\n";
        $minY = 0;
        $maxY = 0;
    }
    if ((($Y_AXIS =~ /azimuth/i) && ($X_AXIS =~ /elevation/i))
            || (($X_AXIS =~ /azimuth/i) && ($Y_AXIS =~ /elevation/i))

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


=cut

sub getColor {
    my $color = $COLOR_LIST[$COLOR_INDEX];
    my $len = @COLOR_LIST;
    $COLOR_INDEX ++;
    $COLOR_INDEX = $COLOR_INDEX % $len;
    return $color;
}

=item B<calcTime>

Draws a dot at the current time on each source.

=cut

sub calcTime {
    $TIMER->cancel if defined $TIMER;
    my $so = shift;

    my ($sources, $telsource);
    if (defined $so) {
        if (ref $so) {
            $sources = [[$so, 'drawFillOval', 1]];
        }
        elsif ('TelescopePosition' eq $so) {
            $sources = [];
            $telsource = $TELPOSN->get_position() if defined $TELPOSN;
        }
        else {
            die 'Unexpected source parameter';
        }
    }
    else {
        $sources = [map {[$_, 'drawFillOval', 1]} @SOURCE_LIST];
        $telsource = $TELPOSN->get_position() if defined $TELPOSN;
    }

    if (defined $telsource) {
        $telsource->color('#ffffff');
        push @$sources, [$telsource, 'drawOval', 3];
    }

    my $timeBug = 0;
    my ($ss, $mm, $hh, $md, $mo, $yr, $wd, $yd, $isdst) = gmtime(time);
    $mo ++;  # this catches the month up to the current date
    $mo = '0' . $mo if length($mo) < 2;
    $md = '0' . $md if length($md) < 2;
    $mm = '0' . $mm if length($mm) < 2;
    $ss = '0' . $ss if length($ss) < 2;
    $yr += 1900;
    my ($sety, $setm, $setd) = split(/\//, $DATE);

    if ((! $yr =~ /$sety/) || $setm != $mo || $setd != $md) {
        return;
    }
    print "The gm time is $hh:$mm:$ss and date is $yr\/$mo\/$md\n" if $timeBug;

    #calculate the local time
    my $strp = DateTime::Format::Strptime->new(
        pattern => '%Y/%m/%d %H:%M:%S',
        on_error => 'croak');

    my $dt = $strp->parse_datetime("$yr\/$mo\/$md $hh:$mm:$ss");

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

    my $t = $dt->strftime('%H:%M:%S');
    my $d = $dt->strftime('%Y/%m/%d');

    $plotter->drawColor('white');
    foreach my $sourceinfo (@$sources) {
        my ($source, $plotstyle, $radiusscale) = @$sourceinfo;
        next unless $source->active();

        $plotter->delete('timeDot' . $source->name());

        print "Real time = $TIME and real date = $DATE\n" if $timeBug;
        print "Date = $d and time = $t before calcpoint\n" if $timeBug;
        my ($lst, $ele, $az, $pa, $elex, $eley, $azx, $azy) = $source->calcPoint($d, $t, $telObject);

        if ($lst < $minX) {
            $lst += 2 * pi;
        }
        elsif ($lst > $maxX) {
            $lst -= 2 * pi;
        }

        my ($x, $y);

        if ($X_AXIS =~ /time/i) {
            $x = $lst;
        }
        elsif (($X_AXIS =~ /elevation/i) || ($X_AXIS =~ /air mass/i)) {
            $x = $ele;
        }
        elsif ($X_AXIS =~ /azimuth/i) {
            $x = $az;
        }
        elsif ($X_AXIS =~ /parallactic angle/i) {
            $x = $pa;
        }

        if ($Y_AXIS =~ /time/i) {
            $y = $lst;
        }
        elsif (($Y_AXIS =~ /elevation/i) || ($Y_AXIS =~ /air mass/i)) {
            $y = $ele;
        }
        elsif ($Y_AXIS =~ /azimuth/i) {
            $y = $az;
        }
        elsif ($Y_AXIS =~ /parallactic angle/i) {
            $y = $pa;
        }

        if ((($Y_AXIS =~ /azimuth/i) && ($X_AXIS =~ /elevation/i))
                || (($X_AXIS =~ /azimuth/i) && ($Y_AXIS =~ /elevation/i))
                || (($Y_AXIS =~ /azimuth/i) && ($X_AXIS =~ /air mass/i))
                || (($Y_AXIS =~ /air mass/i) && ($X_AXIS =~ /azimuth/i))) {

( run in 0.307 second using v1.01-cache-2.11-cpan-e93a5daba3e )