## Update 1: 09/18/01
##      Removed requirement for Time::HiRes::sleep function.
##      Term::ReadKey supports a decimal timeout parameter.
##

This is my first module submission to this site.  I've 
written a couple of modules previously but they are work 
specific and not generalized.  I would like to 
thank everyone that offered responses to several related 
nodes.  I hope this will prove useful to others and 
welcome feedback, critiques, etc.  I will state up front 
that the module works best with the predefined terminal 
emulations (vt52, vt100, vt102, and vt220) but is still 
somewhat functional in a Windows environment.  Perhaps a more 
Windows oriented monk will add a Windows variant that can
detect multi-code sequenced keys.

This submission contains three parts: 1) the module; 2) a 
simple program to interface with the module; and 3) a 
utility demo program (does not use Term::TermKeys but 
does require the Term::Readkey module).

===========================================================
1) the module
===========================================================

# FILE: TermKeys.pm

=head1 NAME

Term::TermKeys - A perl module for single stroke keyboard input

=head1 SYNOPSIS

    use Term::TermKeys;
    my %keyhash = Term::TermKeys::LoadKeyHash();
    print "\nPress Enter to continue . . . ";
    my $seq = '';
    while ($keyhash{$seq} ne 'ENTER') {
       $seq = Term::TermKeys::KeyPressed();
    }
    print "\n\n";

=head1 DESCRIPTION

Term::TermKeys is a perl module consisting of two functions:

=item Term::TermKeys::LoadKeyHash() 

LoadKeyHash() returns a hash, say %keyhash where the key 
is a string generated by pressing the key and the value is a key 'label' as
in:  $keyhash{key} = label or $keyhash{chr 13} = 'ENTER'.  This function 
should be called before using the KeyPressed() function, but is not required. 
When invoked, LoadKeyHash() looks to $ENV{TERM} for a currently defined 
terminal emulation.  Some key values are already included for terminal types:
vt52, vt100, vt102, and vt220.  If $ENV{TERM} is any other value or undefined,
a standard set of ASCII key definitions is returned. [ CTRL-A .. CTRL-Z, TAB, 
ENTER, BACKSPACE, SPACE, and decimal ASCII character equivalents for values 
0 .. 127 ].  Note that not all keys are defined for any of the predefined 
terminal emulations, although by viewing the module source, a user should be 
able to figure out how to define %keyhash locally through their own program, 
extend the definitions (like the keypad), and skip the call to LoadKeyHash().

=item Term::TermKeys::KeyPressed() 

KeyPressed() is a function that returns the entire string 
sequence, let's say $seq, of codes returned by a single keystroke.  Thus keys 
in emulations that return a series of chars (e.g., decimal codes 27,91 and 65
are returned by pressing the UpArrow key under vt220 emulation) can be test 
for.  Although written mainly for single keystroke input, creative use of this
function could be used to generate fielded data as well.

=head1 COPYRIGHT

Copyright (c) 2001 Jim Longino.  All rights reserved.
This program is free software; you may redistribute it and/or modify it 
under the same terms as Perl itself.

=head1 AUTHOR

Jim Longino <jlongino@jaguar1.usouthal.edu>

=cut

package Term::TermKeys;

$VERSION = "0.001.000";

use strict;
use warnings;
   
sub KeyPressed {
   use Term::ReadKey;
   my @vals = ();
   my @char = ();
   select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
   ReadMode 4; 
   while (not defined ($char[0] = ReadKey(0.01))) {
      # no key pressed
   }
   push (@vals, ord $char[0]);
   ## sometimes pressing a key returns more than one ASCII code.
   ## the next while captures these as well.
   while (defined (my $ch = ReadKey(0.01))) {
      push (@vals, ord $ch);
      push (@char, $ch);
   }
   ReadMode 0; # Reset tty mode before exiting
   my $seq = join '', @char;
#  echo standard ASCII chars only
#  print $seq if ((length $seq == 1) && ($vals[0] > 31) && ($vals[0] < 127));
   return $seq;
}

