view release on metacpan or  search on metacpan

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

    $Top->gridColumnconfigure(0, -weight => 1);

    print "made it past all the buttons and just about to fill...\n" if $locateBug;
    # if we do not have a catalog yet create one
    unless ($self->Catalog) {
        $self->file($catEnt->get);
        $self->Catalog($self->CatClass->new(
            File => $self->file,
            Format => $FORMAT,
            ReadOpt => $FORMAT_OPT,
        ));
    }
    $self->fillWithSourceList('full');

    return $self;
}

=item destroy

Remove the widget from display. Leaves calling the
Reset handler to the DESTROY method.

=cut

sub destroy {
    my $self = shift;
    my $Top = $self->Toplevel;
    $Top->destroy() if defined $Top && Exists($Top);
}

=item DESTROY

Object destructor. Triggers when the object is destroyed.
Guarantees to destroy the Toplevel widget and does trigger
the onDestroy callback.

=cut

sub DESTROY {
    my $self = shift;
    my $callback = $self->Reset;
    $callback->() if defined $callback;
    my $Top = $self->Toplevel;
    $Top->destroy() if defined $Top && Exists($Top);
}

=item fillWithSourceList

Fills a text widget with the list of current sources

    $cat->fillWithSourceList();
    $cat->fillWithSourceList($text, $selected, $task, $index);
    $cat->fillWithSourceList($text, $selected, $task);
    $cat->fillWithSourceList($text, $selected);

Also triggers the UpDate method.

=cut

sub fillWithSourceList {
    my (@bold, @normal);
    my $self = shift;
    my $T = $self->Text;
    my $selected = $self->Selected;
    my $task = shift;
    my $index = shift;
    my @entered = ();
    my ($line, $itag);

    # Retrieve the objects
    # forcing the reference time
    $self->Catalog->force_ref_time;
    my @stars = $self->Catalog->stars;
    my @sources = map {$_->coords} @stars;

    # Enable infobox for access
    $T->configure(-state => 'normal');

    # Clear the existing widgets
    if (defined $task && $task eq 'full') {
        $T->delete('1.0', 'end');
        foreach my $source (@sources) {
            # KLUGE source does not have index attribute
            if (exists $source->{index} && defined $source->{index}) {
                $T->tagDelete('d' . $source->{index});
            }
        }

        # And clear the current selection
        @$selected = ();
    }

    # Set up display styles
    if ($T->depth > 1) {
        @bold   = (-background => "#eeeeee", -relief => 'raised', -borderwidth => 1);
        @normal = (-background => undef, -relief => 'flat');
    }
    else {
        @bold   = (-foreground => 'white', -background => 'black');
        @normal = (-foreground => undef, -background => undef);
    }
    $T->tag(qw/configure normal -foreground blue/);
    $T->tag(qw/configure inactive -foreground black/);
    $T->tag(qw/configure selected -foreground red/);
    foreach (@COLOR_LIST) {
        $T->tag('configure', $_, -foreground => $_);
    }

    # Get a reference coordinate from the object
    my $ref = $self->Catalog->reference;

    # write the label
    if ($ref) {
        my ($az, $el) = $ref->azel();
        my $summary = sprintf("%-15s Az: %3.0f  El: %3.0f",
            $ref->name, $az->degrees, $el->degrees);
        $self->RefLabel("Reference position: $summary");
    }
    else {
        # blank it
        $self->RefLabel('');
    }

    # Insert the current values
    if (defined $task && $task eq 'full') {
        my $len = @sources;
        for ($index = 0; $index < $len; $index ++) {
            my $source = $sources[$index];
            # KLUGE source does not have index attribute
            $source->{index} = $index;
            # KLUGE - source summary should add az, el and we should
            # add distance
            my $distance = " --- ";
            if ($ref) {
                my $d = $ref->distance($source);
                if (defined $d) {
                    $distance = sprintf("%5.0f", $d->degrees);
                }
                else {
                    $distance = "  Inf";
                }
            }
            my $custom = '';
            if ($self->{'CustomColumns'}) {
                $custom = join(' ', map {$_->{'generator'}->($stars[$index])}
                        @{$self->{'CustomColumns'}}) . ' ';
            }
            $line = sprintf("%-4d  %s %3.0f %3.0f %s %s%s",
                $index,
                $source->summary(),
                $source->az(format=>'d'),
                $source->el(format=>'d'),
                $distance,
                $custom,
                $source->comment
            );
            if ($self->isWithin ($source, @$selected)) {
                $self->inswt("$line\n","d$index",'selected');
            }
            else {
                # KLUGE - source does not really have active or color attributes
                # KLUGE2 - "active" is never set!
                if ($source->{active}) {
                    if ($source->{color} ne '') {
                        $self->inswt("$line\n", "d$index", $source->{color});
                    }
                    else {
                        $self->inswt("$line\n", "d$index", 'normal');
                    }
                }
                else {
                    $self->inswt("$line\n", "d$index", 'inactive');
                }
            }
        }

        $len = @sources;
        for ($itag = 0; $itag < $len; $itag ++) {
            my $dtag = "d$itag";
            $T->tag('bind', $dtag, '<Any-Enter>' => sub {
                shift->tag('configure', $dtag, @bold);
            });
            $T->tag('bind', $dtag, '<Any-Leave>' => sub {
                shift->tag('configure', $dtag, @normal);
            });
            $T->tag('bind', $dtag, '<ButtonRelease-1>' => sub {
                unless ($BUSY) {
                    unless ($self->isWithin($sources[substr($dtag, 1, 99)], @$selected) ) {
                        shift->tag('configure', $dtag, -foreground => 'red');
                        push (@$selected, $sources[substr($dtag, 1, 99)]);
                    }
                    else {
                        # KLUGE - no color support in class
                        if ($sources[substr($dtag, 1, 99)]->{color} ne '') {
                            shift->tag('configure', $dtag, -foreground => $sources[substr($dtag, 1, 99)]->color());
                        }
                        else {
                            shift->tag('configure', $dtag, -foreground => 'blue');
                        }
                        $self->remove($sources[substr($dtag, 1, 99)], $selected);
                    }
                }
            });
            $T->tag('bind', $dtag, '<Double-1>' => sub {
                $BUSY = 1;
                my $source = $sources[substr($dtag, 1, 99)];
                push (@$selected, $source);
                my $T = shift;
                my $callback = $self->AddCommand;
                # turn off tags
                foreach $source (@$selected) {
                    # KLUGE source does not have index attribute
                    $T->tag('configure', 'd' . $source->{index}, -foreground => 'blue');
                }
                print " ref(@$selected) is selected \n" if $locateBug;
                my @array = [1..2];
                $callback->($selected);
                $BUSY = 0;
                @$selected = ();

                $self->destroy if $self->Transient;
            });
        }
    }

    $T->mark(qw/set insert 1.0/);

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

    # Trigger an update callback
    $self->UpDate->($self);
}

=item color

Returns a color from @COLOR_LIST and increments the latter's index

    $color = $cat->color();

=cut