The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# 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