sub LoadKeyHash {
   my %keyhash;
   my %TermType = (vt52 => 1, vt100 => 1, vt102 => 1, vt220 => 1);
   ### NOTE: Supported terminal types: vt52, vt100, vt102 and vt220
   my @DATA = qw(
         vt52:BKSP:8 vt52:F1:27_80 vt52:F2:27_81 vt52:F3:27_82 vt52:F4:27_83 
         vt52:UPAR:27_65 vt52:DNAR:27_66 vt52:RTAR:27_67 vt52:LTAR:27_68 
         vt52:DELETE:127 vt52:ENTER:10

         vt100:BKSP:8 vt100:F1:27_79_80 vt100:F2:27_79_81 vt100:F3:27_79_82 
         vt100:F4:27_79_83 vt100:UPAR:27_79_65 vt100:DNAR:27_79_66 
         vt100:RTAR:27_79_67 vt100:LTAR:27_79_68 vt100:DELETE:127
         vt100:ENTER:10

         vt102:BKSP:127 vt102:F1:27_79_80 vt102:F2:27_79_81 vt102:F3:27_79_82 
         vt102:F4:27_79_83 vt102:F5:28 vt102:UPAR:27_91_65 vt102:DNAR:27_91_66 
         vt102:RTAR:27_91_67 vt102:LTAR:27_91_68 vt102:ENTER:10

         vt220:BKSP:127 vt220:F1:27_79_80 vt220:F2:27_79_81 vt220:F3:27_79_82 
         vt220:F4:27_79_83 vt220:F6:27_91_49_55_126 vt220:F7:27_91_49_56_126 
         vt220:F8:27_91_49_57_126 vt220:F9:27_91_50_48_126 
         vt220:F10:27_91_50_49_126 vt220:F11:27_91_50_56_126 
         vt220:F12:27_91_50_57_126 vt220:UPAR:27_91_65 vt220:DNAR:27_91_66 
         vt220:RTAR:27_91_67 vt220:LTAR:27_91_68 vt220:INSERT:27_91_49_126 
         vt220:HOME:27_91_50_126 vt220:END:27_91_53_126 
         vt220:DELETE:27_91_52_126 vt220:PGUP:27_91_51_126
         vt220:PGDN:27_91_54_126 vt220:ENTER:10
      );
   my $TERM = lc $ENV{TERM};
   if (not exists $TermType{$TERM}) {
      $TERM = '';
   }
   ## create entries for Ctrl-A through Ctrl-Z for %keyhash
   foreach (1..26) {
      $keyhash{chr $_} = 'CTRL-' . chr ($_ + 64);
   }
   # set up standard ASCII defaults for %keyhash
   foreach (33..126) {
      $keyhash{chr $_} = chr $_ ;
   }
   ## add miscellaneous standard keys
   $keyhash{' '} = ' ';
   $keyhash{chr   9} = 'TAB';
   $keyhash{chr  13} = 'ENTER';
   $keyhash{chr  27} = 'ESCAPE';
   $keyhash{chr 127} = 'DELETE' if not exists $keyhash{chr 127};
   ## read in Emulation specific keys from @DATA
   foreach (@DATA) {
      my ($ttype, $label, $deckeys) = split /:/;
      if ($ttype eq $TERM) {
         my $seq = '';
         my @dec = split "_", $deckeys;
         ## useful for debugging
         ## print "\$ttype: '$ttype', \$label: '$label', \$deckeys: '$deckeys'\n";
         foreach (@dec) {
            $seq .= chr $_;
         }
         $keyhash{$seq} = $label;
      }
   }
   return %keyhash;
}

1;


===========================================================
2) the example module interface program
===========================================================

## Program: TermKeys.pl
##
## This program demonstrates the interface to module Term::TermKeys
## Note that the module works best when using standard vt52, vt100, 
## vt102 and vt220 terminal emulations (Unix or Linux systems) but 
## has some functionality on Windows platforms.

use strict;
use Term::ReadKey qw(ReadMode);
use Term::TermKeys;

my %keyhash = Term::TermKeys::LoadKeyHash();

my $seq = '';
while (($keyhash{$seq} ne 'ENTER') && ($keyhash{$seq} ne 'CTRL-C')) {
   print "\nPress Enter to continue or Ctrl-C to quit . . . ";
   $seq = Term::TermKeys::KeyPressed();
   print "$keyhash{$seq}\n";
}

## conditional control structure based on value of $keyhash{$seq}
if ($keyhash{$seq} eq 'ENTER') {
   ## do stuff
   print "\n\nCongratulations! you found the Enter key.";
}  elsif ($keyhash{$seq} eq 'CTRL-C') {
      print "\n\nTerminated by Ctrl-C";
      exit;
}
print "\n";

END {
   select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
   ReadMode 0; # Reset tty mode in case error terminates program
   print "\n\n";
}

===========================================================
3) the demo/utility program
===========================================================

## Program: TermKeys.demo.pl
##
##    Copyright (c) 2001 Jim Longino.  All rights reserved.
##    This program is free software; you may redistribute it 
##    and/or modify it under the same terms as Perl itself.
##
## This program is for demo purposes.  It does not use module 
## Term::TermKeys but still requires module Term::ReadKey. 
## It is also useful for determining what decimal 
## ASCII codes are returned when a key is pressed so that you 
## can build your own %keyhash rather than use the one returned
## by sub LoadKeyHash().

use Term::ReadKey;
use English;
use strict;

my %keyhash = &LoadKeyHash;

my $ch = '';
while (($keyhash{$ch} ne 'ENTER') && ($keyhash{$ch} ne 'CTRL-C')) {
   print "\nPress Enter to continue or Ctrl-C to quit . . . ";
   my $seq = KeyPressed();
   print "   key pressed: $keyhash{$seq}\n" if exists $keyhash{$seq};
   $ch = lc $seq;
}
print "\n\n";

