|
|
PGTS Humble BlogThread: Perl Programming |
|
Gerry Patterson. The world's most humble blogger | |
Edited and endorsed by PGTS, Home of the world's most humble blogger | |
| |
Tk/perl Table Example |
|
Chronogical Blog Entries: |
|
| |
Date: Tue, 17 Jun 2008 22:12:36 +1000Recently 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:
- sudo apt-get install perl-tk
- sudo apt-get install libtk-gbarr-perl
- sudo apt-get install libtk-tablematrix-perl
- sudo apt-get install libtk-pod-perl
- sudo apt-get install libtk-splashscreen-perl
- sudo apt-get install libtk-objscanner-perl
- sudo cpan
i /OptionMenu.pm/
install FELIXL/vptk/vptk_w_2_38b.tgz
# Probably didn't need the last one
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.