aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/clipping.pl14
1 files changed, 8 insertions, 6 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/clipping.pl b/Perl/demos/Tk/demos/zinc_lib/clipping.pl
index 8ee9f63..a31d602 100644
--- a/Perl/demos/Tk/demos/zinc_lib/clipping.pl
+++ b/Perl/demos/Tk/demos/zinc_lib/clipping.pl
@@ -15,7 +15,7 @@ my $zinc = $mw->Zinc(-width => 700, -height => 600,
-borderwidth => 3, -relief => 'sunken',
)->pack;
-my $display_clipping_area_limits = 1;
+my $display_clipping_item_background = 0;
my $clip = 1;
$zinc->add('text', 1,
@@ -34,7 +34,10 @@ my $clipping_item = $zinc->add('curve', $clipped_group,
[10,100, 690,100, 690,590, 520,300,
350,590, 180,300, 10,590],
-closed => 1,
- -linewidth => $display_clipping_area_limits);
+ -priority => 1,
+ -fillcolor => "tan2",
+ -linewidth => 0,
+ -filled => $display_clipping_item_background);
$zinc->contour($clipping_item, "diff", [200,200, 500,200, 500,250, 200,250]);
############### creating the tan_group objects ################
@@ -118,8 +121,8 @@ sub release {
}
###################### toggle buttons at the bottom #######
my $row = $mw->Frame()->pack();
-$row->Checkbutton(-text => 'Show clipping limits',
- -variable => \$display_clipping_area_limits,
+$row->Checkbutton(-text => 'Show clipping item',
+ -variable => \$display_clipping_item_background,
-command => \&display_clipping_area)->pack;
$row->Checkbutton(-text => 'Clip',
@@ -127,7 +130,7 @@ $row->Checkbutton(-text => 'Clip',
-command => \&clip)->pack;
sub display_clipping_area {
- $zinc->itemconfigure($clipping_item, -linewidth => $display_clipping_area_limits);
+ $zinc->itemconfigure($clipping_item, -filled => $display_clipping_item_background);
}
sub clip {
@@ -135,7 +138,6 @@ sub clip {
$zinc->itemconfigure($clipped_group, -clip => $clipping_item);
}
else {
- print "unclip\n";
$zinc->itemconfigure($clipped_group, -clip => undef);
}
}