# 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