The New PerlTk.org - Zooming & Scaling using Tk::Canvas
www.mamboteam.com
The New PerlTk.org  
Home
Monday, 01 September 2014
 
 
Main Menu
Home
Perl/Tk Widgets
Articles
Scripts
Useful Tips
Links
Contact Us
Search
FAQs
Login Form
Username

Password

Remember me
Forgotten your password?
No account yet? Create one
Zooming & Scaling using Tk::Canvas PDF Print E-mail
Written by Ala Qumsieh   
By Ala Qumsieh (ala_qumsieh at yahoo dot com)

In the past I have struggled to properly implement zooming and scaling of canvas objects. If you are interested in doing those operations, then I believe this article will be useful. Basically, in this article, I will develop a program that allows the drawing of any widget on screen, and allows to arbitrarily zoom into any user-defined window.

First, let's start with the basics. Let's create a window that just contains a canvas.


  #!/usr/bin/perl

  use strict;
  use warnings;
  use Tk;

  my $box = [0, 0, 500, 500];

  my $mw = new MainWindow;
  my $c  = $mw->Scrolled(qw/
         Canvas -bg black
         -xscrollincrement 1
         -yscrollincrement 1
         -confine 1
         -scrollbars se
         -width 500
         -height 500/,
         -scrollregion => $box,
         );
  $c->pack(qw/-fill both -expand 1 -side top/);

  $mw->bind('<Any-Enter>' => sub { $c->Tk::focus });

  MainLoop;
This will simply create a canvas in a window. Note how I used the Scrolled() megawidget, which simply creates the desired widget (in our case, a canvas) with scrollbars. The positions of the scrollbars are defined using the '-scrollbars' option, which the only option specific to Scrolled().

All other options are specific of the canvas. The '-(x|y)scrollincrement' options control the amount of vertical and horizontal scrolling in screen units. The '-scrollregion' option sets the area of the canvas that is scrollable. Understanding this is key to knowing how to properly scale objects on canvases. Note that at any point in time, the currently visible area of the canvas could be smaller (if you are zoomed in) or larger (if you are zoomed out) than the scrollregion. In most practical purposes, however, we are not interested in anything outside the scrollregion, so we have to ask the canvas to confine us to it. This is precisely what the '-confine' option does; if set to 1, it tells the canvas that we can not set the view outside the scrollregion.

We also declared an anonymous array, stored in $box, that keeps track of the bounding box of our canvas.

The idea of the scrollregion confused me at the beginning, because I thought that it was the area of the canvas that is currently displayed on my screen. So lets set things straight. It is NOT. If you set the '-confine' to 1, then the scrollregion defines your total canvas area that you are allowed to view by scrolling around using the scrollbars.

Finally, we bind our window such that whenever the mouse is over our window, the canvas takes the focus.

Now that we have our canvas, let's define a simple function that will draw a square of arbitrary size wherever you click on the cavas with the first mouse button.


  $c->CanvasBind('<1>' => sub {
      my ($x, $y) = ($Tk::event->x, $Tk::event->y);

      my $size = rand 100;
      $c->createRectangle($x, $y, 
                          $x+$size, $y+$size,
                          -fill => 'white');
  });
Notice here that I have used the CanvasBind method, which is new for Tk8.00, and is simply a wrapper around Tk::bind. If you have a recent enough version of Tk, then I suggest that you always use CanvasBind for canvases. Else, upgrade your Tk and use it!

Now comes the fun part. I would like to use the third mouse button to be able to draw a red rectangular region where I want to zoom. The zoom scale depends on the size of the rectangle: the smaller the rectangle, the bigger the zoom factor. Also, to make things look nicer, I would like an outline of the rectangle to be drawn as we are defining it. To do that, we need to bind the following:

  • 1. pressing button 3 : this will start drawing the rectangle.
  • 2. dragging button 3 : this will alter the size of the rectangle as the mouse pointer moves.
  • 3. releasing button 3: this will delete the rectangle we created, and zoom in.
Part 1 looks like this:

  my $zoomRect;
  my @zoomRectCoords;
  $c->CanvasBind('<3>' => sub {
      my $x = $c->canvasx($Tk::event->x);
      my $y = $c->canvasy($Tk::event->y);

      @zoomRectCoords = ($x, $y, $x, $y);
    
      $zoomRect = $c->createRectangle(
                                      @zoomRectCoords,
                                      -outline => 'red',
                                      );
  });
Here, we defined a scalar $zoomRect that will contain the object ID of the rectangle. We also use an array @zoomRectCoords to store the current coordinates of the rectangle.

Part 2 is similarly simple and looks like this:


  $c->CanvasBind('' => sub {
      @zoomRectCoords[2,3] = ($c->canvasx($Tk::event->x),
      $c->canvasy($Tk::event->y));
    
      $c->coords($zoomRect => @zoomRectCoords);
  });
