#!/usr/bin/perl -w
                                                                      
+          
use Tk;
                                                                      
+          
use strict;
use warnings;
                                                                      
+          
my $mw = new MainWindow();

$mw->bind( '<KeyPress-Control-a>', sub {print "Button a has been press
+ed\n"} );
$mw->bind( '<KeyPress-Control-a>', sub {print "Button a has been relea
+sed\n"} );

MainLoop;

# Produces ...
bad event type or keysym "Control" at
/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi/Tk/Derived.pm l
+ine 469.

# My version of Perl
This is perl, v5.8.0 built for i386-linux-thread-multi
[download]

This program creates a yellow rectangle on a canvas. The rectangle is possible to move up, down, left, and right by the respective arrow keys.

  
#!/usr/bin/perl -w            
use Tk;
use strict;  
      
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas',
-width => 200,
-height => 200,
-background =>'blue',
-scrollregion => [ 0, 0, 500, 500 ]
);

$c->pack(-expand => 1, -fill => 'both');
my $rect=$c->createRectangle(100, 100, 150, 150, -fill => 'yellow');  
+    
    
    $mw->bind('<KeyPress-Left>', sub{$c->move($rect, -5, 0);});
    $mw->bind('<KeyPress-Right>', sub{$c->move($rect, 5, 0);});
    $mw->bind('<KeyPress-Up>', sub{$c->move($rect, 0, -5);});
    $mw->bind('<KeyPress-Down>', sub{$c->move($rect, 0, 5);});
    
    my @coords_list = $c->coords($rect);

MainLoop;
[download]

Now I would like to be able to move the rectangle on the diagonal by pressing for example both up and right. To write:

$mw->bind('<Right-KeyPress-Up>', sub{$c->move($rect, 5, -5);});
[download]

..is however not possible do you have any other suggestions how to bind two arrowkeys to an event?

Thanks for providing the small functional example! You might consider doing some variation of this:

use Tk;
use strict;  
      
my $mw = MainWindow->new;
my $c = $mw->Scrolled('Canvas',
   -width => 200,
   -height => 200,
   -background =>'blue',
   -scrollregion => [ 0, 0, 500, 500 ]
)->pack(qw/-expand 1 -fill both/);

## Bind Both Press and Release events
my $keyHR = {};
$mw->bind('<KeyPress-Up>',      [\&ButtonPress,   "up",    $keyHR]);
$mw->bind('<KeyPress-Down>',    [\&ButtonPress,   "down",  $keyHR]);
$mw->bind('<KeyPress-Right>',   [\&ButtonPress,   "right", $keyHR]);
$mw->bind('<KeyPress-Left>',    [\&ButtonPress,   "left",  $keyHR]);
$mw->bind('<KeyRelease-Up>',    [\&ButtonRelease, "up",    $keyHR]);
$mw->bind('<KeyRelease-Down>',  [\&ButtonRelease, "down",  $keyHR]);
$mw->bind('<KeyRelease-Right>', [\&ButtonRelease, "right", $keyHR]);
$mw->bind('<KeyRelease-Left>',  [\&ButtonRelease, "left",  $keyHR]);

my $rect = 
   $c->createRectangle(100, 100, 150, 150, -fill => 'yellow');      

MainLoop;

sub ButtonRelease {
   my ($w, $dirKey, $keyHR) = @_;
   $keyHR->{$dirKey} = 0;
   Move($keyHR);
}

sub ButtonPress {
   my ($w, $dirKey, $keyHR) = @_;
   $keyHR->{$dirKey} = 1;
   Move($keyHR);
}

sub Move {
   my $keyHR = shift;
   my $speed = 5;

   my $x = 0;
   $x += $speed if $keyHR->{right};
   $x -= $speed if $keyHR->{left};
    
   my $y = 0;
   $y += $speed if $keyHR->{down};
   $y -= $speed if $keyHR->{up};
   $c->move($rect, $x, $y);
}
[download]

Rob

Hi tamaguchi,

No, there's no way to do it using multiple keypresses (that I'm aware of).  And even if you could, there would be a problem when you held the 2 keys down, and relied on key repeats; whichever key you pressed "last" will dictate the direction that the object moves in.

You can try it yourself by holding down the left and up arrow, for example; the initial movement might appear to be a "wobbly" northwest movement, but after the repeat kicks in, the square will only move left or up.

My recommendation would be to assign a completely different set of keys.  For example, you could use the 8 keys centered around the "k":

    my $pbindings = {
        'Key-j'  => sub { $c->move($rect, -5,  0) },
        'Key-l'  => sub { $c->move($rect,  5,  0) },
        'Key-i'  => sub { $c->move($rect,  0, -5) },
        'comma'  => sub { $c->move($rect,  0,  5) },
        'Key-u'  => sub { $c->move($rect, -5, -5) },
        'Key-o'  => sub { $c->move($rect,  5, -5) },
        'Key-m'  => sub { $c->move($rect, -5,  5) },
        'period' => sub { $c->move($rect,  5,  5) },
    };
                                                                      
+          
    map { $mw->bind("<$_>" => $pbindings->{$_}) } (keys %$pbindings);
[download]

---

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/