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

#by originally by Chris Lamprecht
my $MAIN    = new MainWindow;

my $canvas  = $MAIN->Canvas()->pack(-expand => 'yes',
    -fill =>'both');
my  $initial_fontsize = 24;
my  $scaling_factor   = 1;
my  $l_text = "current scaling_factor : $scaling_factor";
my  $helveticaStd = $MAIN->Font(-family=> 'Arial', -size  => $initial_fontsize);

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

for my$fac (0.8,1.2){
   $MAIN->Button(-text    => "Scale by $fac",
      -command => [\&scaling,$fac]
       )->pack;
}
$MAIN->Label(-textvariable=>\$l_text)->pack;
MainLoop;

sub scaling{
   $scaling_factor *= $_[0];
   $canvas->scale('all',0,0,$_[0],$_[0]);
   $helveticaStd->configure(-size=>$initial_fontsize * $scaling_factor);
   $l_text = "current scaling_factor : $scaling_factor";
}
__END__