ATTN: Phillip Bradey RE: Tk Options

jmcveigh-tk-options.pl

#!/bin/perl -w

package Application {
    use Moose;

    use Tk;
    require Tk::BrowseEntry;

    use feature 'say';
    use feature 'state';
    use feature 'switch';

    use namespace::autoclean;

    has '_mw' => (
        is => 'rw',
        isa => 'Tk::MainWindow',
    );
    
    has '_packdirs' => (
        is => 'rw',
        isa => 'ArrayRef',
        required => 1,
        default => sub { [] },
    );
    
    has '_top' => (
        is => 'rw',
        isa => 'Tk::Widget',
    );

    sub  _build_mw {
        my ($self) = @_;
        my $numWidgets = 4;
        
        $self->_mw(MainWindow->new(-title => "Tk Options"));
        
        my $ft1 = $self->_mw->Frame(
            -borderwidth => 2,
            -relief => 'groove',
        )->pack(
            -side => 'top',
            -fill => 'y',
        );

        my $f1 = $ft1->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );
        
        my $f2 = $ft1->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );
        
        my $f3 = $ft1->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );

        my $f4 = $ft1->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );
        
        
        my $ft2 = $self->_mw->Frame(
            -borderwidth => 2,
            -relief => 'groove',
        )->pack(
            -side => 'bottom',
            -fill => 'y',
        );
        
        my $f5 = $ft2->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
            
        );
        
        my $f6 = $ft2->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
            -fill => 'x'
        );
        
        my $f7 = $ft2->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );

        my $f8 = $ft2->Frame(
            -borderwidth => 2,
            -relief => 'groove'
        )->pack(
            -side => 'left',
        );

        my $i = 0;

        my $lbl1 = $f1->Label(-text => 'Configuration 1')->pack(-ipady => 5);
        my $lbl2 = $f2->Label(-text => 'Configuration 2')->pack(-ipady => 5);
        my $lbl3 = $f3->Label(-text => 'Configuration 3')->pack(-ipady => 5);
        my $lbl4 = $f4->Label(-text => 'Configuration 4')->pack(-ipady => 5);
        my $lbl5 = $f5->Label(-text => 'Configuration 5')->pack(-ipady => 5);
        my $lbl6 = $f6->Label(-text => 'Configuration 6')->pack(-ipady => 5);
        my $lbl7 = $f7->Label(-text => 'Configuration 7')->pack(-ipady => 5);
        my $lbl8 = $f8->Label(-text => 'Configuration 8')->pack(-ipady => 5);
        
        foreach (0..$numWidgets)
        {
            $self->_packdirs->[$_] = 'Skip';
            my $be1 = $f1->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be2 = $f2->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be3 = $f3->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be4 = $f4->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be5 = $f5->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be6 = $f6->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be7 = $f7->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
            
            my $be9 = $f8->BrowseEntry(-label => "Setting $_:", 
                -choices => ["On", "Off", "Skip"], 
                -variable => \$self->_packdirs->[$_], -browsecmd => \&repack)
            ->pack(-ipady => 5);
        }

        my $btn1 = $f1->Button(-text => 'Commence New Process 1')->pack(-ipady => 5);
        my $btn2 = $f2->Button(-text => 'Commence New Process 2')->pack(-ipady => 5);
        my $btn3 = $f3->Button(-text => 'Commence New Process 3')->pack(-ipady => 5);
        my $btn4 = $f4->Button(-text => 'Commence New Process 4')->pack(-ipady => 5);
        my $btn5 = $f5->Button(-text => 'Commence New Process 5')->pack(-ipady => 5);
        my $btn6 = $f6->Button(-text => 'Commence New Process 6')->pack(-ipady => 5);
        my $btn7 = $f7->Button(-text => 'Commence New Process 7')->pack(-ipady => 5);
        my $btn8 = $f8->Button(-text => 'Commence New Process 8')->pack(-ipady => 5);
        
        $self->_top($self->_mw->Toplevel(-title => "output window"));

        my $c;

        my $idx = 0;
        foreach (@{$self->_packdirs})
        {
            my $b = $self->_top->Button(-text =>  "Open Folder ${idx}", -font => "Courier 20 bold")->pack(-side => 'bottom', -fill => 'both', -expand => 1);
            $idx++;
        }

        MainLoop;
    }
    
    sub main {
        my ($self) = @_;
        $self->_build_mw;
    }

    __PACKAGE__->meta->make_immutable;
}

my $app = Application->new->main unless caller;

1;