in reply to Help with TK writing shorter code

Yes. You need to take advantage of subroutines and arrays. Below is my refactoring of your code to use arrays to hold all the slot info, and subroutines to build the similar screen components. Compare it carefully with what you have. Note - I have not attempted to do anything with your validation subroutines and other stuff. 

#!/usr/local/bin/perl5 -w

use strict;
use warnings;
require Tk;
use Tk;
my $Version="1.0";

my @sernums=  ("", "", "", "", "", "", "", "", "", "", "", "", "", "",
+ "", "", "");
my @partnums= ("", "", "", "", "", "", "", "", "", "", "", "", "", "",
+ "", "", "");


# Create main window
my $width = 900;
my $height = 680;

my $main = MainWindow->new();
$main->minsize( ($width, $height));
$main->maxsize( ($width, $height));
$main->title(" SanDisk SFT1");
#$main->setIcon(-file => 'PliantLogo.ico');
$main->configure(-background=>'gray'); #cyan

my $menu_bar = $main->Frame(-relief=> 'groove',
    -borderwidth=> 3,
    -background=> 'blue', #purple
    )->pack('-side'=> 'top',-fill=> 'x');

my $file_mb = $menu_bar->Menubutton(-text => 'File',
    -background => 'blue', #purple
    -activebackground => 'blue',
    -foreground => 'white',
    )->pack(-side=> 'left');

$file_mb->command(-label => 'Exit',
    -activebackground => 'blue',
    -command => sub{$main->destroy});

my $help_mb = $menu_bar->Menubutton(-text=> 'Help',
    -background => 'blue', #purple
    -activebackground => 'cyan',
    -foreground => 'white',
    )->pack(-side=> 'right');

$help_mb->command(-label => 'About',
    -activebackground => 'blue',
    -command => \&about_txt);

$help_mb->separator();

$help_mb->command(-label => 'Help',
    -activebackground => 'blue',
    -command => \&help_txt);

#Build the innards
my $statusline = $main->Frame(-borderwidth => 3, -relief => 'groove',
    -background => 'purple')->pack(-side => 'top');

my $status = $statusline->Label(-width => $width, -height => 0,
    -foreground => 'white', -background => 'purple')->pack();


my $num_slots = 16;
my $slots_per_row = 4;

my( @descSlot, @sernumSlot, @partnumSlot, @statusSlot, @goSlot, );

my $row;

for my $slot ( 1 .. $num_slots )
{
    $row = make_row( $main, $width, $slot, $slot+$slots_per_row-1 )
        unless ($slot-1) % $slots_per_row;
    make_slot( $row, $slot );
}



$main->geometry('+400+200'); # '+10+340'

compute();

$status->configure(-text => "Status Display");

$statusSlot[$_]->configure(-text => "Inactive", -background => 'gray')
    for 1 .. $num_slots;

MainLoop();

sub compute {
    return;
}

sub validateSerNum {
    my $sernum = shift;
    print "validateSerNum called with $sernum\n";
    if (($sernum =~ m/^\d{8}/) && (length($sernum) == 8)) {
        print "Returning 1\n";
        return(1);
    } else {
        print "Returning 0\n";
        return(0);
    }
}

sub invalidSerNum {
    $main->bell;
    $main->messageBox(-icon => 'error', -message => 'Serial number mus
+t be 8 digits!', -title => 'Error', -type => 'Ok');
    $main->focusCurrent;
}

sub validatePartNum {
    my $partnum = shift;
    print "validatePartNum called with $partnum\n";
    if (($partnum =~ m/^\d{8}/) && (length($partnum) == 8)) {
        print "Returning 1\n";
        return(1);
    } else {
        print "Returning 0\n";
        return(0);
    }
}

sub invalidPartNum {
    $main->bell;
    $main->messageBox(-icon => 'error', -message => 'Invalid part numb
+er!', -title => 'Error', -type => 'Ok');
    $main->focusCurrent;
}


sub make_row
{
    my( $parent, $width, $lo, $hi ) = @_;
    my $line = $parent->Frame(-borderwidth => 3, -relief => 'groove', 
+-background => 'gray')->pack(-side => 'top');
    $line->Label(-text => sprintf("Slots %02d - %02d", $lo, $hi), -wid
+th => $width, -height => 0, -foreground => 'black', -background => 'g
+ray')->pack();

    my $row = $parent->Frame(-background => 'cyan',)->pack(-side => 't
+op', -fill => 'x');
    my $descriptionrow = $row->Frame(-background => 'cyan',)->pack(-si
+de => 'left', -pady => 9, -padx => 8);
       $descriptionrow->Label(-text => 'Serial Number ', -background =
+> 'cyan',)->pack();
       $descriptionrow->Label(-text => 'Part Number', -background => '
+cyan',)->pack();
       $descriptionrow->Label(-text => 'Status', -background => 'cyan'
+,)->pack();

    $row
}


sub make_slot
{
    my( $parent, $x, ) = @_;
    my $slot = $parent->Frame( -background => 'cyan',
        )->pack( -side => 'left', -pady => 2, -padx => 15);

    $descSlot[$x] = $slot->Label( -text => sprintf('Slot %02d',$x), -b
+ackground => 'cyan',
        )->pack();

    $sernumSlot[$x] = $slot->Entry( -width => 22, -background => 'whit
+e', -validate => 'focusout',
        -textvariable => \$sernums[$x],
        -validatecommand => \&validateSerNum,
        -invalidcommand => \&invalidSerNum,
        )->pack();

    $partnumSlot[$x] = $slot->Entry( -width => 22, -background => 'whi
+te', -validate => 'focusout', 
        -textvariable => \$partnums[$x], 
        -validatecommand => \&validatePartNum, 
        -invalidcommand => \&invalidPartNum,
        )->pack();

    $statusSlot[$x] = $slot->Label( -background => 'white', -width => 
+19, -relief => 'groove', -borderwidth => 3,
        -text => 'dormant',
        )->pack( -anchor => 'center');

    $goSlot[$x] = $slot->Button( -width => 10, -height => 1, -text => 
+'Start', -background => 'gray',
        -command => \&compute
        )->pack( -side => 'top', -anchor => 'center');
}

[download]
I reckon we are the only monastery ever to have a dungeon stuffed with 16,000 zombies.

Replies are listed 'Best First'.
Re^2: Help with TK writing shorter code
by alexanderp98 (Novice) on Sep 22, 2011 at 17:25 UTC
    Thanks for your help. Is there a way to identify which slot a given start button is associated with? Thanks.
[reply]
      The button is defined by $x, in the sub make_slot 
       $goSlot[$x] = $slot->Button()

      [download]
      so keep track of $x.

      What are you trying to do with the button tracking?

      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
        I'm trying to figure out how to keep track of $x. I want to be able to pass a unique serial number that is associated with the start button. So, for example, if slot 1 contained serial number 01234567, I want to be able to process that serial number if slot 1's start button is pressed. I'm pretty new to perl so I'm kind of floundering here. Thanks for your help.
[reply]

In Section Seekers of Perl Wisdom