Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Re^2: Unbind canvas items and Forget

by Phinix (Acolyte)
on Oct 31, 2012 at 20:23 UTC ( #1001742=note: print w/ replies, xml ) Need Help??


in reply to Re: Unbind canvas items and Forget
in thread Unbind canvas items and Forget

Thanks for the replies! I put together a quick example. Keep in mind this is a very rough sketch...

Basically what it does, is set up the frame/canvas structure, then invokes &scan1start; which is a subroutine to build the first fake canvas button, and bind it to right and left mouse (not the reset button, leave that alone for now!)

Clicking the button runs the next two subroutines to create two more buttons (and also changes the first button's color). I have some commented code as in my working example this changes an image not the background color, but you get the idea.

Clicking either of these new buttons will change their color, and right-clicking will change it back. Right-clicking the first button hides the two higher buttons, but only if they are "off" (black in this example.)

You can test all of this and it works fine, until you click the reset button. This button is supposed to basically destroy all the buttons, then run the initial subroutine to re-create the first button and set up it's bindings, basically starting all over. However, as you can see perl complains a ton and the button is never re-created.

Here's the sample code:

#!/usr/bin/perl use warnings; use Tk; use strict; my $mw = new MainWindow; $mw-> geometry('640x480'); $mw-> resizable( 0, 0 ); my $numscan1 = 0; my $numscan2 = 0; my $numscan3 = 0; my $leftframe = $mw-> Frame(); $leftframe->form(-left => '%0', -right => '%25', -bottom => '%99', -to +p => '%1'); my $resetb = $leftframe-> Button(-text => 'Reset', -command => \&reset + )->form(-left => '%50', -top => '%50'); my $rightframe = $mw-> Frame(-relief => 'groove', -borderwidth => 1); $rightframe-> form(-left => $leftframe, -right => '%99', -bottom => '% +99', -top => '%1'); my $maincanvas = $rightframe-> Canvas(-background => 'blue', -highligh +tthickness => 0); $maincanvas-> form(-left => '%1', -right => '%99', -bottom => '%99', - +top => '%1'); # I use canvas so I can have a background image beneath my items. # This is how I was doing that, though for this example # I'm just using background color instead: #my $maincanvasi = $mw-> Photo(-file => "background.jpg"); #$maincanvas->createImage(0,0, -image => $maincanvasi, -anchor => 'nw' +); #Here are some fake buttons using sub-canvas: my $scan1 = $maincanvas-> Canvas(-width => 64, -height => 54, -highlig +htthickness => 0); #my $scan1img1 = $maincanvas->Photo(-file => "scan1img1.jpg"); #my $scan1img2 = $maincanvas->Photo(-file => "scan1img2.jpg"); my $scan2 = $maincanvas-> Canvas(-width => 64, -height => 54, -highlig +htthickness => 0); #my $scan2img1 = $maincanvas->Photo(-file => "scan2img1.jpg"); #my $scan2img2 = $maincanvas->Photo(-file => "scan2img2.jpg"); my $scan3 = $maincanvas-> Canvas(-width => 64, -height => 54, -highlig +htthickness => 0); #my $scan3img1 = $maincanvas->Photo(-file => "scan3img1.jpg"); #my $scan3img2 = $maincanvas->Photo(-file => "scan3img2.jpg"); &scan1start; MainLoop; sub reset { my @buttons = ($scan1,$scan2,$scan3); foreach (@buttons) { $_-> destroy; } &scan1start; } sub scan1start { if ($numscan1 == 0) { $scan1-> form(-left => '187', -top => '319'); #$scan1-> createImage(0, 0, -image => $scan1img1, -anchor => ' +nw'); $scan1-> configure(-background => 'black'); $scan1-> Tk::bind('<Button-1>' => sub { #$scan1->delete($scan1img1); $numscan1 = 1; &scan2start; &scan3start; &scan1start; } ); $scan1-> Tk::bind('<Button-3>' => sub { }); } elsif ($numscan1 == 1) { $scan1-> form(-left => '187', -top => '319'); #$scan1-> createImage(0, 0, -image => $scan1img2, -anchor => ' +nw'); $scan1-> configure(-background => 'white'); $scan1-> Tk::bind('<Button-3>' => sub { if (($numscan2 == 0) && ($numscan3 == 0)) { #$scan2->delete($scan2img1); #$scan3->delete($scan3img1); #$scan1->delete($scan1img2); $scan2->formForget; $scan3->formForget; $numscan1 = 0; &scan1start; } } ); $scan1-> Tk::bind('<Button-1>' => sub { }); } } sub scan2start { if ($numscan2 == 0) { $scan2-> form(-left => '102', -top => '211'); #$scan2-> createImage(0, 0, -image => $scan2img1, -anchor => ' +nw'); $scan2-> configure(-background => 'black'); $scan2-> Tk::bind('<Button-1>' => sub { #$scan2->delete($scan2img1); $numscan2 = 1; &scan2start; } ); $scan2-> Tk::bind('<Button-3>' => sub { }); } elsif ($numscan2 == 1) { $scan2-> form(-left => '102', -top => '211'); #$scan2-> createImage(0, 0, -image => $scan2img2, -anchor => ' +nw'); $scan2-> configure(-background => 'white'); $scan2-> Tk::bind('<Button-3>' => sub { #$scan2->delete($scan2img2); $numscan2 = 0; &scan2start; } ); $scan2-> Tk::bind('<Button-1>' => sub { }); } } sub scan3start { if ($numscan3 == 0) { $scan3-> form(-left => '202', -top => '211'); #$scan3-> createImage(0, 0, -image => $scan3img1, -anchor => ' +nw'); $scan3-> configure(-background => 'black'); $scan3-> Tk::bind('<Button-1>' => sub { #$scan3->delete($scan3img1); $numscan3 = 1; &scan3start; } ); $scan3-> Tk::bind('<Button-3>' => sub { }); } elsif ($numscan3 == 1) { $scan3-> form(-left => '202', -top => '211'); #$scan3-> createImage(0, 0, -image => $scan3img2, -anchor => ' +nw'); $scan3-> configure(-background => 'white'); $scan3-> Tk::bind('<Button-3>' => sub { #$scan3->delete($scan3img2); $numscan3 = 0; &scan3start; } ); $scan3-> Tk::bind('<Button-1>' => sub { }); } }


Comment on Re^2: Unbind canvas items and Forget
Download Code
Re^3: Unbind canvas items and Forget
by zentara (Archbishop) on Nov 01, 2012 at 10:49 UTC
    Hi, your code runs, and the problem is as you describe. However, I think your problem stems from trying to use the Form manager to place multiple canvases on top of another base canvas. I may be wrong, but this is what I was taught. Forming or packing a canvas, on top of another canvas, does not make it an item of the underlying canvas.

    When you try to put another widget into another widget, as opposed to putting them in a container widget, like a frame or window, you need to use the createWindow method of the underlying Canvas. Here is a simple example.

    By the way, what sort of things are you putting in your sub-canvases? Why can't you just use a small image, and bind to it for your mouse actions? Also, buttons can be given background images, with Tk::Compound

    A second example following, shows how to hide createWindow items.

    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::JPEG; use Image::Magick; my $im = Image::Magick->new; my $image = shift || 'zen16.jpg'; #roughly a 500x500 jpg my ($width, $height, $size, $format) = $im->Ping($image); my $mw = MainWindow->new(); $mw->fontCreate('big', -family=>'courier', -weight=>'bold', -size=>int(-18*18/14)); my $canv = $mw->Canvas( -bg => 'lightsteelblue', -relief => 'sunken', -width => $width, -height => $height)->pack(-expand => 1, -fill => 'both'); my $img = $mw->Photo(-file => $image ); $canv->createImage( 0, 0, -image => $img, -anchor => 'nw' ); my $text = $mw->Scrolled('Text', -bg=>'lightyellow', -scrollbars=>'osoe', ); my $textcontainer = $canv->createWindow( $width/2, $height/2, -window => $text, -width => $width -200, -height => $height-200, -state => 'normal'); my $button = $mw->Button( -bg=>'lightblue', -text=>'Push Me', -command=> sub{ $text->insert('end',time."\n")}, ); my $butcontainer = $canv->createWindow( 125, 25, -window => $button, -width => 125, -height => 25, -state => 'normal'); my $ctext = $canv->createText( 300,20, -font=>'big', -fill=> 'white', -text=>'la di da'); bunchOfBoxes(); $text->focus; MainLoop(); sub bunchOfBoxes { for(0..10){ my $window = $canv->Checkbutton(-text=> $_); $canv->createWindow(450, 20 + ($_ * 20), -window=> $window); } }

    Showing hiding of a createWindow item

    #!/usr/bin/perl use warnings; use strict; use Tk; use Tk::JPEG; use Tk::PNG; #demonstrates need for subwidget method #on Scrolled Canvas, to use lower or raise my $mw = new MainWindow; my $canvas = $mw->Scrolled('Canvas', -bg => 'white', -xscrollincrement => 1, -yscrollincrement => 1, -confine => 1, -scrollbars => 'se', -width => 200, -height => 200, -closeenough =>3, -scrollregion => [ 0, 0, 500, 500 ], )->pack(qw/ -fill both -expand 1 -side top/); my $realcanvas = $canvas->Subwidget('scrolled'); $mw->Button(-text=>"Raise Bunny", -command => sub{ # $canvas->lower( 'bunny' ,'tux' ); # will cause error # need subwidget of the scrolled canvas $realcanvas->raise( 'bunny' ,'background' ); })->pack(); $mw->Button(-text=>"Lower Bunny", -command => sub{ $realcanvas->lower( 'bunny' ,'background' ); })->pack(); my $rect = $canvas->createRectangle(0,0,500, 500, -fill => 'orange', -tags => ['background'], ); my $bunny = $mw->Photo(-data => get_bunny() ); $canvas->createImage( 40, 40, -image => $bunny, -anchor => 'nw', -tags => ['bunny'], ); my $window = $canvas->Checkbutton(-text=> 'Foo'); my $win = $canvas->createWindow(20,20, -window=> $window, ); $canvas->move($win,-1000,-1000); #dx, dy $mw->Button(-text=>"Show Checkbox", -command => sub{ $canvas->move($win, 1000,1000 ); })->pack(); $mw->Button(-text=>"Hide Checkbox", -command => sub{ $canvas->move($win, -1000,-1000 ); })->pack(); # $canvas->lower( 'bunny' ,'background' ); # will cause error # need subwidget $realcanvas->lower( 'bunny' ,'background' ); MainLoop; sub get_bunny{ return 'iVBORw0KGgoAAAANSUhEUgAAAB4AAAAjEAIAAABcJvHFAAAACXBIWXMAAAsSAAALEgHS3 +X78AAAD F0lEQVR42u1YL+yqUBj1vfcLbhY3C44is8BIREYSG9FoNBqNkok2aFhp2BhJDWyadCZN/i +lOGxan jRdOuRsPxl/f+23vJKfX7x6+73znu5dK5RviV9QPDMMwDIPP7/f7/X6XTWU0Go1Go06n0+ +l0PM/z PC91CNu2bduWZVmW5bLpjsfj8XgcBEEQBJPJZDKZZAw0n8/n8zkCGYZhGIYgCIIgFEt3OB +wOh8OA gKZpmqZlDDedTqfTKRnO933f95GVer1er9fz0BVFURRFxCR3QfyMQfv9fr/fDyLgOI7jON +mo419k JUkMBoPBYJCRNBrxdrvdbrco6qvVarVaIWdFpQO/5tIcFBbE4nQ6nU6nJIpHjlGlEklTFE +VRFDIa T32/3+/3+3jqHMdxHBcfB2sK6HFFURRFeb1er9crfksoNUrr0GvUfxGfnA+FmX+QALDItG +LDA6O2 pQyCJFkPqxMDK2p9LodOAhQaLRjfoKRGo2wObl3G8PoDsA0Gb5Q5oonjfSNKTh96AOh+u9 +1ut1uS FuZrONPJ7bJ06tA9TDDsD6QkCnDltEDRkV1Q9AnENyuk8hcyChkkcZKo5uv1er1er3S6cA +PkFXSx MQodPrXFg2zTEsVANhO2JNdEmVo80ub7K/lSDHPyLkNaXrVarVar2W46LMuyLFsKaZ7neZ +4nvwFR NGKeGjYajUajkXz9z+RLn8/n8/ms/ANIQXq5XC6Xy/v9fr/fvw3p9Xq9Xq9VVVVV9fF4PB +6Pokhc r9fr9Vr6s6Lf4dNpbS6/exQA3BHDt/fkPl3wwT85wlcEcrCHZyHO1tmOSl95iGLcQN80Td +M0jTa1 LMuyLF3XdV03TdM0zWaz2Ww2Xdd1XRenDlDHgTbtvj/ykMZpDm/6LpfL5XLBmGi32+12G6 +Th5RAA Pne73W63iwfGYFosFovF4kOZrtVqtVoN16TD4XA4HPAAKDp5yZUkSZIk1GGz2Ww2m91ut9 +vt0Mof lcfxeDwej7PZbDaboRFbrVar1SJfIsLdYZfn8/l8Pue3y1zyiH9VAMFElb5Yp/+PcvAbH/ +25ox5S PYYAAAAASUVORK5CYII='; }

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

      I see you are using raise and lower to show/hide items rather than destroying/re-creating them. That could work, though it would require some re-coding.

      I have tried using frames rather than sub-canvas, as well as other widgets, but run into the same error when attempting to destroy and re-create bound widgets. It would be really nice to know what internal reference is being maintained to these events and stop processing on them so I could destroy and rebuild, simulating re-starting the application from scratch when their structure is initially created...

      For now the raise/lower method is an effective enough workaround, so I thank you. I would still like to discover the way to do as I intended though, eventually, just for my own edification.

        You are on the right track in your thinking, but the thing to remember is that Canvas items are NOT objects, and don't respond correctly to create/destroy ...... a Canvas is an object, but things you put into a canvas's surface are called Canvas Items. Items can be shown/hidden/deleted. Most times on a Canvas, if you wanted to reuse canvas items, you hide them, then reconfigure them in the background, then show them again. If you try to put another Canvas on top of another Canvas, it will probably not work as you expect, unless you put the other canvas into a createWindow of the underlying canvas.
        #!/usr/bin/perl use warnings; use strict; use Tk; # the -stipple=>'transparent' option will still # allow the bindings to work, but you can see the overlap # See Chapter 17 of Mastering Perl/Tk my $mw = MainWindow->new(); # first create a canvas widget my $canvas = $mw->Canvas(width => 300, height => 200)->pack(); my $one = $canvas->createOval(55, 20, 200, 190, -fill => 'blue', -outline=>'blue', -tags => ['blue'], -stipple => 'transparent', ); my $two = $canvas->createOval(105, 20, 250, 190, -fill => 'red', -outline=>'red', -tags => ['red'], -stipple => 'transparent', ); my $ebutton = $mw->Button(-text => 'Exit', -command => 'Tk::exit')->pack(); my $cbutton = $mw->Button(-text => 'Clear', -command => sub{$canvas->delete('all')})->pack(); $canvas->Tk::bind("<Motion>", [ \&print_xy, Ev('x'), Ev('y') ]); MainLoop(); sub print_xy { my ($canv, $x, $y) = @_; # print "(x,y) = ", $canv->canvasx($x), ", ", $canv->canvasy($y), "\n +"; #trick to find overlapping objects, just use x1 = x and y1 = y #to get a rectangular region of 1 point my (@current) = $canvas->find('overlapping', $x, $y, $x, $y); foreach my $id(@current){ print $canvas->gettags($id),' '; } print "\n"; }

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1001742]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2014-10-25 09:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (142 votes), past polls