use subs qw
/cscroll_button cscroll_enter cscroll_leave/;
# Create a top-level window containing a simple canvas that can be
# scrolled in two dimensions.
-text
=> 'This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout.',
-title
=> 'Scrollable Canvas Demonstration',
my $c = $TOP->Scrolled(qw
/Canvas
-relief sunken
-borderwidth
2
-scrollbars se
-scrollregion
/ => ['-10c', '-10c', '50c', '20c']);
$c->pack(qw
/-expand yes -fill both/);
my($bg, $i, $j, $x, $y) = ($c->configure(-background
))[4];
for ($i = 0; $i < 20; $i++) {
$c->create('rectangle', sprintf("%dc", $x), sprintf("%dc", $y),
sprintf("%dc", $x+2), sprintf("%dc", $y+2),
-outline
=> 'black', -fill
=> $bg, -tags
=> 'rect');
$c->create('text', sprintf("%dc", $x+1), sprintf("%dc", $y+1),
-text
=> "$i,$j", -anchor
=> 'center', -tags
=> 'text');
$c->bind('all', '<Any-Enter>' => [\
&cscroll_enter
, \
$old_fill]);
$c->bind('all', '<Any-Leave>' => [\
&cscroll_leave
, \
$old_fill]);
$c->bind('all', '<1>' => \
&cscroll_button
);
$c->CanvasBind('<2>' => sub {
$c->scan('mark', $e->x, $e->y);
$c->CanvasBind('<B2-Motion>' => sub {
$c->scan('dragto', $e->x, $e->y);
my $id = $c->find(qw
/withtag current/);
$id++ if ($c->gettags('current'))[0] ne 'text';
print STDOUT
'You buttoned at ', ($c->itemconfigure($id, -text
))[4], "\n";
my $id = $c->find(qw
/withtag current/);
$id-- if ($c->gettags('current'))[0] eq 'text';
$$old_fill = ($c->itemconfigure($id, -fill
))[4];
$c->itemconfigure($id, -fill
=> 'SeaGreen1');
$c->itemconfigure($id, -fill
=> 'black');
$c->itemconfigure($id+1, -fill
=> 'white');
my $id = $c->find(qw
/withtag current/);
$id-- if ($c->gettags('current'))[0] eq 'text';
$c->itemconfigure($id, -fill
=> $$old_fill);
$c->itemconfigure($id+1, -fill
=> 'black');