Detecting hit from keyboard 1

[Arepi]

Hi!

I try monitoring the keyboard in perl tk(non blocked read)
I tryed use TermReadKey but that read just from prompt shell(STDIN) I need something to non blocked read in tk(in a subrutin what i called from mainwindow)
(like in C kbhit(); function)

Thanks!

 

[Xaqte]

From:

http://search.cpan.org/src/PVHP/ptkFAQ-0_03/qna9.4.html

    #!/usr/local/bin/perl -w
    use Tk;
    $top = MainWindow->new();
    $frame = $top->Frame( -height => '6c', -width => '6c',
                            -background => 'black', -cursor => 'gobbler' );
    $frame->pack;
    $top->bind( '<Any-KeyPress>' => sub
    {
        my($c) = @_;
        my $e = $c->XEvent;
        my( $x, $y, $W, $K, $A ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );

        print "A key was pressed:\n";
        print "  x = $x\n";
        print "  y = $y\n";
        print "  W = $K\n";
        print "  K = $W\n";
        print "  A = $A\n";
    } );
    MainLoop();

 

[Arepi]

Thanks but this work just in MainWindow. I need that ina subrutin what I called from MainWindow

use Tk;
$top = MainWindow->new();
$frame = $top->Frame( -height => '6c', -width => '6c',
-background => 'black', -cursor => 'gobbler' );
$frame->pack;

$g2 = $top->Button(-text => "Button",
-command => sub{ &rutin}
);
$g2->pack();


$top->bind( '<Any-KeyPress>' => sub
{
my($c) = @_;
my $e = $c->XEvent;
my( $x, $y, $W, $K, $A ) = ( $e->x, $e->y, $e->K, $e->W, $e->A );

print "A key was pressed:\n";
print " x = $x\n";
print " y = $y\n";
print " W = $K\n";
print " K = $W\n";
print " A = $A\n";

} );

MainLoop();

sub rutin
{
while(1){}
}


So its doesnt work, I detect hit in sub rutin

 

[Kirsle]

  MainLoop();
    
    sub  rutin
    {
        while(1){}
    }

This is [red]BAD![/red]

You need to understand what Tk::MainLoop does and how Perl/Tk works. This code will demonstrate what's wrong with your code:

use Tk;

my $mw = MainWindow->new (
   -title => 'Demo',
);
$mw->Label (
   -text => "Press the button below and your GUI will freeze\n"
      . "up for 30 seconds and appear broken.",
)->pack;

$mw->Button (
   -text => "Click Here",
   -command => \&do_long_operation,
)->pack;

MainLoop;

sub do_long_operation {
   for (my $i = 0; $i < 30; $i++) {
      sleep(1);
   }
   return;
}

When your program does long operations (a while(1) loop that never ends is considered a long operation), your GUI will entirely freeze up. No buttons can be clicked on, nothing can be done with your window. MS Windows will even start to say "(Not Responding)" when you mess with the window for a while because Windows thinks your program has completely frozen up.

During a long operation you have to take care to update your GUI frequently to avoid this. Changing our code to this will demonstrate:

sub do_long_operation {
   for (my $i = 0; $i < 30; $i++) {
      sleep(1);
      $mw->update; # update the GUI
   }
   return;
}

Now, the GUI only freezes up for one second at a time, but between every loop, Tk is free to process pending keyboard presses and all other events that happened to the GUI since the last update.

Furthermore, while(1){} is very bad in general, because your Perl interpreter will loop through that SO rapidly that your CPU consumption was probably stuck around 100% cuz yer computer was giving all the resources it possibly could to let Perl loop through your empty while loop at a million miles a second.

So if you change your while loop, I bet your program will work how you want it to:

sub rutin {
   while (1) {
      select (undef,undef,undef,0.01); # sleep 1/10th of a second
         # so that the GUI never appears stuck even for
         # a second, but so Perl will be slowed down and
         # not devour 100% CPU.
      $top->update; # Update Tk.
         # Any keypress bindings you defined will be
         # processed every time update() is called.
   }
}

If curious, MainLoop() essentially does a while(1) update() automatically.

-------------
Cuvou.com | My personal homepage

perl -e '$|=$i=1;print" oo\n<|>\n_|_";x:sleep$|;print"\b",$i++%2?"/":"_";goto x;'