END {
   ReadMode 0; # Reset tty mode in case error terminates program
}

sub KeyPressed {
   my @vals = ();
   my @char = ();
   select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
   ReadMode 4; # Turn off controls keys
   while (not defined ($char[0] = ReadKey(0.01))) {
      # no key pressed
   }
   push (@vals, ord $char[0]);
   ## sometimes pressing a key returns more than one ASCII code.
   ## the next while captures these as well.
   while (defined (my $ch = ReadKey(0.01))) { 
      push (@vals, ord $ch);
      push (@char, $ch);
   }
   ReadMode 0; # Reset tty mode before exiting
   print "\n   Codes triggered: " . scalar(@vals) . "\n";
   my $ct = scalar(@vals) - 1;
   my $j = 0;
   foreach my $code (@vals) {
      $j++;
      print "      decimal code $j: $code\n";
   }
   ReadMode 0; # Reset tty mode before exiting
   my $seq = join '', @char;
   return $seq;
}

sub LoadKeyHash {
   # set up standard ASCII defaults for %keyhash
   my %keyhash;
   my %TermType = (vt52 => 1, vt100 => 1, vt102 => 1, vt220 => 1);
   ### NOTE: Supported terminal types: vt52, vt100, vt102 and vt220
   my @DATA = qw(
         vt52:BKSP:8 vt52:F1:27_80 vt52:F2:27_81 vt52:F3:27_82 vt52:F4:27_83 
         vt52:UPAR:27_65 vt52:DNAR:27_66 vt52:RTAR:27_67 vt52:LTAR:27_68 
         vt52:DELETE:127 vt52:ENTER:10

         vt100:BKSP:8 vt100:F1:27_79_80 vt100:F2:27_79_81 vt100:F3:27_79_82 
         vt100:F4:27_79_83 vt100:UPAR:27_79_65 vt100:DNAR:27_79_66 
         vt100:RTAR:27_79_67 vt100:LTAR:27_79_68 vt100:DELETE:127
         vt100:ENTER:10

         vt102:BKSP:127 vt102:F1:27_79_80 vt102:F2:27_79_81 vt102:F3:27_79_82 
         vt102:F4:27_79_83 vt102:F5:28 vt102:UPAR:27_91_65 vt102:DNAR:27_91_66 
         vt102:RTAR:27_91_67 vt102:LTAR:27_91_68 vt102:ENTER:10

         vt220:BKSP:127 vt220:F1:27_79_80 vt220:F2:27_79_81 vt220:F3:27_79_82 
         vt220:F4:27_79_83 vt220:F6:27_91_49_55_126 vt220:F7:27_91_49_56_126 
         vt220:F8:27_91_49_57_126 vt220:F9:27_91_50_48_126 
         vt220:F10:27_91_50_49_126 vt220:F11:27_91_50_56_126 
         vt220:F12:27_91_50_57_126 vt220:UPAR:27_91_65 vt220:DNAR:27_91_66 
         vt220:RTAR:27_91_67 vt220:LTAR:27_91_68 vt220:INSERT:27_91_49_126 
         vt220:HOME:27_91_50_126 vt220:END:27_91_53_126 
         vt220:DELETE:27_91_52_126 vt220:PGUP:27_91_51_126
         vt220:PGDN:27_91_54_126 vt220:ENTER:10
      );
   my $TERM = lc $ENV{TERM};
   if (not exists $TermType{$TERM}) {
      $TERM = '';
   }
   print "\$TERM: $TERM\n";
   ## create entries for Ctrl-A through Ctrl-Z for %keyhash
   foreach (1..26) {
      # print "\$keyhash{chr $_}: ",  'CTRL-' . chr ($_ + 64) . "\n";
      $keyhash{chr $_} = 'CTRL-' . chr ($_ + 64);
   }
   foreach (33..126) {
      $keyhash{chr $_} = chr $_ ;
   }
   ## add miscellaneous standard keys
   $keyhash{' '} = ' ';
   $keyhash{chr   9} = 'TAB';
   $keyhash{chr  13} = 'ENTER';
   $keyhash{chr  27} = 'ESCAPE';
   $keyhash{chr 127} = 'DELETE' if not exists $keyhash{chr 127};
   ## read in Emulation specific keys from @DATA
   foreach (@DATA) {
      my ($ttype, $label, $deckeys) = split /:/;
      if ($ttype eq $TERM) {
         my $seq = '';
         my @dec = split ("_", $deckeys);
         foreach (@dec) {
            $seq .= chr $_;
         }
         $keyhash{$seq} = $label;
         # print "\$ttype: $ttype  \$label: $label  \$deckeys: $deckeys";
      }
   }
   return %keyhash;
}