#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::JPEG;


my $width  = 600;
my $height = 600;

my $mw = MainWindow->new( -background => 'lightgreen' );
$mw->geometry( $width . 'x' . $height . '+40+40' );


# first create a canvas widget
my $canvas = $mw->Scrolled('Canvas', width => $width/1.3, height => $height/1.3)->pack();

 
my $eightim = $mw->Photo(-data => get_img() );


my $one = $canvas->createOval(55, 20, 200, 190, 
                      -fill => 'blue',
		      -outline=>'blue',
		      -tags => ['blue'],
		      -stipple => 'gray75',
		      );

my $two = $canvas->createOval(105, 20, 250, 190, 
                      -fill => 'red',
		      -outline=>'red',
		      -tags => ['red'],
                      -stipple => 'gray12',
		      );

my $eight = $canvas->createImage( ($width * .5), ($height * .5) - 20,
       -image     => $eightim,
       -anchor   => 'center',
       -tags     => ['8im'],
);


my  $testfont = $mw->Font(-family=> 'Arial', -size  => 24);

my $text    = 'This is some text';
$canvas->createText(50,50,
    -text   => $text,
    -anchor => 'nw',
    -font   => $testfont );
    
$canvas->createRectangle(47,47,290,87);

my $ebutton = $mw->Button(-text => 'Exit',
                  -command => 'Tk::exit')->pack();

my $sbutton = $mw->Button(-text => 'Scale',
                  -command => sub{
                  
                      $canvas->scale('all', 0, 0, 1.5, 1.5);
                  
                      $canvas->configure(-scrollregion=>[$canvas->bbox("all")]);
                  })->pack();


MainLoop();


###########################################
sub get_img{
my $ima8=
'/9j/4AAQSkZJRgABAQEASABIAAD/4QAWRXhpZgAATU0AKgAAAAgAAAAAAAD//gAXQ3JlYXRlZCB3
aXRoIFRoZSBHSU1Q/9sAQwAFAwQEBAMFBAQEBQUFBgcMCAcHBwcPCwsJDBEPEhIRDxERExYcFxMU
GhURERghGBodHR8fHxMXIiQiHiQcHh8e/9sAQwEFBQUHBgcOCAgOHhQRFB4eHh4eHh4eHh4eHh4e
Hh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4eHh4e/8AAEQgARQAxAwEiAAIRAQMRAf/E
ABwAAAICAwEBAAAAAAAAAAAAAAAHBggCAwUEAf/EADkQAAEDAwEFBgMECwEAAAAAAAECAwQABREG
BxIhMYEIE0FhcZFRofAiIzJiFBVCUlOCkqKxwcLx/8QAFAEBAAAAAAAAAAAAAAAAAAAAAP/EABQR
AQAAAAAAAAAAAAAAAAAAAAD/2gAMAwEAAhEDEQA/AMa3RY0iXITHix3X3lcm20FSj0HGs7XCkXG5
RoEVO8/IdS22PMnGas/onSdp0jaEtRm2u+CMyJSgApZ8Tk8kjwHh65JBEwNmOtZaAsWcspIyO+eQ
g9Uk5HUVnL2W62joKxaUvAc+7kNk+2cnpTF1Ftms0GUuPare9c9xRSXS6Gm1Ec8cCT7CtFn22WyR
JS3dLO/CbJx3rbwdA8yCEkD0zQJW4wZttkmNPiPxXxzbdQUq9jXmq199s9j1jYEtyEtSo76N5h9H
EpzyUk+H0KrHqmzSdP3+XaJR3nI690LxjfTgFKuoINBzKKKKCabE0NL2lWsOAHAdKc/ENLOacu2m
S9F2cXNUclKndxpRH7qlgKHUZHWq66euj9lvkK6xgC5FeSsAnG8M8Un1GR1qzCX7Lr7RzzUd/vIs
xvu14/GyvmAR4KBAPt4UFWc545zw5/XpXzOOOcY86l+otnOrLRKW2LVInsg/YeiNl0KHoOI6ivPZ
9A6vuchLLVjlR883JTZaQnzO9j5ZoG32eJMh7RDzDpKkRpi22vygpSopHlkk9ag3aJQ0nXcctgby
re2V4+O+4M+wFNvTlutWgdFhiTLQhiOlTsh9fDfWeZ8/AD0FV413f16m1RLuxSUNuKCWUH9lCRhP
U4yfM0HCooooM20LccDTaCtajupSBkqJ4AY8c/Cnnsx2Zy7Spu6XS6zIkpaQTGiulGE88OKH4ufI
YA8/CG7AbQ1cNaKlPpC0QI5eQCM/eEhKT0BJ9QKZG3S/SbLpBLMNwtyJ73cFY4FKACVY+Q6mg6F+
2j6RsslcR+5d++g7q246C4U+RVyz5ZzWm0bUNHXB9LH6xXEWrl+kNFCffiB1IqtIGBgE4HLj9cfP
jR68c8+FBYXaTs7XqhJnQbzJVIA3248hzfjq8k8PsE/HjSBnxJUGa9DmsrZksq3HELHFJH11507u
zxfpc61zLJKeLgg7q2Co5IQrI3fQEf3egri9o+0tMXS23htCUrlIW07jxKMbpPxOFY/lFApKKKKB
o9nGY21qmdEWQlT8TeRnxKVA49iT0qYdoW2PzdJR5sdtSzCkguADOEKGCffd96R2nLvKsN7jXaGr
D0Ze+ATgLGMFJ8iOHWrN6U1NZNW2kqiuNLUpG7IiO43kZGCFJPNPyNBVTIxzHvR4cOfhT/v2xuwT
ZKn7dNk2zfOS2kBbY9ASCB1rTaditljvpduN0lzkpIPdpQGkn15n5ig8HZutbzbNzvDiFJZeKGGC
R+LGSr/n51h2lZbfd2WCD95l15Q+A+yB/umTdLnYNH2NK5TkeBEYQUsspwCfyoT4n/01WzXOo5Oq
NRP3WQC2lQDbLROe7bGcD5k+pNBwqKKKA5ZPlW6JIkRXUvxH3Y7qRlK2llJHoQRiiigk8HaTrWI2
ENX15aR/GbQ6f6lJJ+dZydpmt5SVNqvi0Jxx7thtJ9wkEUUUEXnzptxfMmdLkSXVcCt5wrV7k15/
8UUUBRRRQf/Z';
return $ima8;
}
#######################################
__END__