"Scott Shaw" <ss***@twmi.rr.com> wrote in message news:<%P***********************@twister.columbus.r r.com>...
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__
