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