which simply updates the contents of the @zoomRectCoords array, and updates the rectangle's size accordingly.

Part 3 is a bit tougher, and looks like this:


  $c->CanvasBind('' => sub {
      # Delete the rectangle.
      $c->delete($zoomRect);
    
      # Was the rectangle big enough?
      return if abs($zoomRectCoords[0] - $zoomRectCoords[2]) < 10 ||
                abs($zoomRectCoords[1] - $zoomRectCoords[3]) < 10;
    
      # Let's find the zooming factor.
      my $dx = $c->width  /abs($zoomRectCoords[0] - $zoomRectCoords[2]);
      my $dy = $c->height /abs($zoomRectCoords[1] - $zoomRectCoords[3]);
    
      my $scale = [$dx => $dy] -> [$dy <= $dx];

      # Let's scale everything up.
      $c->scale('all' => 0, 0, $scale, $scale);

      # Modify the bounding box.
      $_ *= $scale for @$box;

      # Resize the scrollregion.
      $c->configure(-scrollregion => $box);
    
      # Now we change the view to center on correct area.
      $c->xviewMoveto($zoomRectCoords[0] * $scale / $box->[2]);
      $c->yviewMoveto($zoomRectCoords[1] * $scale / $box->[3]);
  });
Let's examine this. First of all, we delete the rectangle because we don't need it anymore. It was simply there to give us a visual indication of the area we want to zoom in. Then, we impose a restriction that the zoom area has to be at least 10 pixels by 10 pixels large. There is no reason for this restriction and could be removed.

Now we want to find out what our zooming factor is. If we think about it a little bit, we can readily see that the zoom factor in the x direction is simply the ratio of the width of the canvas to the width of the zoom rectangle. Similarly, the zoom factor in the y direction is the ratio of the height of the canvas to the height of the zoom rectangle. This is precisely what we compute and store in $dx and $dy respectively. But, our rectangle is not necessarily a square, and $dx will almost certainly be different from $dy. If we simply scale in the x-direction by a factor $dx, and in the y direction by a factor of $dy, we will distort our canvas objects. Usually, we don't want that. So, we scale in both directions by the smaller of $dx and $dy. In $scale, we store precisely that. The line:


  my $scale = [$dx => $dy] -> [$dy <= $dx];
is a fancy way of doing:

