Re^2: TableMatrix asynch update of cells

Thanks for your kind responses.
I agree that breaking OO encapsulation is a bad idea, but I don't really understand why it is described as an attribute alongside all other "public" attributes unless it is also to be regarded as a means for manipulating the table it is associated with.
By using the "appropriate methods", I assume you mean the set method? This does work, but only as long as the TableMatrix is not disabled.
(My supplied example does not set the TableMatrix to disabled, which is my bad, it shold have been for a clearer example.)

(The reason for using a disabled TableMatrix is to avoid the user making changes to it, or , where applicable, replacing the cell with e.g. a Combobox widget for easier editing. The TableMatrix cells must never be changed, thus I use the -state => 'disabled')

So, I rephrase my original question: What is the best way to update the cells of a disabled TableMatrix without breaking OO encapsulation?
Regards

Comment on Re^2: TableMatrix asynch update of cells

Replies are listed 'Best First'.

Re^3: TableMatrix asynch update of cells
by tybalt89 (Monsignor) on Apr 27, 2022 at 17:25 UTC

You can try playing games with "validate" to leave the TableMatrix enabled but only allow change to the one desired cell.

Something like this...

#!/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,                    # NOT
+E
                              -validatecommand => \&allowchange, # NOT
+E
                    );

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

# 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;
[download]

[reply]
[d/l]


We don't bite newbies here... much
	PerlMonks