#!/usr/bin/perl

use strict; # https://perlmonks.org/?node_id=11143267
use warnings;
use Tk ':eventtypes';
use Tk::TableMatrix;
use Data::Dumper qw( DumperX);

my $top = MainWindow->new;
my $changing = '';

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,
                              -validate => 1,                    # NOTE
                              -validatecommand => \&allowchange, # NOTE
                    );

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');

sub allowchange
  {
  my ($row, $col) = @_;
  my $cell = "$row,$col";
  return $cell eq $changing ? 1 : 0;
  }

my $cnt;
sub Timer
{
    print "Now\n";
    my $variable = $t->cget( -var);

    $changing = "4,0";             # NOTE
    $t->activate("4,0");           # NOTE
    $t->curvalue( "Test".$cnt++ ); # NOTE
    $changing = "";                # NOTE

    #$t->activate("4,0");
    #$t->colWidth( -2 => 7, -1 => 7, 1=> 5, 2 => 8, 4=> 14);
    #$t->update();
    $top->after(1000, \&Timer);
    return 1;
}

$top->after(1000, \&Timer);

Tk::MainLoop;