my $scale = $dx < $dy ? $dx : $dy;
(who said Perl wasn't fun?)

Having figured all of this out, we now do the actual scaling, which is done using the scale() method of the canvas. Since scaling affects only the objects within the canvas, and not the size of the canvas itself, we have to redefine our scrollregion. So, we update the contents of our $box variable by multiplying each entry in the anonymous array by the scale factor. Then we reconfigure the canvas and set the new bounding box using the configure() method.

If we end our callback here, we will see that we have properly zoomed using the correct zoom factor, but our view will be centered at the top left corner of our canvas. This is what the canvas view defaults to when our scrollregion is bigger than our view window. In order to center our view at the desired area (which we outlined with the red rectangle), we need to shift the canvas view to bring the top left corner of our view over the top left corner of the zoom rectangle. To do this, we use the (x|y)viewMoveto methods.

The xviewMoveto() method takes one argument which has to be less than 1. The argument basically tells the widget to adjust its view such that this fraction of the total width of the widget is off-screen to the left. Similarly the yviewMoveto() method adjusts the view such that the specific fraction of the widgets height is off-screen to the top.

In our case, the fraction of the view in the x-direction will be equal to the x coordinate of the top left corner of the zoom box divided by the width of the scrollregion. Similarly, the fraction of the view in the y-direection will be equal to the y coordinate of the top left corner of the zoom box divided by the height of the scrollregion. We use those two fractions as the arguments for the (x|y)viewMoveto methods to adjust our view, and voila!

To complete the example, let's create a binding that will restore the original size and view of our canvas. I will call it 'Fit' and will thus bind it to the letter 'f':


  $c->CanvasBind('' => sub {
      my $scale = 500/$box->[2];

      $c->scale('all' => 0, 0, $scale, $scale);

      $box = [0, 0, 500, 500];

      $c->configure(-scrollregion => $box);
  });
Whenever the key 'f' is pressed, we scale everything back to their original size.

Put together, the whole program looks like this:


#!/usr/bin/perl

use strict;
use warnings;
use Tk;

my $box = [0, 0, 500, 500];

my $mw = new MainWindow;

my $c  = $mw->Scrolled(qw/
       Canvas -bg black
       -xscrollincrement 1
       -yscrollincrement 1
       -confine 1
       -scrollbars se
       -width 500
       -height 500/,
       -scrollregion => $box,
       );

$c->pack(qw/-fill both -expand 1 -side top/);

$mw->bind('<Any-Enter>' => sub { $c->Tk::focus });

$c->CanvasBind('<1>' => sub {
    my ($x, $y) = ($Tk::event->x, $Tk::event->y);

    my $size = rand 100;
    $c->createRectangle($x, $y, 
                        $x+$size, $y+$size,
                        -fill => 'white');
});

my $zoomRect;
my @zoomRectCoords;

$c->CanvasBind('<3>' => sub {
    my $x = $c->canvasx($Tk::event->x);
    my $y = $c->canvasy($Tk::event->y);

    @zoomRectCoords = ($x, $y, $x, $y);
    
    $zoomRect = $c->createRectangle(
                                    @zoomRectCoords,
                                    -outline => 'red',
                                   );
});

$c->CanvasBind('' => sub {
    @zoomRectCoords[2,3] = ($c->canvasx($Tk::event->x),
    $c->canvasy($Tk::event->y));
    
    $c->coords($zoomRect => @zoomRectCoords);

});

$c->CanvasBind('' => sub {
    # Delete the rectangle.
    $c->delete($zoomRect);
    
    # Was the rectangle big enough?
    return if abs($zoomRectCoords[0] - $zoomRectCoords[2]) < 10 ||
              abs($zoomRectCoords[1] - $zoomRectCoords[3]) < 10;
    
    # Let's find the zooming factor.
    my $dx = $c->width  /abs($zoomRectCoords[0] - $zoomRectCoords[2]);
    my $dy = $c->height /abs($zoomRectCoords[1] - $zoomRectCoords[3]);
    
    my $scale = [$dx => $dy] -> [$dy <= $dx];

    # Let's scale everything up.
    $c->scale('all' => 0, 0, $scale, $scale);

    # Modify the bounding box.
    $_ *= $scale for @$box;

    # Resize the scrollregion.
    $c->configure(-scrollregion => $box);
    
    # Now we change the view to center on correct area.

    $c->xviewMoveto($zoomRectCoords[0] * $scale / $box->[2]);
    $c->yviewMoveto($zoomRectCoords[1] * $scale / $box->[3]);
});

$c->CanvasBind('' => sub {
    my $scale = 500/$box->[2];

    $c->scale('all' => 0, 0, $scale, $scale);

    $box = [0, 0, 500, 500];

    $c->configure(-scrollregion => $box);
});

MainLoop;

__END__

Comments
Written by nikhil on 2005-09-01 00:21:34
:sigh  
I am using this code. It doesn't seem to work. 
I have an activestate perl release installed. 
 
The problem is with mouse button -3, zoom, which doesn't seem to happen. 
On button=-3 press, the program seems to put out small red dot on the canvas widget, but does not draw a rectangle which vanishes later on mouse button release
Written by nikhil on 2005-09-01 03:03:25
I realized that the buttons were bound to nothing for a couple of CanvasBind procedures. 
 
The code seems to work after those modifications. 
Thanks for the excellent code.
Written by ala on 2005-09-25 21:56:08
Yeah, I had a bug in my HTML that confused the angled brackets in the first argument to CanvasBind() for HTML code. Sorry about that.
Written by JenSpin on 2006-09-05 12:19:20
Thanks so much for writing this -- it was exactly what I was looking for. The only problem I'm having is that key binding doesn't seem to work.. but I just replaced that with a binding to the second mouse button. 
 
If you want to fix the bug in your html, you can replace the offending brackets with < (open) and [I]=[I] (close). 
 
Thanks again!
Written by JenSpin on 2006-09-05 12:21:49
Whoops -- my last comment got interpreted apparantley... and it turns out I was wrong too!  
Use &-#-60-; for an open angle bracket and &-#-62-; for a closed angle bracket.  
 
Hope that works. :)
One modification to fix centering
Written by JenSpin on 2006-09-05 18:02:02
I love this code, very very helpful. 
 
I made one minor modification in my own implementation that others might find helpful. I replaced 
Code:
$c->xviewMoveto($zoomRectCoords[0] * $scale / $box->[2]); $c->yviewMoveto($zoomRectCoords[1] * $scale / $box->[3]); 

 
with 
Code:
 
my $xmove = $zoomRectCoords[0] < $zoomRectCoords[2] ? $zoomRectCoords[0] : $zoomRectCoords[2]; 
my $ymove = $zoomRectCoords[1] < $zoomRectCoords[3] ? $zoomRectCoords[1] : $zoomRectCoords[3]; 
 
$xmove *= $scale / $box->[2]; 
$ymove *= $scale / $box->[3]; 
 
$c->xviewMoveto($xmove); 
$c->yviewMoveto($ymove); 

 
 
so that it centers correctly no matter how you drag the rectangle. In the original code, the centering only worked properly if you dragged the zoom rectangle down and to the right. This seems to take care of all the cases.

Only registered users can write comments.
Please login or register.

Powered by AkoComment 2.0!

< Prev
 
Top! Top!