The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
## basic
##
## This demo shows the basic use of the table widget
##
## jeff.hobbs@acm.org


use Tk;

use Tk::TableMatrix;

use Data::Dumper qw( DumperX);
my $top = MainWindow->new;

my $arrayVar = {};

foreach my $row  (-1..6){
	foreach my $col (-2..5){
		$arrayVar->{"$row,$col"} = "r$row, c$col";
	}
}

## Test out the use of a callback to define tags on rows and columns
sub rowSub{
	my $row = shift;
	return "OddRow" if( $row > 0 && $row % 2) 
}
sub colSub{
	my $col = shift;
	return "OddCol" if( $col > 0 && $col%2) ;
}

my $label = $top->Label(-text => "TableMatrix v1 Example");

my $t = $top->Scrolled('TableMatrix', -rows => 8, -cols => 8, 
                              -width => 6, -height => 6,
			       -titlerows => 1, -titlecols => 2,
			      -variable => $arrayVar,
			      -roworigin =>  -1,  -colorigin  => -2, 
			      -rowtagcommand => \&rowSub, 
			      -coltagcommand => \&colSub,
			      -colstretchmode => 'last',
			      -rowstretchmode => 'last',
			      -selectmode => 'extended',
			      -sparsearray => 0,
                    );

my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy});		    

# hideous Color definitions here:
$t->tagConfigure('OddRow', -bg => 'orange', -fg => 'purple');
$t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink');

$t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14);

$label->pack( -expand => 1, -fill => 'both');

$t->pack(-expand => 1, -fill => 'both');
$button->pack(-expand => 1, -fill => 'both');

my $variable = $t->cget( -var);



Tk::MainLoop;