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

my $mw=MainWindow->new(-title=>"Print out the canvas");
my $c=$mw->Scrolled("Canvas")->pack(-expand=>1,-fill=>'both');
my $canvas=$c->Subwidget("canvas");
$canvas->createLine(100,100,20,20,-arrow=>'both',-arrowshape=>[10,10,10]);
$canvas->createOval(100,80,65,75,-fill=>"blue");
$canvas->createRectangle(30,50,60,80, -fill=>"red",-width=>5);
$canvas->createText(150,1100,-text=>"check postscript",-justify=>"left");
$canvas->createOval(150,1150,300,1300,-fill=>"blue");
$canvas->createRectangle(150,1300,400,1350, -fill=>"red",-width=>5);
$canvas->configure(-scrollregion=>[$canvas->bbox("all")]);
$canvas->update();

my $button=$canvas->Button(-text=>"Print",-command=>\&buttonDo)
							->pack(-side=>"bottom");
MainLoop;
sub buttonDo{

         $canvas->update;
         my @capture=();
         my ($x0,$y0,$x1,$y1)=$canvas->bbox('all');

         my $width = $x1-$x0;
         my $height = ($y1-$y0)/2;
         print "$width $height\n";
         
         
         @capture=('-x'=>$x0,'-y'=>$y0,-height=>$height,-width=>$width);
         
         $canvas -> postscript(-colormode=>'color',
                               -file=>"$0a.ps",
			       -rotate=>0,
			#       -width=> 500,
			#       -height=>500,    
			       @capture);


         @capture=('-x'=>$x0,'-y'=>$height ,-height=>$height,-width=>$width);
         
         print $y0 + ($y1-$y0/2),"\n";
         
         
         $canvas -> postscript(-colormode=>'color',
                               -file=>"$0b.ps",
			       -rotate=>0,
			      # -width=> 500,
			      # -height=>500,    
			       @capture);

         
         print "saved\n";
         
	}