view release on metacpan or  search on metacpan

lib/Tk/AstroCatalog.pm  view on Meta::CPAN

use Astro::Catalog;
use Astro::Catalog::Item;
use Astro::Coords 0.12;
use Tk;
use Tk::FileSelect;

my $locateBug = 0;
my $BUSY = 0;
my @COLOR_LIST = (
    '#ffAAAA', '#00ff00', '#ff55ff', '#ffff00', '#00ffff',
    '#ff00ff', '#ffffff', '#ff5555', '#55ff55', '#55ffff', '#ffff55');
my $COLOR_INDEX = 0;

our $VERSION = '4.38';

# Kluge - this is the format of the catalog to be read
# Needs to be given as an option on the FileSelect widget.
our $FORMAT = 'JCMT';
our $FORMAT_OPT = {incplanets => 0};

=head1 PUBLIC METHODS

Methods available in this class:

=head2 Constructor

=over 4

=item new

Create a new Tk::AstroCatalog object.  A new catalog object will be
created.  Callbacks must be specified for -addCmd and -upDate; a
warning is issued for -onDestroy when it is missing.

    $cat = new Tk::AstroCatalog($MW,
        -addCmd => $addCmd,
        -upDate => $upDate,
        -onDestroy => $onDestroy);

Additionally a pre-existing Astro::Catalog object can be supplied
using the "-catalog" option.

    $cat = new Tk::AstroCatalog($MW,
        -addCmd => $addCmd,
        -upDate => $upDate
        -catalog => $cat);

The "-transient" option can be used if only a single value is required
from the widget. Default behaviour is for the widget to be
permanent. The "-transient" button does not have a "Done" button on
the screen (ie no button to close the window without a selection)

The "-addCmd" callback is triggered whenever a source is selected
from the widget. If the widget is transient the widget will be
closed after the first add is triggered.

The "-onDestroy" callback is triggered when the "Done" button is
pressed.

The "-upDate" method is triggered whenever the contents of the
catalog widget are refreshed/updated.

It makes more sense for this widget to work like Tk::FileSelect
when used in transient mode since we want to get the answer back
rather than enter an event loop.

The "-customColumns" method can be used to add additional columns
to the display.  This is an array of hashes specifying the
title, width and generator function for each column.  This generating
function will be called with an Astro::Catalog::Item and must
return a string of the given width.

    -customColumns => [{
        title     => 'Example',
        width     => 7,
        generator => sub {
            my $item = shift;
            return sprintf('%7s', 'test');
        }},
    ]

=cut

sub new {
    my $class = shift;
    croak "CatWin usage: Missing args \n" unless (@_);
    my $MW = shift;
    my %defaults = (
        -default => 'defaults',
        -transient => 0,
        @_);

    croak "Tk::AstroCatalog -addCmd option missing \n" unless exists $defaults{'-addCmd'};
    croak "Tk::AstroCatalog -upDate option missing \n" unless exists $defaults{'-upDate'};
    warn "Tk::AstroCatalog -onDestroy option missing \n" unless exists $defaults{'-onDestroy'};

    my $self = {};

    if (exists $defaults{'-catalog'}) {
        $self->{CatClass} = ref($defaults{'-catalog'});
        $self->{Catalog} = $defaults{'-catalog'};
    }
    else {
        # use default settings
        $self->{CatClass} = 'Astro::Catalog';
        $self->{Catalog} = $self->{CatClass}->new();
    }

    $self->{UpDate} = undef;
    $self->{Reset} = undef;
    $self->{AddCommand} = undef;
    $self->{Toplevel} = $MW->Toplevel;
    $self->{Selected} = [];
    $self->{Text} = undef;
    $self->{File} = 'default';
    $self->{Transient} = $defaults{'-transient'};
    $self->{RefLabel} = '';

    if (exists $defaults{'-customColumns'}) {
        # Store whole hash rather than just generator function
        # in case we want to add other ways of specifying custom columns.