File: async.pl

package info (click to toggle)
libterm-termkey-perl 0.19-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 232 kB
  • sloc: perl: 370; makefile: 5
file content (52 lines) | stat: -rw-r--r-- 1,098 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
#!/usr/bin/perl

use v5.14;
use warnings;

use IO::Select;
use Term::TermKey qw(
   FLAG_UTF8 RES_KEY RES_AGAIN RES_EOF FORMAT_VIM
);

my $select = IO::Select->new();

my $tk = Term::TermKey->new(\*STDIN);
$select->add(\*STDIN);

# ensure perl and libtermkey agree on Unicode handling
binmode( STDOUT, ":encoding(UTF-8)" ) if $tk->get_flags & FLAG_UTF8;

sub on_key
{
   my ( $tk, $key ) = @_;

   print "You pressed " . $tk->format_key( $key, FORMAT_VIM ) . "\n";
}

my $again = 0;

while(1) {
   my $timeout = $again ? $tk->get_waittime/1000 : undef;
   my @ready = $select->can_read($timeout);

   if( !@ready ) {
      my $ret;
      while( ( $ret = $tk->getkey_force( my $key ) ) == RES_KEY ) {
         on_key( $tk, $key );
      }
   }

   while( my $fh = shift @ready ) {
      if( $fh == \*STDIN ) {
         $tk->advisereadable;
         my $ret;
         while( ( $ret = $tk->getkey( my $key ) ) == RES_KEY ) {
            on_key( $tk, $key );
         }

         $again = ( $ret == RES_AGAIN );
         exit if $ret == RES_EOF;
      }
      # Deal with other filehandles here
   }
}