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