Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Re^2: Tk: Scaling canvas objects

by perldough (Sexton)
on Jul 24, 2012 at 15:41 UTC ( [id://983442]=note: print w/replies, xml ) Need Help??


in reply to Re: Tk: Scaling canvas objects
in thread Tk: Scaling canvas objects

Alright, I think I've almost isolated the problem, but I feel no closer to a solution--without someone else's help, that is. :)

Let me illustrate with 2 contrasting examples. These examples only test ovals because they are the objects that are truly causing me trouble.

========================= Ex. 1 =========================

So first, when I run the whole out of one file, as you did in your example, I have no problem. The ovals scale properly and I get no error messages See code below.

review.pm 

use Tk;

our $MW  = MainWindow->new(-title => " PROXY FOR MW");
$MW->geometry("+4+5");

RC::review($MW);

MainLoop;

package RC;              

use Tk;
use Tk::PNG;
use Tk::LabFrame;
use Tk::Radiobutton;
use Tk::Pane;
use File::Basename;
use feature ':5.10';
use strict;

sub review
{
    my ($MW)    = @_;

    my ($RW, $FW, $CW) = makeReviewScreen($MW);    # Review window has
+ file & canvas sections
    paint_Info($MW, $CW, 1);  
    
    
}

sub makeReviewScreen
{
    my ($MW)    = @_;
    our $width  = $MW->screenwidth - 145;
    state $zoomLevel = 1;

    my $RW = $MW->Toplevel(-title => ' Review2');
    $RW->geometry("+0+5");

    my $LW = $RW->Frame;
    my $FW = $LW->Scrolled('Frame', -scrollbars => 'e')->pack(-expand 
+=> '1', -fill => 'y');
    my $ZW = $LW->LabFrame(-label => " ZOOM ", -labelside => "acrossto
+p", -bg => 'white');

    my $CW = $RW->Scrolled('Canvas', -width        => $width,
                                     -height       => '480',
                                     -background   => 'white',
                                     -borderwidth  => '3',
                                     -scrollbars   => 'se',
                                     -relief       => 'sunken',
                                     -scrollregion => [-100,0, 6000,40
+00]);

    foreach my $zoom (-4, -3, -2, 1, 2, 3)                 # Make the 
+diagram zoom buttons here
    {
        my $text = ($zoom > 0) ? 100 * $zoom : 100 / $zoom;
        $text    = int($text);

        $ZW->Radiobutton( -text     => "$text Percent",
                          -bg       => 'white',
                          -value    => $zoom,
                          -variable => \$zoomLevel,
                          -command  => sub { zoom($MW, $CW, $zoom);
                                             say "make $currentDwg -  
+$text %"; }
                        )->pack;
    }

    $ZW->pack(-pady => 5);
    $LW->pack(-side => 'left', -fill => 'y',    -expand => '1', -ancho
+r => 'nw', );
    $CW->pack(-side => 'left', -fill => 'both', -expand => '1' );
    return( $RW, $FW, $CW);
}


sub paint_Info     #  ($MW, $Config)
{
    my ($MW, $CW, $zoom) = @_;

    $CW->createOval( 30, 30,
                     15, 15,
                     -outline => 'red', -width => 2,
                     -tags    => ['INFO']);  

    my $zfactor = ($zoom > 0) ? $zoom : -1 / $zoom;
    $CW->scale('all', 0, 0, $zfactor, $zfactor);
}

sub zoom
{
    my ($MW, $CW, $zoom) = @_;
    
    state $already_zoom = 1;
    
    my $zoomleft = $zoom / $already_zoom;
    $already_zoom= $zoom;
    
    my $zfactor = ($zoomleft > 0) ? $zoomleft : -1 / $zoomleft;
    $CW->scale('all', 0, 0, $zfactor, $zfactor);    
}


1;

[download]
========================= Ex. 2 =========================

However, when I have a MW in a separate file which invokes the second window containing the canvas, the ovals don't scale and I get a whole wack of problems, including the original one.

Tk::Error: bad window path name "all" at review2.pm line 97.
Tk callback for .toplevel
Tk callback for .toplevel.frame
Tk callback for .toplevel.frame.frame
Tk callback for .toplevel.frame.frame.pane.frame
Tk callback for .toplevel.frame.frame.pane
Tk callback for .toplevel.frame.frame.ysbslice
Tk callback for .toplevel.frame.frame.ysbslice.corner
Tk callback for .toplevel.frame.labframe.border
Tk callback for .toplevel.frame.labframe.border.frame
Tk callback for .toplevel.frame.labframe.border.frame1
Tk callback for .toplevel.frame1
Tk callback for .toplevel.frame1.ysbslice
Tk callback for .toplevel.frame1.ysbslice.corner
Tk callback for scale
RC::paint_Info at review2.pm line 97
RC::review at review2.pm line 37
main::__ANON__ at Z:\Boolean_OCR_afsheen_3\review_caller.pl line 21
Tk callback for .frame.labframe.border.frame1.button
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Button::butUp at C:/Perl/site/lib/Tk/Button.pm line 175
<ButtonRelease-1>
(command bound to event)
Tk::Error: bad window path name "all" at review2.pm line 110.
Tk callback for scale
Tk callback for .toplevel.frame.labframe.border.frame1.radiobutton
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Radiobutton::Invoke at C:/Perl/site/lib/Tk/Radiobutton.pm line 42
<Button-1>
(command bound to event)
Tk::Error: bad window path name "all" at review2.pm line 110.
Tk callback for scale
Tk callback for .toplevel.frame.labframe.border.frame1.radiobutton1
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Radiobutton::Invoke at C:/Perl/site/lib/Tk/Radiobutton.pm line 42
<Button-1>
(command bound to event)
Tk::Error: bad window path name "all" at review2.pm line 110.
Tk callback for scale
Tk callback for .toplevel.frame.labframe.border.frame1.radiobutton2
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Radiobutton::Invoke at C:/Perl/site/lib/Tk/Radiobutton.pm line 42
<Button-1>
(command bound to event)
Tk::Error: bad window path name "all" at review2.pm line 110.
Tk callback for scale
Tk callback for .toplevel.frame.labframe.border.frame1.radiobutton3
Tk::__ANON__ at C:/Perl/site/lib/Tk.pm line 250
Tk::Radiobutton::Invoke at C:/Perl/site/lib/Tk/Radiobutton.pm line 42
<Button-1>
(command bound to event)

Here is the code:

review_caller.pl 

 use Tk;
 use Tk::DialogBox;
 use Tk::LabEntry;
 use Tk::Balloon;
 use Tk::LabFrame;
 use Tk::Scale;
 use warnings;
 use feature ':5.12';
 
 
 use review2;         
 our $MW = MainWindow->new(-title => 'Title MW');
 $MW->geometry("+120+50");



 our $FW = $MW->Frame->pack;
 our $F2 = $FW->LabFrame( -label=> ' This Frame', -relief => 'groove')
+->pack( -side => 'left');
 our $RC = $F2->Button(-text => 'Review',        -command => sub{
                  RC::review($MW);
                  })->pack(-side => 'left');
  

 MainLoop;

[download]
review2.pm (beginning slightly different) 


package RC;              

use Tk;
use Tk::PNG;
use Tk::LabFrame;
use Tk::Radiobutton;
use Tk::Pane;
use File::Basename;
use feature ':5.10';
use strict;

our $currentDwg = '';




sub review
{
    my ($MW)    = @_;

    my ($RW, $FW, $CW) = makeReviewScreen($MW);    # Review window has
+ file & canvas sections
    paint_Info($MW, $CW, 1);  
    
    
}

sub makeReviewScreen
{
    my ($MW)    = @_;
    our $width  = $MW->screenwidth - 145;
    state $zoomLevel = 1;

    my $RW = $MW->Toplevel(-title => ' Review2');
    $RW->geometry("+0+5");

    my $LW = $RW->Frame;
    my $FW = $LW->Scrolled('Frame', -scrollbars => 'e')->pack(-expand 
+=> '1', -fill => 'y');
    my $ZW = $LW->LabFrame(-label => " ZOOM ", -labelside => "acrossto
+p", -bg => 'white');

    my $CW = $RW->Scrolled('Canvas', -width        => $width,
                                     -height       => '480',
                                     -background   => 'white',
                                     -borderwidth  => '3',
                                     -scrollbars   => 'se',
                                     -relief       => 'sunken',
                                     -scrollregion => [-100,0, 6000,40
+00]);

    foreach my $zoom (-4, -3, -2, 1, 2, 3)                 # Make the 
+diagram zoom buttons here
    {
        my $text = ($zoom > 0) ? 100 * $zoom : 100 / $zoom;
        $text    = int($text);

        $ZW->Radiobutton( -text     => "$text Percent",
                          -bg       => 'white',
                          -value    => $zoom,
                          -variable => \$zoomLevel,
                          -command  => sub { zoom($MW, $CW, $zoom);
                                             say "make $currentDwg -  
+$text %"; }
                        )->pack;
    }

    $ZW->pack(-pady => 5);
    $LW->pack(-side => 'left', -fill => 'y',    -expand => '1', -ancho
+r => 'nw', );
    $CW->pack(-side => 'left', -fill => 'both', -expand => '1' );
    return( $RW, $FW, $CW);
}





sub paint_Info                            #  ($MW, $Config)
{
    my ($MW, $CW, $zoom) = @_;

    $CW->createOval( 30, 30,
                     15, 15,
                     -outline => 'red', -width => 2,
                     -tags    => ['INFO']);  

    my $zfactor = ($zoom > 0) ? $zoom : -1 / $zoom;
    $CW->scale('all', 0, 0, $zfactor, $zfactor);
}

sub zoom
{
    my ($MW, $CW, $zoom) = @_;
    
    state $already_zoom = 1;
    
    my $zoomleft = $zoom / $already_zoom;
    $already_zoom= $zoom;
    
    my $zfactor = ($zoomleft > 0) ? $zoomleft : -1 / $zoomleft;
    $CW->scale('all', 0, 0, $zfactor, $zfactor);    
}




1;

[download]

Any ideas?

Thank you very much for your time,
Perldough

Replies are listed 'Best First'.
Re^3: Tk: Scaling canvas objects
by zentara (Archbishop) on Jul 24, 2012 at 16:42 UTC
    When I run your review2.pm, I get your error. But I added a line which shows the problem. I can't figure out why it allowed you to create an Oval to begin with.? 
    sub paint_Info{
 
 #this shows the problem   
 my ($MW, $CW, $zoom) = @_; 
 print "\n\n@_\n\n";

    $CW->createOval( 30, 30,
                     15, 15,
                     -outline => 'red', -width => 2,
                     -tags    => ['INFO']);

    my $zfactor = ($zoom > 0) ? $zoom : -1 / $zoom;
    $CW->scale('all', 0, 0, $zfactor, $zfactor);
}

    [download]
    When you print out @_, you get
    MainWindow=HASH(0x7b8078) Tk::Frame=HASH(0xe2bfb0) 1
    You then take $_1 and try to run Canvas methods on it. Scale will not run on a Frame, that is a Canvas method.

    It just dawned on me! Your Frame is the Scrolled Frame the Canvas is in. Try getting the real canvas in your module. This fixes it! :-) 

     
sub paint_Info                            #  ($MW, $Config)
{
    my ($MW, $CW, $zoom) = @_;

print "\n\n@_\n\n";

    my $canvas = $CW->Subwidget('canvas');

    $canvas->createOval( 30, 30,
                     15, 15,
                     -outline => 'red', -width => 2,
                     -tags    => ['INFO']);

    my $zfactor = ($zoom > 0) ? $zoom : -1 / $zoom;
    $canvas->scale('all', 0, 0, $zfactor, $zfactor);
}

    [download]
    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
[select]

      That fix works for me too! Thanks! =D

      Sorry, but I don't think I understand why this is necessary. Why didn't I have this problem when I had the whole thing running out of a single file?

      Thanks,
      Perldough
[reply]
        I'm not sure why it works in a monolithic script, but not in your modules. It must have something to do with how the Scrolled widget works, and your module's @ISA. This is not the only time you will encounter this with Scrolled Canveses or Text widgets. Most of the Scrolled widget's internals get passed on, but some don't. The most notable of these is using Balloons on Scrolled widgets.... you most often need to bind to the actual Subwidget, the Scrolled widget is finicky.

        By the way, if you are serious about zooming, rotating, and scaling on a Canvas, you should look at Tk::Zinc, it still works well even if it isn't being maintained.

        I'm not really a human, but I play one on earth.
        Old Perl Programmer Haiku ................... flash japh
[reply]

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://983442]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others admiring the Monastery: (6)
As of 2024-04-23 21:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found