0: ## Update 1: 09/18/01
1: ##      Removed requirement for Time::HiRes::sleep function.
2: ##      Term::ReadKey supports a decimal timeout parameter.
3: ##
4: 
5: This is my first module submission to this site.  I've 
6: written a couple of modules previously but they are work 
7: specific and not generalized.  I would like to 
8: thank everyone that offered responses to several related 
9: nodes.  I hope this will prove useful to others and 
10: welcome feedback, critiques, etc.  I will state up front 
11: that the module works best with the predefined terminal 
12: emulations (vt52, vt100, vt102, and vt220) but is still 
13: somewhat functional in a Windows environment.  Perhaps a more 
14: Windows oriented monk will add a Windows variant that can
15: detect multi-code sequenced keys.
16: 
17: This submission contains three parts: 1) the module; 2) a 
18: simple program to interface with the module; and 3) a 
19: utility demo program (does not use Term::TermKeys but 
20: does require the Term::Readkey module).
21: 
22: ===========================================================
23: 1) the module
24: ===========================================================
25: 
26: # FILE: TermKeys.pm
27: 
28: =head1 NAME
29: 
30: Term::TermKeys - A perl module for single stroke keyboard input
31: 
32: =head1 SYNOPSIS
33: 
34:     use Term::TermKeys;
35:     my %keyhash = Term::TermKeys::LoadKeyHash();
36:     print "\nPress Enter to continue . . . ";
37:     my $seq = '';
38:     while ($keyhash{$seq} ne 'ENTER') {
39:        $seq = Term::TermKeys::KeyPressed();
40:     }
41:     print "\n\n";
42: 
43: =head1 DESCRIPTION
44: 
45: Term::TermKeys is a perl module consisting of two functions:
46: 
47: =item Term::TermKeys::LoadKeyHash() 
48: 
49: LoadKeyHash() returns a hash, say %keyhash where the key 
50: is a string generated by pressing the key and the value is a key 'label' as
51: in:  $keyhash{key} = label or $keyhash{chr 13} = 'ENTER'.  This function 
52: should be called before using the KeyPressed() function, but is not required. 
53: When invoked, LoadKeyHash() looks to $ENV{TERM} for a currently defined 
54: terminal emulation.  Some key values are already included for terminal types:
55: vt52, vt100, vt102, and vt220.  If $ENV{TERM} is any other value or undefined,
56: a standard set of ASCII key definitions is returned. [ CTRL-A .. CTRL-Z, TAB, 
57: ENTER, BACKSPACE, SPACE, and decimal ASCII character equivalents for values 
58: 0 .. 127 ].  Note that not all keys are defined for any of the predefined 
59: terminal emulations, although by viewing the module source, a user should be 
60: able to figure out how to define %keyhash locally through their own program, 
61: extend the definitions (like the keypad), and skip the call to LoadKeyHash().
62: 
63: =item Term::TermKeys::KeyPressed() 
64: 
65: KeyPressed() is a function that returns the entire string 
66: sequence, let's say $seq, of codes returned by a single keystroke.  Thus keys 
67: in emulations that return a series of chars (e.g., decimal codes 27,91 and 65
68: are returned by pressing the UpArrow key under vt220 emulation) can be test 
69: for.  Although written mainly for single keystroke input, creative use of this
70: function could be used to generate fielded data as well.
71: 
72: =head1 COPYRIGHT
73: 
74: Copyright (c) 2001 Jim Longino.  All rights reserved.
75: This program is free software; you may redistribute it and/or modify it 
76: under the same terms as Perl itself.
77: 
78: =head1 AUTHOR
79: 
80: Jim Longino <jlongino@jaguar1.usouthal.edu>
81: 
82: =cut
83: 
84: package Term::TermKeys;
85: 
86: $VERSION = "0.001.000";
87: 
88: use strict;
89: use warnings;
90:    
91: sub KeyPressed {
92:    use Term::ReadKey;
93:    my @vals = ();
94:    my @char = ();
95:    select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
96:    ReadMode 4; 
97:    while (not defined ($char[0] = ReadKey(0.01))) {
98:       # no key pressed
99:    }
100:    push (@vals, ord $char[0]);
101:    ## sometimes pressing a key returns more than one ASCII code.
102:    ## the next while captures these as well.
103:    while (defined (my $ch = ReadKey(0.01))) {
104:       push (@vals, ord $ch);
105:       push (@char, $ch);
106:    }
107:    ReadMode 0; # Reset tty mode before exiting
108:    my $seq = join '', @char;
109: #  echo standard ASCII chars only
110: #  print $seq if ((length $seq == 1) && ($vals[0] > 31) && ($vals[0] < 127));
111:    return $seq;
112: }
113: 
114: sub LoadKeyHash {
115:    my %keyhash;
116:    my %TermType = (vt52 => 1, vt100 => 1, vt102 => 1, vt220 => 1);
117:    ### NOTE: Supported terminal types: vt52, vt100, vt102 and vt220
118:    my @DATA = qw(
119:          vt52:BKSP:8 vt52:F1:27_80 vt52:F2:27_81 vt52:F3:27_82 vt52:F4:27_83 
120:          vt52:UPAR:27_65 vt52:DNAR:27_66 vt52:RTAR:27_67 vt52:LTAR:27_68 
121:          vt52:DELETE:127 vt52:ENTER:10
122: 
123:          vt100:BKSP:8 vt100:F1:27_79_80 vt100:F2:27_79_81 vt100:F3:27_79_82 
124:          vt100:F4:27_79_83 vt100:UPAR:27_79_65 vt100:DNAR:27_79_66 
125:          vt100:RTAR:27_79_67 vt100:LTAR:27_79_68 vt100:DELETE:127
126:          vt100:ENTER:10
127: 
128:          vt102:BKSP:127 vt102:F1:27_79_80 vt102:F2:27_79_81 vt102:F3:27_79_82 
129:          vt102:F4:27_79_83 vt102:F5:28 vt102:UPAR:27_91_65 vt102:DNAR:27_91_66 
130:          vt102:RTAR:27_91_67 vt102:LTAR:27_91_68 vt102:ENTER:10
131: 
132:          vt220:BKSP:127 vt220:F1:27_79_80 vt220:F2:27_79_81 vt220:F3:27_79_82 
133:          vt220:F4:27_79_83 vt220:F6:27_91_49_55_126 vt220:F7:27_91_49_56_126 
134:          vt220:F8:27_91_49_57_126 vt220:F9:27_91_50_48_126 
135:          vt220:F10:27_91_50_49_126 vt220:F11:27_91_50_56_126 
136:          vt220:F12:27_91_50_57_126 vt220:UPAR:27_91_65 vt220:DNAR:27_91_66 
137:          vt220:RTAR:27_91_67 vt220:LTAR:27_91_68 vt220:INSERT:27_91_49_126 
138:          vt220:HOME:27_91_50_126 vt220:END:27_91_53_126 
139:          vt220:DELETE:27_91_52_126 vt220:PGUP:27_91_51_126
140:          vt220:PGDN:27_91_54_126 vt220:ENTER:10
141:       );
142:    my $TERM = lc $ENV{TERM};
143:    if (not exists $TermType{$TERM}) {
144:       $TERM = '';
145:    }
146:    ## create entries for Ctrl-A through Ctrl-Z for %keyhash
147:    foreach (1..26) {
148:       $keyhash{chr $_} = 'CTRL-' . chr ($_ + 64);
149:    }
150:    # set up standard ASCII defaults for %keyhash
151:    foreach (33..126) {
152:       $keyhash{chr $_} = chr $_ ;
153:    }
154:    ## add miscellaneous standard keys
155:    $keyhash{' '} = ' ';
156:    $keyhash{chr   9} = 'TAB';
157:    $keyhash{chr  13} = 'ENTER';
158:    $keyhash{chr  27} = 'ESCAPE';
159:    $keyhash{chr 127} = 'DELETE' if not exists $keyhash{chr 127};
160:    ## read in Emulation specific keys from @DATA
161:    foreach (@DATA) {
162:       my ($ttype, $label, $deckeys) = split /:/;
163:       if ($ttype eq $TERM) {
164:          my $seq = '';
165:          my @dec = split "_", $deckeys;
166:          ## useful for debugging
167:          ## print "\$ttype: '$ttype', \$label: '$label', \$deckeys: '$deckeys'\n";
168:          foreach (@dec) {
169:             $seq .= chr $_;
170:          }
171:          $keyhash{$seq} = $label;
172:       }
173:    }
174:    return %keyhash;
175: }
176: 
177: 1;
178: 
179: 
180: ===========================================================
181: 2) the example module interface program
182: ===========================================================
183: 
184: ## Program: TermKeys.pl
185: ##
186: ## This program demonstrates the interface to module Term::TermKeys
187: ## Note that the module works best when using standard vt52, vt100, 
188: ## vt102 and vt220 terminal emulations (Unix or Linux systems) but 
189: ## has some functionality on Windows platforms.
190: 
191: use strict;
192: use Term::ReadKey qw(ReadMode);
193: use Term::TermKeys;
194: 
195: my %keyhash = Term::TermKeys::LoadKeyHash();
196: 
197: my $seq = '';
198: while (($keyhash{$seq} ne 'ENTER') && ($keyhash{$seq} ne 'CTRL-C')) {
199:    print "\nPress Enter to continue or Ctrl-C to quit . . . ";
200:    $seq = Term::TermKeys::KeyPressed();
201:    print "$keyhash{$seq}\n";
202: }
203: 
204: ## conditional control structure based on value of $keyhash{$seq}
205: if ($keyhash{$seq} eq 'ENTER') {
206:    ## do stuff
207:    print "\n\nCongratulations! you found the Enter key.";
208: }  elsif ($keyhash{$seq} eq 'CTRL-C') {
209:       print "\n\nTerminated by Ctrl-C";
210:       exit;
211: }
212: print "\n";
213: 
214: END {
215:    select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
216:    ReadMode 0; # Reset tty mode in case error terminates program
217:    print "\n\n";
218: }
219: 
220: ===========================================================
221: 3) the demo/utility program
222: ===========================================================
223: 
224: ## Program: TermKeys.demo.pl
225: ##
226: ##    Copyright (c) 2001 Jim Longino.  All rights reserved.
227: ##    This program is free software; you may redistribute it 
228: ##    and/or modify it under the same terms as Perl itself.
229: ##
230: ## This program is for demo purposes.  It does not use module 
231: ## Term::TermKeys but still requires module Term::ReadKey. 
232: ## It is also useful for determining what decimal 
233: ## ASCII codes are returned when a key is pressed so that you 
234: ## can build your own %keyhash rather than use the one returned
235: ## by sub LoadKeyHash().
236: 
237: use Term::ReadKey;
238: use English;
239: use strict;
240: 
241: my %keyhash = &LoadKeyHash;
242: 
243: my $ch = '';
244: while (($keyhash{$ch} ne 'ENTER') && ($keyhash{$ch} ne 'CTRL-C')) {
245:    print "\nPress Enter to continue or Ctrl-C to quit . . . ";
246:    my $seq = KeyPressed();
247:    print "   key pressed: $keyhash{$seq}\n" if exists $keyhash{$seq};
248:    $ch = lc $seq;
249: }
250: print "\n\n";
251: 
252: END {
253:    ReadMode 0; # Reset tty mode in case error terminates program
254: }
255: 
256: sub KeyPressed {
257:    my @vals = ();
258:    my @char = ();
259:    select((select(STDOUT), $| = 1)[0]); #flush STDOUT buffer
260:    ReadMode 4; # Turn off controls keys
261:    while (not defined ($char[0] = ReadKey(0.01))) {
262:       # no key pressed
263:    }
264:    push (@vals, ord $char[0]);
265:    ## sometimes pressing a key returns more than one ASCII code.
266:    ## the next while captures these as well.
267:    while (defined (my $ch = ReadKey(0.01))) { 
268:       push (@vals, ord $ch);
269:       push (@char, $ch);
270:    }
271:    ReadMode 0; # Reset tty mode before exiting
272:    print "\n   Codes triggered: " . scalar(@vals) . "\n";
273:    my $ct = scalar(@vals) - 1;
274:    my $j = 0;
275:    foreach my $code (@vals) {
276:       $j++;
277:       print "      decimal code $j: $code\n";
278:    }
279:    ReadMode 0; # Reset tty mode before exiting
280:    my $seq = join '', @char;
281:    return $seq;
282: }
283: 
284: sub LoadKeyHash {
285:    # set up standard ASCII defaults for %keyhash
286:    my %keyhash;
287:    my %TermType = (vt52 => 1, vt100 => 1, vt102 => 1, vt220 => 1);
288:    ### NOTE: Supported terminal types: vt52, vt100, vt102 and vt220
289:    my @DATA = qw(
290:          vt52:BKSP:8 vt52:F1:27_80 vt52:F2:27_81 vt52:F3:27_82 vt52:F4:27_83 
291:          vt52:UPAR:27_65 vt52:DNAR:27_66 vt52:RTAR:27_67 vt52:LTAR:27_68 
292:          vt52:DELETE:127 vt52:ENTER:10
293: 
294:          vt100:BKSP:8 vt100:F1:27_79_80 vt100:F2:27_79_81 vt100:F3:27_79_82 
295:          vt100:F4:27_79_83 vt100:UPAR:27_79_65 vt100:DNAR:27_79_66 
296:          vt100:RTAR:27_79_67 vt100:LTAR:27_79_68 vt100:DELETE:127
297:          vt100:ENTER:10
298: 
299:          vt102:BKSP:127 vt102:F1:27_79_80 vt102:F2:27_79_81 vt102:F3:27_79_82 
300:          vt102:F4:27_79_83 vt102:F5:28 vt102:UPAR:27_91_65 vt102:DNAR:27_91_66 
301:          vt102:RTAR:27_91_67 vt102:LTAR:27_91_68 vt102:ENTER:10
302: 
303:          vt220:BKSP:127 vt220:F1:27_79_80 vt220:F2:27_79_81 vt220:F3:27_79_82 
304:          vt220:F4:27_79_83 vt220:F6:27_91_49_55_126 vt220:F7:27_91_49_56_126 
305:          vt220:F8:27_91_49_57_126 vt220:F9:27_91_50_48_126 
306:          vt220:F10:27_91_50_49_126 vt220:F11:27_91_50_56_126 
307:          vt220:F12:27_91_50_57_126 vt220:UPAR:27_91_65 vt220:DNAR:27_91_66 
308:          vt220:RTAR:27_91_67 vt220:LTAR:27_91_68 vt220:INSERT:27_91_49_126 
309:          vt220:HOME:27_91_50_126 vt220:END:27_91_53_126 
310:          vt220:DELETE:27_91_52_126 vt220:PGUP:27_91_51_126
311:          vt220:PGDN:27_91_54_126 vt220:ENTER:10
312:       );
313:    my $TERM = lc $ENV{TERM};
314:    if (not exists $TermType{$TERM}) {
315:       $TERM = '';
316:    }
317:    print "\$TERM: $TERM\n";
318:    ## create entries for Ctrl-A through Ctrl-Z for %keyhash
319:    foreach (1..26) {
320:       # print "\$keyhash{chr $_}: ",  'CTRL-' . chr ($_ + 64) . "\n";
321:       $keyhash{chr $_} = 'CTRL-' . chr ($_ + 64);
322:    }
323:    foreach (33..126) {
324:       $keyhash{chr $_} = chr $_ ;
325:    }
326:    ## add miscellaneous standard keys
327:    $keyhash{' '} = ' ';
328:    $keyhash{chr   9} = 'TAB';
329:    $keyhash{chr  13} = 'ENTER';
330:    $keyhash{chr  27} = 'ESCAPE';
331:    $keyhash{chr 127} = 'DELETE' if not exists $keyhash{chr 127};
332:    ## read in Emulation specific keys from @DATA
333:    foreach (@DATA) {
334:       my ($ttype, $label, $deckeys) = split /:/;
335:       if ($ttype eq $TERM) {
336:          my $seq = '';
337:          my @dec = split ("_", $deckeys);
338:          foreach (@dec) {
339:             $seq .= chr $_;
340:          }
341:          $keyhash{$seq} = $label;
342:          # print "\$ttype: $ttype  \$label: $label  \$deckeys: $deckeys";
343:       }
344:    }
345:    return %keyhash;
346: }