use Tk;
use strict;

# a nice and stolen pic

my $dilbert = <<"EOXPM";
/* XPM */
static char *smalldilbert[] = {
"    16    16       14            1",
/* colors */
"` c #000000",
". c #380000",
"# c #383800",
"a c #383838",
"b c #790000",
"c c #793838",
"d c #797938",
"e c #797979",
"f c none",
"g c #bebe38",
"h c #bebe79",
"i c #ffff79",
"j c #bebebe",
"k c #ffffff",
/* pixels */
"fff`dd##aadd`fff",
"ffff`iiiiii`ffff",
"ffff`iiiiii`ffff",
"ffff`ihghgi`ffff",
"fff``deeeed``fff",
"fffdaiededi#dfff",
"fffa`iighii`#fff",
"ffff`idiidi`ffff",
"ffff`igddhi`ffff",
"ffff`iiiiii`ffff",
"ffff`iiiiii`ffff",
"ffffaeedddeaffff",
"fff`eee.`eee`fff",
"ff`jjck.bkkkj`ff",
"f`jkb.a.`kkkkj`f",
"`jjj``...kkkjjj`"
};
EOXPM

# making a empty image

my $mw = MainWindow -> new;
my $label = $mw->Label ()->pack;
my $image = $label ->Photo('image',
                     -height => 10, 
                     -width => 10,
                     -format=>'XPM');
$label->configure(-image => $image);
my $data_mw = $image->data(-format => 'XPM');

# so what we have?

print "$data_mw\n";

# this is ok

# now making a dilbert image

my $top = $mw ->Toplevel;
my $label_1 = $top -> Label()->pack;
my $image_1 = $label_1 ->Photo('image',
                         -data=> $dilbert,                            
+                -format=>'XPM');
$label_1->configure(-image => $image_1);

# copying the dilbert inside the empty one
# MainLoop auto-update...

$image -> copy($image_1);

my $data_copy = $image->data(-format => 'XPM');
print $data_copy;

# the above print something like
# Tk::Photo=HASH(0xc5ef04)

# How can I access this data?
# Not the original but the copy

MainLoop;
[download]