#!/usr/bin/perl -w

use strict;
use warnings;
use Tk;

# User-defined
my @button_names = qw( blue red green white purple orange );


# Main program
my $mw = new MainWindow(-title => 'Button example');

my $fr = $mw->Frame()->pack(-fill => 'x');

foreach my $name (@button_names) {
    my $b = $fr->Button(-text => $name, -bg => $name)->pack(-side => 'left');
    $b->configure(-command => sub { invoke_button($b, $name) });
}

MainLoop;

                                                                       
# Subroutines
sub invoke_button {
    my ($button, $name) = @_;
    print "You clicked on button '$name'; object is '$button'\n";
}