#!/usr/bin/perl
use Tk;
use strict;

my $mw = MainWindow->new;
my @color = qw/red lightgray/;
my $bits = pack("b8"x8,
"...11...",
"..1111..",
".111111.",
"11111111",
"11111111",
".111111.",
"..1111..",
"...11...",);

$mw->DefineBitmap('indicator' => 8,8, $bits);

my $label = $mw->Label(-bitmap=>'indicator', -fg=>'red')->pack;

$mw->repeat(500,sub{$label->configure(
                               -fg=>$color[0]);
                               @color=reverse(@color);
 });

MainLoop;

##</code><code>##

#!/usr/bin/perl -w
use strict;
use Tk;

# An explanation to XPM file format can be found at 
# http://www.dcs.ed.ac.uk/home/mxr/gfx/2d-hi.html 

my $open = <<"EOD";
/* XPM */
static char * pixmap[] = {
/* width height num_colors chars_per_pixel */
"   16     12       4            1         ",
/* colors */
"   s None  c None",
".  c black",
"X  c yellow",
"o  c #5B5B57574646",
/* pixels */
"   ....         ",
"  .XXXX.        ",
" .XXXXXX.       ",
".............   ",
".oXoXoXoXoXo.   ",
".XoX............",
".oX.XXXXXXXXXXX.",
".Xo.XXXXXXXXXX. ",
".o.XXXXXXXXXXX. ",
".X.XXXXXXXXXXX. ",
"..XXXXXXXXXX..  ",
".............   "};
EOD


my $mw  = MainWindow->new();
my $image = $mw->Pixmap(-data => $open);
$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
MainLoop;

##</code><code>##

#!/usr/bin/perl -w
use strict;
use Tk;
use Tk::JPEG;
use MIME::Base64;

#this method works as easy as it does, because 
#Tk needs it's images to be base64 encoded anyways, 

#use this to encode 
#open (FH,"< tux.jpg") or die $!; 
#my $photo = do {local $/; <FH>}; 
#my $content = encode_base64($photo) or die $!;  
#print $content; 

#don't forget to '' quote 
my $photo =
'/9j/4AAQSkZJRgABAQIASABIAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRofHh0a 
HBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwhMjIyMjIy 
MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAARCAA8AEMDASIA 
AhEBAxEB/8QAHAAAAgIDAQEAAAAAAAAAAAAAAAQFBwIDCAYB/8QAMBAAAQMCBQMCBQMFAAAAAAAA 
AQIDBAARBQYSITEHUXETYSIyQUKBFTOhI1KRscH/xAAaAQEBAQADAQAAAAAAAAAAAAAAAQIDBQYE 
/8QAIxEAAgEDAwQDAAAAAAAAAAAAAAECAwQREyExBRJBkVFSof/aAAwDAQACEQMRAD8Ap5brjgSF 
uLUEgBIUomwACRb8ADwB2rCl5bymWgU8k2v2oiyPWGk/OP5oBiiilYkbEsanCJhsZ+S8r5Wo6CtR 
97DegGqKZw3LWZpk6RDYwiY69GIS+0WiFNk8A34J+gPNaHW3GHVtPIU242opWhYsUkcgg8GgNa3E 
Nga1AXr6CFC4NxUXKe9Z24+UbCm4CiWSD9DtQE07jmKvurdXiMrUo3Ol0pA8AbAew2FFR9FY0ofV 
F7n8is9N2QexqPQstrCk8ipd1HqNKR3FQ6klKikixFbIS3qhcYuJ/tJ8V7LpFjWV8Pm4rh2aU6Yu 
JMJZD11AJsoK0lSTqAJA3Haq9Ze0sutk7Ebb/WiEtpucwt9OppKwVp7i+9R8A6jVO/UcfmTGMBZm 
YEsxnI6npBaccdZvpeSLG4sQAFEXCQeDVV9a1uzsyJxVjBZUGO6wht5x1KbLdBVc3SSPl0jm/wAN 
WejGn3mmpGH4Yqdh7qApp2K+gK8FKym1uOT+K8x1CzNHiZUmQMSYaRMmJ0sRQ6HFJTt8a7CwII2t 
fgb828pa9avalyoSgmm+E91++POV6OzqWlGNPKb29FA1KQkaI4J+43qOab9V1KO53qZAsABwK9Yd 
YFFZBtZFwhVvFFTKGDGkpse49VPP3Cnaxct6ar8WNUELW+HEkT5bUSK0t191QQ22gXKiTYACtFWR 
0LQ0vqnh/qtayG3Sg2uEq9NW/wDugLEyX0XzHBw0KxDM8jDC4NRiRPj0+VXtfwD5rxHVLpPiOUo/ 
64nE14nDccCHXHEkONqPGrc3B7966qqMzBgcPMuAy8HnhRjSkaVaDYixBBHuCAfxWFTgpOSW7K5N 
rBxFAaGlTvJ48U7Tmasrzsi5qfwmbct31NPWsHWz8qh/33BFJ1shaLs7qHiTpmwoOMRoz/8AUbai 
IfDQB3ukEnY882322tRUE9nTMDjzjjeKS46VqKvSYkOIQm+5skKsB7DaigPF0vMVpjH32pik8Q/b 
R5oCPrq3ofktnL+UGsYebviOJoDhUoboa+1I87KPe47VyvHSFyWkngrAP+a71jR24kVmMynS0yhL 
aE9kgWAoDbRRRQFc9ZsnR8zZJkzUpAn4W2qSy59SgC60n2IF/IHvXLkVZcjpJ5GxrrzqfNdgdM8f 
fZ06zFLXxC+yyEH+FGuQIP7Fve9AW9Iw+JIfU7h+TJaoqrFsuy1sqO290FSrb3+p7+1FQKHXEoAW 
UuqAtrW2gqPnaivld3BPGGcmkz//2Q==';

my $mw  = MainWindow->new();
my $image = $mw->Photo(-data => $photo);
$mw->Label(-image => $image)->pack(-expand => 1, -fill => 'both');
$mw->Button(-text => 'Quit', -command => [destroy => $mw])->pack;
MainLoop;

##</code><code>##

#!/usr/bin/perl
use Tk;
my $mw = tkinit;
my $image = 'z-icon.gif';       # 32x32 GIF or BMP 
my $icon = $mw->Photo(-file => $image);
$mw->idletasks;         # this line is crucial 
$mw->iconimage($icon);
MainLoop;