view release on metacpan or  search on metacpan

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

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

    $MW->update;
}

=item B<changeOpt>

Displays a window allowing the options to be changed.

=cut

sub changeOpt {
    my $name;
    my $telEnt = $TEL;
    my ($tb, $tb2);

    $optBut->configure(-state => 'disabled');

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

    # place the telescope menuButton
    $topFrame->Label(-text => 'Telescope:')->grid(-column => 0, -row => 0);
    my $f = $topFrame->Frame()->grid(-column => 1, -row => 0, -padx => 10, -pady => 5, -sticky => 'w');
    my $f2 = $topFrame->Frame()->grid(-column => 1, -row => 1, -padx => 10, -pady => 5, -sticky => 'w');
    $tb = $f->Menubutton(
        -text => $telEnt,
        -relief => 'raised',
        -width => 15,
    )->pack(-side => 'left');
    $tb->cascade(-label => 'A - C', -underline => 0);
    $tb->cascade(-label => 'D - F', -underline => 0);
    $tb->cascade(-label => 'G - I', -underline => 0);
    $tb->cascade(-label => 'J - L', -underline => 0);
    $tb->cascade(-label => 'M - O', -underline => 0);
    $tb->cascade(-label => 'P - R', -underline => 0);
    $tb->cascade(-label => 'S - U', -underline => 0);
    $tb->cascade(-label => 'V - X', -underline => 0);
    $tb->cascade(-label => 'Y - Z', -underline => 0);

    my $cm = $tb->cget('-menu');
    my $ac = $cm->Menu;
    my $df = $cm->Menu;
    my $gi = $cm->Menu;
    my $jl = $cm->Menu;
    my $mo = $cm->Menu;
    my $pr = $cm->Menu;
    my $su = $cm->Menu;
    my $vx = $cm->Menu;
    my $yz = $cm->Menu;

    $tb->entryconfigure('A - C', -menu => $ac);
    $tb->entryconfigure('D - F', -menu => $df);
    $tb->entryconfigure('G - I', -menu => $gi);
    $tb->entryconfigure('J - L', -menu => $jl);
    $tb->entryconfigure('M - O', -menu => $mo);
    $tb->entryconfigure('P - R', -menu => $pr);
    $tb->entryconfigure('S - U', -menu => $su);
    $tb->entryconfigure('V - X', -menu => $vx);
    $tb->entryconfigure('Y - Z', -menu => $yz);

    foreach $name ($telObject->telNames()) {
        if ($name =~ /^[A-Ca-c]/) {
            $ac->command(
                -label => $name,
                -command => sub {
                    $tb->configure(-text => $name);
                    $telEnt = $name;
                },
            );
        }
        elsif ($name =~ /^[D-Fd-f]/) {
            $df->command(
                -label => $name,
                -command => sub {
                    $tb->configure(-text => $name);
                    $telEnt = $name;
                },
            );
        }
        elsif ($name =~ /^[G-Ig-i]/) {
            $gi->command(
                -label => $name,
                -command => sub {
                    $tb->configure(-text => $name);
                    $telEnt = $name;
                },
            );
        }
        elsif ($name =~ /^[J-Lj-l]/) {
            $jl->command(
                -label => $name,
                -command => sub {
                    $tb->configure(-text => $name);
                    $telEnt = $name;
                },
            );
        }
        elsif ($name =~ /^[M-Om-o]/) {