PGTS PGTS Pty. Ltd.   ACN: 007 008 568

point Site Navigation

point Other Blog Threads



  Valid HTML 4.01 Transitional

   Give Windows The Boot!
   And Say Goodbye To Viruses!

   Ubuntu

   If you own a netbook/laptop~
   Download Ubuntu Netbook!






PGTS Humble Blog

Thread: Perl Programming

GP JPG
Gerry Patterson, The World's Most Humble Blogger

Tk/perl Table Example


Chronogical Blog Entries:



Date: Tue, 17 Jun 2008 22:12:36 +1000

Recently I tried my hand at some Tk/Perl. It was difficult to find a practical example of Tk/Perl script that used the Table method. I found a couple of examples that didn't really work and several trivial scripts.

The following is an example of Tk/Perl that creates a Table and allows you to select/de-select cells by clicking on them:
#!/usr/bin/perl
use strict;
use warnings;
use Tk;
use Tk::Table;
my $cols = 10;
my $rows = 20;
my %slct;

# ------------------------------------------------------------------------

sub show_cells {
        print "Selected Cells: ";
        foreach ( sort {$a <=> $b} (keys %slct)) {
                printf "%d,%d ",split (/\./,$_);
        }
        print "\n";
}

# ------------------------------------------------------------------------

sub toggle_slct {
        my ($w, $t) = @_;
        my ($row, $col) = $t->Posn( $w );
        my $k = sprintf "%d.%02d",$row,$col;
        if ($slct{$k}) {
                $w->configure(-background => 'white');
                print "Row: $row Col: $col unselected\n";
                delete($slct{$k});
        } else {
                $w->configure(-background => 'grey');
                print "Row: $row Col: $col selected\n";
                $slct{$k} = 1;
        }
}

# ------------------------------------------------------------------------

#
# create the main window and frame
#
my $mw = new MainWindow();
my $tableFrame = $mw->Frame(-borderwidth => 2,
                            -relief => 'raised')->pack;
#
# allocate a table to the frame
#
my $table = $tableFrame->Table(-columns => 8,
                               -rows => 10,
                               -fixedrows => 1,
                               -scrollbars => 'se',
                               -relief => 'raised');
#
# column headings
#
foreach my $c ( 1 .. $cols) {
        my $hdr = "Row " . $c;
        my $tmp = $table->Label(-text => $hdr,
                                -width => 6,
                                -relief => 'raised');
        $table->put( 0, $c, $tmp );
}
#
# populate the cells and bind an action to each one
#
foreach my $r ( 1 .. $rows ) {
        foreach my $c ( 1 .. $cols ) {
                my $data = $r . "," . $c;
                my $tmp = $table->Label(-text => $data, -padx => 2,
                                        -anchor => 'w',
                                        -background => 'white',
                                        -relief => 'groove');
                $tmp->bind('<Button>', [ \&toggle_slct, $table ]);
                $table->put( $r, $c, $tmp );
        }
}
$table->pack( -expand => 'yes', -fill => 'both');
#
# create the menu bar, and add the "show" and "exit" buttons
#
my $buttonBar = $mw->Frame( -borderwidth => 4 )->pack(-fill => 'y');
my $showB = $buttonBar->Button(-text => "Show",
                                -command => \&show_cells);
my $exitB = $buttonBar->Button( -text => "Exit",
                                -width => 10,
                                -command => sub { exit });
foreach ( $showB, $exitB ) {
        $_->pack(-side => 'left', -padx => 2 );
}
#
# start it up
#
MainLoop();

Getting Tk/perl to work in Ubuntu was difficult. I used apt-get. I probably ended up installing too many packages. Here is what I did:

I was not able to get the Tk package working in Activestate perl on Mac OS X. I had to use Tkx rather than Tk.


Other Blog Posts In This Thread:

Copyright     2008, Gerry Patterson. All Rights Reserved.