1## spreadsheet.tcl
2##
3## This demos shows how you can simulate a 3D table
4## and has other basic features to begin a basic spreadsheet
5##
6## jeff.hobbs@acm.org
7##  Converted to perl/tk by John Cerney
8
9
10use Tk;
11
12use Tk::TableMatrix;
13
14my ($rows,$cols) = (10,10); # number of rows/cols
15my $page = 'AA';
16my $oldPage = '';
17
18my $tableColors = { default => 'pink',AA => 'orange', BB => 'blue', CC => 'green'};
19
20my $top = MainWindow->new;
21
22sub colorize{
23	my ($num) = @_;
24	return 'colored' if( $num > 0 && $num%2);
25	return '';
26}
27
28# Sub to fill the array variable
29sub fill{
30
31	my ($name, $array,$r,$c) = @_;
32	my ($i,$j);
33	$r ||= $rows;
34	$c ||= $cols;
35	for( $i = 0; $i<$r; $i++){
36		for( $j = 0; $j<$c; $j++){
37			if( $j && $i){
38				$array->{"$i,$j"} = "$name $i,$j";
39			}
40			elsif( $i ){
41				$array->{"$i,$j"} = "$i";
42			}
43			elsif( $j ){
44				$array->{"$i,$j"} = sprintf("%c",($j+64));
45			}
46		}
47	}
48}
49
50my $arrayVar = { AA => {},
51		 BB => {},
52		 CC => {}};
53
54fill('AA',$arrayVar->{AA}, $rows,$cols); # fill up the array variable
55fill('BB',$arrayVar->{BB}, $rows/2,$cols/2); # fill up the array variable
56
57my $t = $top->Scrolled('TableMatrix', -rows => $rows, -cols => $cols,
58                              -width => 5, -height => 5,
59			      -titlerows => 1, -titlecols => 1,
60			      -coltagcommand => \&colorize,
61			      -selectmode => 'extended',
62			      -flashmode => 'on',
63			      -variable => $arrayVar->{$page},
64
65                    );
66
67
68my $label = $top->Label(-text => "TableMatrix vs Spreadsheet Example");
69
70# Label the changes with the value of currentTest
71my $currentText = '';
72my $currentLabel = $top->Label(-textvariable => \$currentText);
73
74# Entry that changes with the value of activeText
75my $activeText = '';
76my $activeEntry = $top->Entry(-textvariable => \$activeText);
77
78my $pageLabel = $top->Label(-text => 'PAGE:', -width => 6, -anchor => 'e');
79my $pageSelect = $top->Optionmenu( -options => [ qw/ AA BB CC/],
80		-variable => \$page,
81		-command => [ \&changepage]);
82
83
84
85sub changepage{
86
87	my ($newPage) = @_;
88
89	if( $newPage ne $oldPage){
90
91		$t->selectionClear('all');
92		$t->activate(''); # unactivate anything
93		$t->configure(-variable => $arrayVar->{$newPage});
94	        # $e config -textvar ${i}(active)
95		$t->activate('origin');
96		if( exists $tableColors->{$newPage}){
97			$t->tagConfigure('colored', -bg => $tableColors->{$newPage});
98		}
99		else{
100			$t->tagConfigure('colored', -bg => $tableColors->{'default'});
101		}
102		$t->see('active');
103		$oldPage = $newPage;
104	}
105}
106
107$t->configure( -browsecommand => sub{
108					my ($oldindex,$index) = @_;
109					$currentText = $index;
110					$activeText = $t->get($index);
111				});
112
113
114
115# hideous Color definitions here:
116$t->tagConfigure('colored', -bg => $tableColors->{$page});
117$t->tagConfigure('title', -fg => 'red', -relief => 'groove');
118$t->tagConfigure('blue', -bg => 'blue');
119$t->tagConfigure('green', -bg => 'green');
120
121$t->tagCell('green', '6,3','5,7','4,9');
122$t->tagCell('blue', '8,8');
123$t->tagRow('blue', 7);
124$t->tagCol('blue', 6,8);
125
126$t->colWidth( 0 => 3, 2 => 7);
127
128$label->grid(				'-',		'-',		'-',		'-',	'-sticky' => 'ew');
129$currentLabel->grid(		$currentLabel,	$activeEntry, 	$pageLabel, 	$pageSelect, 	'-',	'-sticky' => 'ew');
130$t->grid( 				'-',		'-',		'-',		'-',	'-sticky' => 'nsew');
131$top->gridColumnconfigure(1, -weight => 1);
132$top->gridRowconfigure(2, -weight => 1);
133
134
135Tk::MainLoop;
136