summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl30
1 files changed, 30 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl
new file mode 100644
index 00000000000..aed66103bb2
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/photo1.pl
@@ -0,0 +1,30 @@
+# photo1.pl
+
+use vars qw/$TOP/;
+
+sub photo1 {
+
+ my($demo) = @_;
+
+ $TOP = $MW->WidgetDemo(
+ -name => $demo,
+ -text => 'This demonstration displays, for two seconds, a picture of a teapot over a green background, then proceeeds to render transparent a 50 x 50 pixel area of the teapot so that the green background shows through.',
+ -title => 'Transparent Pixels',
+ -iconname => 'photo1',
+ );
+
+ my $l = $TOP->Label( qw/ -background green -width 300 -height 300 / )->pack;
+
+ my $f1 = $TOP->Photo( -file => Tk->findINC( 'demos/images/teapot.ppm' ) );
+ $l->configure( -image => $f1 );
+ $TOP->idletasks;
+ $TOP->after(2000);
+
+ foreach my $x ( 50 .. 100 ) {
+ foreach my $y ( 50 .. 100 ) {
+ $f1->transparencySet( $x, $y, 1 );
+ $f1->update;
+ }
+ }
+
+} # end photo1