/usr/share/doc/libtk-tablematrix-perl/examples/debug is in libtk-tablematrix-perl 1.23-6build2.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | #!/usr/bin/perl
## version2.tcl
##
## This demo uses most features of the table widget
##
## jeff.hobbs@acm.org
## Converted to perl/tk by John Cerney
use Tk;
use Tk::TableMatrix;
my ($rows,$cols) = (25,20); # number of rows/cols
my $top = MainWindow->new;
# Sub to fill the array variable
sub fill{
my ($array,$x,$y) = @_;
my ($i,$j);
for( $i = -$x; $i<$x; $i++){
for( $j = -$y; $j<$y; $j++){
$array->{"$i,$j"} = "r$i,c$j";
}
}
}
## Test out the use of a callback to define tags on rows and columns
sub colSub{
my $col = shift;
return "OddCol" if( $col > 0 && $col%2) ;
}
my $label = $top->Label(-text => "TableMatrix v2 Example");
my $arrayVar = {};
fill($arrayVar, $rows,$cols); # fill up the array variable
my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols,
-variable => $arrayVar,
-width => 6, -height => 8,
-titlerows => 1, -titlecols => 2,
-roworigin => -5, -colorigin => -2,
-coltagcommand => \&colSub,
-selectmode => 'extended',
-selecttitles => 0,
-drawmode => 'single',
);
my $button = $top->Button( -text => "Exit", -command => sub{ $top->destroy});
$label->pack( -expand => 1, -fill => 'both');
$t->pack(-expand => 1, -fill => 'both');
$button->pack(-expand => 1, -fill => 'both');
# hideous Color definitions here:
$t->tagConfigure('OddCol', -bg => 'brown', -fg => 'pink');
$t->tagConfigure('title', -bg => 'red', -fg => 'blue', -relief => 'sunken');
$t->tagConfigure('dis', -state => 'disabled');
my $i = -1;
my $first = $t->cget(-colorigin);
my $anchor;
foreach $anchor( qw/ n s e w nw ne sw se c /){
$t->tagConfigure($anchor, -anchor => $anchor);
$t->tagRow($anchor, ++$i);
$t->set( "$i,$first",$anchor);
}
$top->fontCreate('courier', -family => 'courier', -size => 10);
$t->tagConfigure('s', -font => 'courier', -justify => 'center');
# $initWindow->Label(-image => $top->Photo(-file => Tk->findINC('Xcamel.gif')))->pack;
my $perltkLogo = $top->Photo(-file => Tk->findINC('Xcamel.gif'));
$t->tagConfigure('logo', -image => $perltkLogo, -showtext => 1);
$t->tagCell('logo', '1,2', '2,3', '4,1');
$t->tagCell('dis', '2,1', '1,-1', '3,0');
$t->colWidth(qw/ -2 8 -1 9 0 12 4 14/);
$t->set( '1,1' => "multi-line\ntext\nmight be\ninteresting" ,
'3,2' => "more\nmulti-line\nplaying\n" ,
'2,2' => "null\0byte" );
$i = -1;
# This is in the row span
my $l = $top->Label(-text => "Window s", -bg => 'yellow');
$t->windowConfigure("6,0", -sticky => 's', -window => $l);
# This is in the row titles
$l = $top->Label(-text => "Window ne", -bg => 'yellow');
$t->windowConfigure("4,-1", -sticky => 'ne', -window => $l);
# This will get swallowed by a span
$l = $top->Label(-text => "Window ew", -bg => 'yellow');
$t->windowConfigure("5,3", -sticky => 'ew', -window => $l);
# This is in the col titles
$l = $top->Label(-text => "Window nsew", -bg => 'yellow');
$t->windowConfigure("-5,1", -sticky => 'nsew', -window => $l);
$l = $t->parent->Label(-text => "Sibling l", -bg => 'orange');
$t->windowConfigure("5,1", -sticky => 'nsew', -window => $l);
$t->spans( '-1,-2' => '0,3', '1,2' => '0,5','3,2' => '2,2', '6,0' => '4,0');
Tk::MainLoop;
|