diff options
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.pl | 30 |
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 |