view release on metacpan or  search on metacpan

demos/demos/widget_lib/transtile.pl  view on Meta::CPAN

# transtile.pl

use vars qw/$TOP/;

sub transtile {

    # Create a top-level window that demonstrates tiles
    # and transparent stuff.

    my($demo) = @_;
    $TOP = $MW->WidgetDemo(
        -name     => $demo,
        -text     => ['This window demonstrates tiles and transparent images. The Canvas has a yellow background, which displays for one second before it\'s overlayed with a tile of tiny camels. On top of the tile layer are three non-transparent imag...
        -title    => 'Tile and Transparent Demonstration',
        -iconname => 'transtile',
    );

    my $tile = $TOP->Photo(-file =>Tk->findINC('Camel.xpm'));

    # A tiled Canvas - the tile overlays the background color.

    my $c = $TOP->Canvas(
        -background  => 'yellow',
        -width       => 300,
        -height      => 250,
        -relief      => 'raised',
        -borderwidth => 3,
    )->grid;
    $c->update;
    $c->after(1000);
    $c->configure(-tile => $tile);

    # These images are not transparent, thus they obscure the tile
    # or background.

    my($x, $y) = (30, 30);
    foreach (qw/Xcamel.gif anim.gif icon.gif/) {
	$c->createImage($x, $y, -image => $TOP->Photo(-file => Tk->findINC($_)));
	$x += 50;
	$y += 50;
    }

    # Transparent Canvas items do not generate events.

    my $cb = sub {
	print "Over circle, args = @_!\n";
    };

    # Not filled (transparent), no events.

    my $o1 = $c->createOval(25, 25, 100, 100,
        -outline => 'red',
    );
    $c->bind($o1, '<Motion>' => $cb);

    # Filled (non-transparent), but with events.

    my $o2 = $c->createOval(155, 25, 225, 100,
        -outline => 'red',
        -fill    => 'blue',
    );
    $c->bind($o2, '<Motion>' => $cb);

    # Transparently filled, with events.

    my $o3 = $c->createOval(25, 120, 100, 195,
        -outline => 'red',
        -fill    => 'blue',
        -stipple => 'transparent',
    );
    $c->bind($o3, '<Motion>' => $cb);

    # A transparent GIF overlaying everything.

    $c->createImage(300, 300,
        -image => $TOP->Photo(-data => &encoded_gif, -format => 'gif'),
	-anchor => 'se',
    );

} # end transtile

sub encoded_gif {

    # A Base64 encoded transparent GIF.

    my $gif =  <<'END_OF_GIF';
R0lGODlhyADIAIAAAB0A/////yH+Dk1hZGUgd2l0aCBHSU1QACH5BAEKAAEALAAAAADIAMgAAAL+
jI+py+0Po5y02ouz3rz7D4biSJbmiabqCgJuC7DZK9Ly5+Zdrt8Sb+MAYzDUkKgZ+n5AXNOjLB03
R6TQmpxeo9seSTsDZ3ldctk7fo7EGC5VnQ6+zWd5CB6mx9Ft/N6p92WXBejXt4Z1trTI4MboM/i4
6ChZabkUeam5ydnp+QkaKjpKWmp6ipqqusoKldjqWvOqSQmbx3ebSTiH+yZrZHhR+9c3bGFcgcwb
KMy2PBtR5cpc3DsdTCF9Tc3Efez8rUysWOgNId6NPaGNaJ6t3uweDV2t+y5/9SuLf4M+z2/rXSh7
zQIaPIgwocKFDBs6fAgxosSJjehRHGhxB7z+ZBm/6StSrmMukec2piN4kuQDfyUBhjPZ0tpLlP9k
cnTZgN0dcDdhOtBZz2ZKmj95asRZkWVOo+uYDlW5FOk9oU2lLlBa1KoCrFGp5gu5DWpXoit9zmNF
lslHJxfbun0LN67cuXTr2r2LN6/evbvspj2oVcbfnoP7iR17uGK7xCl37iy81WxWxkm9xpM8GexR
ygi4ToZc1vNVzJVBJzDdmXRmKapHBz5tGVNsgSZEV3aMsRXq0Xx7+/4NPLjw4cSLGz+OPLmK3b5f
p3COinlN6QGo21bsCfp05tqrt3bNGfZm6ojDe+/e/fzs1eNqXz/wXjwM6PHTh17fdZT2+N7+BeMv
Wop1/ykHCnkEHohgggouyGCDDj4oCITRDQiYeYyYx598oti3wnfqkcfhPhRqeIJTMT02Im+a8fJc
fRamll6MKRqQ4WcGFjLfjKmFBYyHJb5Io4+s3QgekAHq6J5gcBEpYZNOPglllFJO2R+V2SFpZY5M
NvlijVXqZ+SWMHKHpXq45Yjjj0J+OV6XZfLnZZFijsRjnc+oGeI1K26WpntrRojmmbG0WOaRehmZ
ZaKKLspoo44+CmmkksyZZIJ54kkmoAX+2aGQHF5qJylAzQRknCIKuthrXsYJYpiFRkbfq/aBSo4g
+yEaJIqUBgXMW6YGCiGtGj25q6TGHov+bLLKLstss2ziOWhc0gn7YXif4morhpyWxtmqrz57Z7hD
flcjq1jC+S2sM8rI7rnuLucporNyWuypmy7mbK/57stvv/7+C3DAAvd1r4S/9gnSXAe3ieKG2MJn
Im21MvwJqKPeoqeWpbpp8Z8Z3thuqCJOuy0iGmf8o70UlfswvL6m22+9A89Mc80231yXzKLKiyvJ
OieMMp/AtjcsphZ+7LGP3oqJ9K3oxSvgpRdfNrTQRe+p67uoRlsxzEFSm9ycC+/7M85mn4122mqv
zfZXbSOWM89rUez2hE4j2bTS3zK9Zt5kvmcuk1NP5dzghFlLb8lf6+2i39q2KnXfks8fCzTCIx89
ude56Vv51W9/Dnrooo9Oeummn4566g4UAAA7
END_OF_GIF

    return $gif;

} # end encoded_gif

1;