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

Friends,

I can't figure out how to set a callback for a mouse click on my canvas. I have this code ... 
#!/usr/bin/perl -w

use strict;

use Tk;
use Tk::Canvas;
use Getopt::Std;
my $width       = 250;
my $height      = 250;
my $units       = 10;
my $background  = 'blue';
my $fill        = 'yellow';
my %opts        = ();
getopts( 'W:H:b:f:u:h', \%opts );
if( $opts{W} ) { $width         = $opts{W} ; }
if( $opts{H} ) { $height        = $opts{H} ; }
if( $opts{b} ) { $background    = $opts{b} ; }
if( $opts{f} ) { $fill          = $opts{f} ; }
if( $opts{u} ) { $units         = $opts{u} ; }

my $dx = $width  / $units;
my $dy = $height / $units;


my $top = MainWindow->new();
my $can = $top->Canvas( -width => $width, -height=> $height )->pack();

drawGrid( $can );

my $root = "BLAHBLAHBLAH";

$can->bind( \$can, '<Button-1>', \&my_test( $root ) );

MainLoop;

sub drawGrid {
        my $can = shift;
        my $X=0;
        for ( my $x=0; $x < $units; $x++ ) {
                $can->create( 'line' , $X , 0 , $X , $can->reqheight()
+ ); $X += $dx;
        }
        my $Y=0;
        for ( my $y=0; $y < $units; $y++ ) {
                $can->create( 'line' , 0 , $Y , $can->reqwidth() , $Y)
+; $Y += $dy;
        }
}

sub my_test {
        my $msg = shift;
        print "$msg\n";
}

[download]
... and the problem with this code is that the sub my_test executes from the MainLoop starts and not when I click the mouse on the canvas. I want my_test to execute when I click the mouse on the canvas.

Thanks

Plankton: 1% Evil, 99% Hot Gas.

Replies are listed 'Best First'.
Re: Tk bind mouse down question
by davidj (Priest) on Jun 01, 2004 at 16:08 UTC
    Use the CanvasBind method and put the function call in a sub:

    On the line
    $can->bind( \$can, '<Button-1>', \&my_test( $root ) );
    You should have
    $can->CanvasBind('<Button-1>', sub { \&my_test($root) } );

    Then it will work.

    hope this helps,
    davidj
[reply]
[d/l]
[select]
      Thanks ... that's what I needed CanvasBind. Here's what I changed my code to ... 
      my $root = "BLAHBLAHBLAH";

$can->CanvasBind( '<Button>', [ \&my_test, $root ] );

MainLoop;

...

sub my_test {
    shift;    # don't know why I have to do this, but ...
    my $msg = shift;
    print "[$msg]\n";
}

      [download]

      Plankton: 1% Evil, 99% Hot Gas.
[reply]
[d/l]
        sub my_test {
    shift; # don't know why I have to do this, but ...

        [download]

        You have to do that because when you bind a sub to an event, and that event occurs, the sub always gets the widget handle that received the event as its first arg.

        It's done this way so that you can bind a sub to a given even in all widgets of a given type (or any bunch of widgets that are supposed to invoke the same behavior), and when the bound sub actually gets called, you have the reference to the particular widget that received the event, just because that may come in handy in a variety of different cases.

[reply]
[d/l]
Re: Tk bind mouse down question
by Sandy (Curate) on Jun 01, 2004 at 15:52 UTC
    Why it doesn't work is explained nicely by dave_the_m in a related post Binding TK events.
    \&mysub creates a reference to the sub mysub; 
    \&mysub(...)

    [download]
    calls mysub, then creates a reference to the returned value
    and by davidj in the same post
    "When you want to pass arguments to a callbakc, specify an array reference, with the callback code reference as the first element and the callback arguments as the subsequent array elements" In other words: instead of 
    
$input->bind('<Return>', [\&mysub($arg)]);

    [download]
    you need to have 
    $input->bind('<Return>', [\&mysub, $arg]);

    [download]
    Thus... what happens is instead of binding my_test to 'can', you are executing 'my_test' and binding the result to 'can'. This happens I guess in the main_loop.

    UPDATE: Fixed format of quoted text

[reply]
[d/l]
[select]
      Okay so I changed my code like so ... 
      #$can->bind( \$can, '<Button-1>', \&my_test( $root ) );
$can->bind( '<Button>', [ \&my_test, $root ] );

      [download]
      ... now I get this error message ... 
      $ ./bind_test.pl
 at c:/Perl/site/lib/Tk.pm line 228.

      [download]
      Did I misunderstand something?
      Thanks

      Plankton: 1% Evil, 99% Hot Gas.
[reply]
[d/l]
[select]
        Try this:
        $top->bind($can, '<Button-1>', sub{my_test(root)});

        [download]
[reply]
[d/l]
Re: Tk bind mouse down question
by davidj (Priest) on Jun 01, 2004 at 18:19 UTC
    Ok, I've been a bit whacky today regarding this node.
    Maybe its because I had to work all weekend and everyone else was on vacation :).

    I will post this on the "Binding Tk event" node since it is the same issue.

    here is the clarification for Calling subs/functions from tk bound widgets:

    subs/functions can be called in 3 basic ways as the following code will demonstrate.
    1) directly
    2) using the sub function
    3) using an anonymous array

    If you want to pass arguments to the called sub you will need to use method 2 or 3.

    The code below demonstrates these 3 three methods.
    Notice closely the difference between what happens in the subs called by $button2 and $button4. Specifically, $button4 requires an initial shift; because an anonymous array is being used. Without this shift the print statement in the sub would attempt to print the tk::button information (which is stored in a hash).

    code
    use Tk;
use strict;

my $mw = MainWindow->new();

my $button1 = $mw->Button(-text => "on release 1")->pack();
$button1->bind('<ButtonRelease 1>' => \&doit1 );

my $msg = "pressed 2";
my $button2 = $mw->Button(-text =>  "on realease 2")->pack();
$button2->bind('<ButtonRelease 1>' => sub { \&doit2($msg) } );

my $button3 = $mw->Button(-text => "on release 3")->pack();
$button3->bind('<ButtonRelease 1>' => [\&doit3]);

my $msg1 = "pressed 4";
my $button4 = $mw->Button(-text => "on release 4")->pack();
$button4->bind('<ButtonRelease 1>' => [\&doit4, $msg1]);

MainLoop;

sub doit1(){
   print "pressed 1\n";
}
sub doit2(){
   my $msg = shift;
   print "$msg\n";
}
sub doit3(){
   print "pressed 3\n";
}
sub doit4(){
   shift;
   my $msg = shift;
   print "$msg\n";
}

    [download]

    output from pressing each button in order:
    pressed 1
pressed 2
pressed 3
pressed 4

    [download]

    Finally, any thoughts about putting this in the tutorials or Q&A section? Or is it not up to par?

    davidj
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom