detect keyboard input without reading it?

Discussion in 'Perl' started by Scott Shaw, Nov 9, 2003.

  1. Scott Shaw

    Scott Shaw Guest

    Hi all,
    I was wondering if you could help out with this problem that I am having.
    What I am trying to do is detect keyboard input in a while loop without
    halting/pausing the loop until the key is pressed (without hitting return).
    I looked at serveral faq's on the net and installed the cspan readkey module
    and neither seems to work most likey its me since I am getting frustrated.
    but anyway here's a sample code.

    while (1) {
    if (keypress) {
    print "you've pressed: $key\n";
    }
    else {
    print"Continuing to loop...\n";
    sleep 1; # delay the loop incase you need to control-c out.
    }
    }

    TIA!
    Scott Shaw
     
    Scott Shaw, Nov 9, 2003
    #1
    1. Advertising

  2. Scott Shaw

    J. Romano Guest

    "Scott Shaw" <> wrote in message news:<%Purb.116619$>...

    > I was wondering if you could help out with this problem that I am having.
    > What I am trying to do is detect keyboard input in a while loop without
    > halting/pausing the loop until the key is pressed (without hitting return).
    > I looked at serveral faq's on the net and installed the cspan readkey module
    > and neither seems to work most likey its me since I am getting frustrated.


    Dear Scott,

    I know I've been frustrated trying to make a portable Perl program
    that accepts individual keystrokes. The simple solution is to install
    the Term::ReadKey module, but that isn't always an option since it's
    not always possible to install modules on every platform you'll
    encounter.

    Therefore, I wrote the following script to provide a portable way
    to read individual keystrokes without resorting to non-standard Perl
    modules. You can run it to see a demo, and then just replace the demo
    code with your code. It's been tested on aix, linux, sunos, darwin
    (MacOS X), and ActiveState Perl (for Win32). It seems to work exactly
    the same on all platforms except that restoreCursorPosition() didn't
    seem to work on MacOS X. In order to make my code support all those
    platforms, I had to check to see what OS it was running on, and then
    carry out the special case for that OS. As a result, my code is quite
    lengthy, but it works.

    To do what you want to do, I recommend removing the lines after
    "package main;" and replacing them with:

    $| = 1; # autoflush
    PortableReadKey::getKeyInit();

    while (1) {
    my $key = PortableReadKey::getKeyNonBlocking();

    if (defined $key) {
    print "you've pressed: $key\n";
    }
    else {
    print"Continuing to loop...\n";
    sleep 1; # delay the loop incase you need to control-c out.
    }
    }

    I included the full program down below. I suggest you try it to
    get a feel of what it can do. Feel free to use it, study it, and/or
    modify it (in other words, this program is in the public domain). The
    code I mentioned is included below. Once you test it out a few times,
    you can put the code above into the "package main" section of the code
    below.

    Got it? Let me know if you don't quite understand.

    I hope this helps.

    -- Jean-Luc


    And here is the code:

    #!/usr/bin/perl -w

    use strict;

    package PortableReadKey;

    my $type;
    my @bsd = qw(darwin);
    my @non_bsd = qw(aix linux sunos);

    use IO::Select;
    my $s = IO::Select->new();
    $s->add(\*STDIN);

    my ($old_mode, $input_con, $output_con); # for win32
    my ($saved_x, $saved_y) = (0,0); # for win32

    sub getKeyInit {
    if ($^O eq "MSWin32") {
    unless (eval "require Win32::Console") {
    die "Cannot find module Win32::Console";
    }
    $type = "win32";
    $input_con = new Win32::Console(
    Win32::Console::STD_INPUT_HANDLE() );
    $old_mode = $input_con->Mode();
    $output_con = new Win32::Console(
    Win32::Console::STD_OUTPUT_HANDLE() );
    } elsif (eval "require Term::ReadKey") {
    # print "\nUsing Term::ReadKey...\n";
    $type = "ReadKey";
    } elsif (grep {$^O eq $_} @bsd) { $type = "bsd";
    } elsif (grep {$^O eq $_} @non_bsd) { $type = "non_bsd";
    } else {
    print "Could not determinte type for \"$^O\".\nExiting...\n";
    exit(1);
    }
    }

    sub turnOffEcho {
    my $break_out = 0;
    if ($type eq "ReadKey") {
    Term::ReadKey::ReadMode('cbreak');
    } elsif ($type eq "bsd") {
    # No idea if this works:
    system "stty cbreak -echo </dev/tty >/dev/tty 2>&1";
    $break_out = 1 if $?; # if true, user most likely hit CTRL-C
    } elsif ($type eq "non_bsd") {
    system("stty", '-echo', '-icanon', 'eol', "\001");
    $break_out = 1 if $?; # if true, user most likely hit CTRL-C
    } elsif ($type eq "win32") {
    $input_con->Mode(
    ~(Win32::Console::ENABLE_LINE_INPUT()
    | Win32::Console::ENABLE_ECHO_INPUT())
    & $old_mode );
    } else { die "\nsub getKeyInit() was never called";
    }
    if ($break_out) {
    PortableReadKey::turnOnEcho();
    print "\n";
    if (exists $SIG{INT} && $SIG{INT}) {
    &{$SIG{INT}};
    } else {
    exit(1);
    }
    }
    }

    sub turnOnEcho {
    my $break_out = 0;
    if ($type eq "ReadKey") {
    Term::ReadKey::ReadMode('normal');
    } elsif ($type eq "bsd") {
    # No idea if this works:
    system "stty -cbreak echo </dev/tty >/dev/tty 2>&1";
    $break_out = 1 if $?; # if true, user most likely hit CTRL-C
    } elsif ($type eq "non_bsd") {
    system("stty", 'echo', 'icanon', 'eol', '^@'); # ASCII null
    $break_out = 1 if $?; # if true, user most likely hit CTRL-C
    } elsif ($type eq "win32") { $input_con->Mode( $old_mode);
    } else { die "\nsub getKeyInit() was never called";
    }
    if ($break_out) {
    print "\n";
    if (exists $SIG{INT} && $SIG{INT}) {
    &{$SIG{INT}};

    } else {
    exit(1);
    }
    }
    }

    # The subroutine PortableReadKey::turnOffEcho() MUST
    # be called before getKeyBlocking() for it to function
    # correctly.
    sub getKeyBlocking {
    my $key;
    if ($type eq "ReadKey") {
    # For some reason this messes up when ENTER
    # is pressed under MSWin32:
    $key = Term::ReadKey::ReadKey(0);
    } elsif ($type eq "bsd" or $type eq "non_bsd") { $key =
    getc(STDIN);
    } elsif ($type eq "win32") {
    $key = $input_con->InputChar(1);
    $key = "\n" if defined $key and ord($key) == 13;
    } else { die "\nsub getKeyInit() was never called";
    } return $key;
    }

    # The subroutine PortableReadKey::turnOffEcho() MUST
    # be called before getKeyNonBlocking() for it to function
    # correctly.
    sub getKeyNonBlocking {
    my $key;
    if ($type eq "ReadKey") {
    $key = Term::ReadKey::ReadKey(-1);
    } elsif ($type eq "bsd" or $type eq "non_bsd") {
    sysread(STDIN,$key,1) if $s->can_read(0);
    } elsif ($type eq "win32") {
    while ($input_con->GetEvents()) {
    my @event = $input_con->Input();
    # print " \@event = (@event)\n";
    if (defined $event[0] and $event[0] == 1
    and $event[1] and $event[5]) {
    $key = chr($event[5]);
    $key = "\n" if defined $key and ord($key) == 13;
    return $key;
    }
    }
    } else {
    die "\nsub getKeyInit() was never called";
    }
    return $key;
    }

    sub clearScreen {
    if ($type eq "win32") {
    $output_con->Cls();
    } elsif ($type eq "bsd" or $type eq "non_bsd"
    or $type eq "ReadKey") {
    print "\e[2J"; # clear screen and move cursor
    # to home position
    print "\e[H"; # move cursor to home position
    # (necessary for some systems)
    } else { die "\nsub getKeyInit() was never called";
    }
    }

    sub moveCursorAbsolute {
    my ($x, $y) = @_;
    # Note that negative values may not give
    # the desired results.
    if ($type eq "win32") {
    $output_con->Cursor($x, $y);
    } elsif ($type eq "bsd" or $type eq "non_bsd"
    or $type eq "ReadKey") {
    printf("\e[%d;%dH", $y, $x);
    } else { die "\nsub getKeyInit() was never called";
    }
    }

    sub moveCursorRelative {
    my ($x, $y) = @_;
    if ($type eq "win32") {
    my ($current_x, $current_y) = $output_con->Cursor();
    # Note that negative values may not give
    # the desired results.
    $x += $current_x;
    $y += $current_y;
    $x = 0 if $x < 0;
    $y = 0 if $y < 0;
    $output_con->Cursor($x, $y);
    } elsif ($type eq "bsd" or $type eq "non_bsd"
    or $type eq "ReadKey") {
    if ($x > 0) { # Go right:
    printf("\e[%dC", $x);
    } elsif ($x < 0) { # Go left:
    printf("\e[%dD", -$x);
    }
    if ($y > 0) { # Go down:
    printf("\e[%dB", $y);
    } elsif ($y < 0) { # Go up:
    printf("\e[%dA", -$y);
    }
    } else { die "\nsub getKeyInit() was never called";
    }
    }

    sub saveCursorPosition {
    if ($type eq "win32") {
    ($saved_x, $saved_y) = $output_con->Cursor();
    } elsif ($type eq "bsd" or $type eq "non_bsd"
    or $type eq "ReadKey") {
    print "\e[s";
    } else { die "\nsub getKeyInit() was never called";
    }
    }

    sub restoreCursorPosition {
    if ($type eq "win32") {
    $output_con->Cursor($saved_x, $saved_y);
    } elsif ($type eq "bsd" or $type eq "non_bsd"
    or $type eq "ReadKey") {
    print "\e[u";
    } else { die "\nsub getKeyInit() was never called";
    }
    }


    package main;

    $| = 1; # autoflush

    PortableReadKey::getKeyInit();

    PortableReadKey::clearScreen();
    my $key;
    PortableReadKey::turnOffEcho();
    print "Press a key for an example of a blocking read...\n";
    $key = PortableReadKey::getKeyBlocking();
    # print "ASCII = ", ord($key), "\n";
    $key = "[ENTER]" if $key eq "\n";
    $key = "[ESCAPE]" if $key eq "\e";
    $key = "[BACKSPACE]"
    if $key eq "\b" or $key eq "\cH" or $key eq "\c?";
    # Now check for CTRL combinations:
    eval qq/\$key = "[CTRL-$_]"
    if \$key eq "\\c$_"/ for ('A' .. 'Z');
    print "\n";
    print "Good! You pressed \"$key\"!\n\n";
    my $num_secs = 30;
    print <<"END_INSTRUCTIONS";
    Now, after you press ENTER, you can type for the next
    $num_secs seconds. A '.' will be printed every second.
    Any key you type will show up as the '*' symbol.
    This is an example of a non-blocking read.
    END_INSTRUCTIONS
    PortableReadKey::moveCursorAbsolute(3,10);
    print "Press ENTER when ready.";
    # Warning on win32 systems: when the echo is turned off,
    # reading from <STDIN> won't work, even to read
    # an ENTER keypress.
    PortableReadKey::turnOnEcho();
    <STDIN>;
    print "\n";
    print "Now, type!";
    PortableReadKey::moveCursorRelative(-4,1);
    PortableReadKey::turnOffEcho();
    my $input = "";
    my ($start_time, $current_time);
    $start_time = $current_time = time;
    print ".";
    while (time - $start_time < $num_secs) {
    PortableReadKey::turnOffEcho();
    $current_time != time and ($current_time = time and print ".");
    my $key = PortableReadKey::getKeyNonBlocking();
    $input .= $key, print "*" if defined $key;
    }
    PortableReadKey::turnOnEcho();

    print qq(\n\nYou typed "$input".\n);

    print "Now for examples of cursor positioning.\n";
    print "Hit ENTER to continue."; <STDIN>;

    PortableReadKey::clearScreen();
    PortableReadKey::moveCursorAbsolute(10,10);
    print "Now at (10,10). (Press ENTER)";
    PortableReadKey::saveCursorPosition();
    <STDIN>;
    PortableReadKey::moveCursorAbsolute(5,5);
    print "Now at (5,5). (Press ENTER)";
    <STDIN>;
    PortableReadKey::restoreCursorPosition();
    print "Back to previous position!\n\n";

    __END__
     
    J. Romano, Nov 10, 2003
    #2
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Replies:
    3
    Views:
    745
    ChrisWSU
    Jun 27, 2005
  2. Replies:
    3
    Views:
    774
    Chris Dollin
    Aug 31, 2005
  3. Replies:
    4
    Views:
    701
    Walter Roberson
    Sep 9, 2005
  4. Replies:
    2
    Views:
    1,025
    cyprian
    Jun 11, 2007
  5. Joris van Lier

    Detect Client-side Keyboard Layout

    Joris van Lier, Apr 21, 2008, in forum: ASP .Net
    Replies:
    0
    Views:
    935
    Joris van Lier
    Apr 21, 2008
Loading...

Share This Page