Two questions regarding -tk-canvas

tamaguchi has asked for the wisdom of the Perl Monks concerning the following question:

Problem1.
I have a yellow rectangle on scrolled canvas...

#!/usr/bin/perl -w

use Tk;
use strict;

# Main program / GUI setup
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas', -width => 200, -height => 200)->grid;
$c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 
+]);

#Grid
$c->createGrid(0, 0, 10, 10);
$c->createGrid(0, 0, 100, 100, -lines => 1, -dash => '.-');

$c->pack(-expand => 1, -fill => 'both');

my $rect = $c->createRectangle(20, 20, 40, 40, 
    -outline => 'yellow', 
    -fill => 'yellow');

MainLoop;
[download]

..which is the best way to make the rectangle float in the same place regardless of in which direction the canvas in scrolled?

Problem2.
Here are two rectangles red and green on a scrolled canvas...

#!/usr/bin/perl -w             
use Tk;
use strict;  
                                                
my $mw = MainWindow->new;

$mw->geometry('300x300'); #try this
 
my $c = $mw->Scrolled('Canvas',
-width => 200,
-height => 200,
-background =>'blue',
-scrollregion => [ 0, 0, 500, 500 ]
)->pack(-expand => -2, -fill => 'both');

$c->createRectangle(100, 100, 150, 150, -fill => 'red');
$c->createRectangle(100, 400, 150, 450, -fill => 'green');

my $plus = $c->Button( 
   -text    => '  +  ', 
       -command => sub {$c->scale("all", 125, 125, 2, 2); } );
   $plus->pack;      
   
my $minus = $c->Button( 
    -text    => '  .  ', 
    -command => sub {$c->scale("all", 125, 125, 0.5, 0.5); } );
   $minus->pack;  


MainLoop;
[download]

...when the canvas is zoomed by 2x by clicking the '+' button the canvas remains in the same size which means that the areas not fitting in the new zoom disapear outside the visible area. (For example it is not possible to scroll to the green rectangle when zooming once.)How is it possible to zoom in a way so that the areas over which it is possible to scroll are expanded to contain the areas that do not fit to the new larger zoom. Thank you very much for your advice.

Comment on Two questions regarding -tk-canvas Select or Download Code

Replies are listed 'Best First'.
Re: Two questions regarding -tk-canvas by Sandy (Curate) on Oct 18, 2006 at 19:49 UTC
This is my solution for problem number 1. First I created a callback for the scrolling action. This call back then gets the current canvas position (via the sub xview and yview), moves the canvas (again via xview and yview), and finally gets the new position of the canvas The return value of xview and yview is a percentage of the canvas that is not seen compared to the total scrollable area. So, it is just simple arithmetic to see how far the canvas actually scrolled. Finally, I just moved the rectangle the same amount the canvas moved. Modified Code: #!/usr/bin/perl -w use Tk; use strict; # Main program / GUI setup my $mw = MainWindow->new; my $c = $mw->Scrolled('Canvas', -width => 200, -height => 200)->grid; $c->configure(-background =>'blue', -scrollregion => [ 0, 0, 500, 500 +]); #Grid $c->createGrid(0, 0, 10, 10); $c->createGrid(0, 0, 100, 100, -lines => 1, -dash => '.-'); $c->pack(-expand => 1, -fill => 'both'); my $rect = $c->createRectangle(20, 20, 40, 40, -outline => 'yellow', -fill => 'yellow'); # get scrollbars my $xscroll = $c->Subwidget("xscrollbar"); my $yscroll = $c->Subwidget("yscrollbar"); # create callbacks for scrollbars $xscroll->configure(-command=>[\&scrolled,'x']); $yscroll->configure(-command=>[\&scrolled,'y']); MainLoop; sub scrolled { my $dir = shift; # what direction my (@xbefore,@ybefore); my (@xafter,@yafter); # debug statement print "${dir}scrolled: <",join("><",@_),">\n"; # get data before moving @xbefore = $c->xview(); @ybefore = $c->yview(); # move canvas if ($dir eq 'x') {$c->xview(@_)}; if ($dir eq 'y') {$c->yview(@_)}; # get data after moving @xafter=$c->xview(); @yafter=$c->yview(); # what is the scrollregion my @scrolls = $c->cget(-scrollregion); print "scrolled @scrolls\n"; # movement in x direction is my $xmv = ($xafter[0] - $xbefore[0])($scrolls[2]-$scrolls[0]); # movement in y direction is my $ymv = ($yafter[1] - $ybefore[1])($scrolls[3]-$scrolls[1]); # move the rectangle to compensate for canvas move print "moving $xmv $ymv\n"; $c->move($rect,$xmv,$ymv); } [download] Cheers Sandy PS: Thanks, that was fun! UPDATE: If window is expanded and contracted such that the yellow box is no longer visible, then no amount of scrolling will make it visible again. Mmmm.	[reply] [d/l]
Re^2: Two questions regarding -tk-canvas by tamaguchi (Pilgrim) on Oct 19, 2006 at 07:41 UTC
Thank very much you Sandy. Your skills are excellent.	[reply]
Re: Two questions regarding -tk-canvas by Khen1950fx (Canon) on Oct 19, 2006 at 01:32 UTC
First, my hat's off to Sandy. She did a great job. Second, a solution for the 2nd problem: I think you need to use the `-confine` option. `-confine => 1` won't allow the display to go outside the scroll region; instead, using `-confine => 0` will. Then `my $c = $mw->Scrolled('Canvas', -confine => 0 -width => 200, -height => 200, -background =>'blue' -scroll => [ 0, 0, 500, 500 ] )->pack(-expand => -2, -fill => 'both'); MainLoop;` [download]	[reply] [d/l] [select]
Re: Two questions regarding -tk-canvas by rcseege (Pilgrim) on Oct 19, 2006 at 06:35 UTC
As for question 2, all you should have to do is increase or decrease the scrollregion for the Canvas, as you scale the objects inside it. It should be a simple matter of calling cget on the -scrollregion option, and then reconfiguring it on once you've recalculated it's values. You may have to play with it a bit, but it should work. Rob	[reply]


There's more than one way to do things
	PerlMonks