summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl86
1 files changed, 86 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl
new file mode 100644
index 00000000000..e39e9caac56
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/cscroll.pl
@@ -0,0 +1,86 @@
+# cscroll.pl
+
+use subs qw/cscroll_button cscroll_enter cscroll_leave/;
+use vars qw/$TOP/;
+
+sub cscroll {
+
+ # Create a top-level window containing a simple canvas that can be
+ # scrolled in two dimensions.
+
+ my($demo) = @_;
+ $TOP = $MW->WidgetDemo(
+ -name => $demo,
+ -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',
+ -iconname => 'cscroll',
+ );
+
+ 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++) {
+ $x = -10 + 3 * $i;
+ $j = 0;
+ $y = -10;
+ while ($j < 10) {
+ $c->createRectangle("${x}c", "${y}c",
+ ($x+2).'c', ($y+2).'c',
+ -outline => 'black', -fill => $bg, -tags => 'rect');
+ $c->createText(($x+1).'c', ($y+1).'c',
+ -text => "$i,$j", -anchor => 'center', -tags => 'text');
+ $j++;
+ $y += 3;
+ } # whilend
+ } # forend
+
+ my $old_fill = '';
+ $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>' => [ scanMark => Ev('x'), Ev('y') ]);
+ $c->CanvasBind('<B2-Motion>' => [ scanDragto => Ev('x'), Ev('y') ]);
+
+} # end cscroll
+
+sub cscroll_button {
+
+ my($c) = @_;
+
+ 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";
+
+} # end cscroll_button
+
+sub cscroll_enter {
+
+ my($c, $old_fill) = @_;
+
+ my ($id) = $c->find(qw/withtag current/);
+ $id-- if ($c->gettags('current'))[0] eq 'text';
+ $$old_fill = ($c->itemconfigure($id, -fill))[4];
+ if ($c->depth > 1) {
+ $c->itemconfigure($id, -fill => 'SeaGreen1');
+ } else {
+ $c->itemconfigure($id, -fill => 'black');
+ $c->itemconfigure($id+1, -fill => 'white');
+ }
+
+} # end cscroll_enter
+
+sub cscroll_leave {
+
+ my($c, $old_fill) = @_;
+
+ 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');
+
+} # end cscroll_leave
+
+1;