1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
|
#!/usr/bin/perl -w
#use strict vars;
#use Term::ReadKey qw( ReadMode ReadKey );
#my $x;
#ReadMode 3;
#print "Read 1\n";
#$x = ReadKey(0);
#print "X=$x\n";
#print "Read 2\n";
#$x = ReadKey(0);
#print "X=$x\n";
#ReadMode 0;
#__END__;
my $interactive = (@ARGV && $ARGV[0] =~ /interactive/ );
BEGIN { print "1 .. 8\n"; }
END { print "not ok 1\n" unless $loaded }
use Term::ReadKey;
$loaded = 1;
print "ok 1\n";
use Fcntl;
if ( not exists $ENV{COLUMNS} )
{
$ENV{COLUMNS} = 80;
$ENV{LINES} = 24;
}
if ($^O =~ /Win32/i) {
sysopen(IN,'CONIN$',O_RDWR) or die "Unable to open console input:$!";
sysopen(OUT,'CONOUT$',O_RDWR) or die "Unable to open console output:$!";
} else {
if ( open(IN,"</dev/tty") ) {
*OUT = *IN;
die "Foo" unless -t OUT;
}
else {
die "Can't open /dev/tty - $!\n";
}
}
*IN=*IN; # Make single-use warning go away
$|=1;
my $size1 = join(",",GetTerminalSize(\IN));
my $size2 = join(",",GetTerminalSize("IN"));
my $size3 = join(",",GetTerminalSize(*IN));
my $size4 = join(",",GetTerminalSize(\*IN));
if (($size1 eq $size2) && ($size2 eq $size3) && ($size3 eq $size4 ))
{
print "ok 2\n";
}
else
{
print "not ok 2\n";
}
sub makenicelist {
my(@list) = @_;
my($i,$result);
$result="";
for($i=0;$i<@list;$i++) {
$result .= ", " if $i>0;
$result .= "and " if $i==@list-1 and @list>1;
$result .= $list[$i];
}
$result;
}
sub makenice {
my($char) = $_[0];
if(ord($char)<32) { $char = "^" . pack("c",ord($char)+64) }
elsif(ord($char)>126) { $char = ord($char) }
$char;
}
sub makeunnice {
my($char) = $_[0];
$char =~ s/^\^(.)$/pack("c",ord($1)-64)/eg;
$char =~ s/(\d{1,3})/pack("c",$1+0)/eg;
$char;
}
my $response;
eval {
if( &Term::ReadKey::termoptions() == 1) {
$response = "Term::ReadKey is using TERMIOS, as opposed to TERMIO or SGTTY.\n";
} elsif( &Term::ReadKey::termoptions() == 2) {
$response = "Term::ReadKey is using TERMIO, as opposed to TERMIOS or SGTTY.\n";
} elsif( &Term::ReadKey::termoptions() == 3) {
$response = "Term::ReadKey is using SGTTY, as opposed to TERMIOS or TERMIO.\n";
} elsif( &Term::ReadKey::termoptions() == 4) {
$response = "Term::ReadKey is trying to make do with stty; facilites may be limited.\n";
} elsif( &Term::ReadKey::termoptions() == 5) {
$response = "Term::ReadKey is using Win32 functions.\n";
} else {
$response = "Term::ReadKey could not find any way to manipulate the terminal.\n";
}
print "ok 3\n";
};
print "not ok 3\n" if $@;
print $response if $interactive;
eval
{
push(@modes,"O_NODELAY") if &Term::ReadKey::blockoptions() & 1;
push(@modes,"poll()") if &Term::ReadKey::blockoptions() & 2;
push(@modes,"select()") if &Term::ReadKey::blockoptions() & 4;
push(@modes,"Win32") if &Term::ReadKey::blockoptions() & 8;
print "ok 4\n";
};
print "not ok 4\n" if $@;
if ($interactive )
{
if(&Term::ReadKey::blockoptions()==0)
{
print "No methods found to implement non-blocking reads.\n";
print " (If your computer supports poll(), you might like to read through ReadKey.xs)\n";
}
else
{
print "Non-blocking reads possible via ",makenicelist(@modes),".\n";
print $modes[0]." will be used. " if @modes>0;
print $modes[1]." will be used for timed reads." if @modes>1 and $modes[0] eq "O_NODELAY";
print "\n";
}
}
eval
{
@size = GetTerminalSize(OUT);
print "ok 5\n";
};
print "not ok 5\n" if $@;
if ( $interactive )
{
if(!@size) {
print "GetTerminalSize was incapable of finding the size of your terminal.";
} else {
print "Using GetTerminalSize, it appears that your terminal is\n";
print "$size[0] characters wide by $size[1] high.\n\n";
}
}
eval
{
@speeds = GetSpeed();
print "ok 6\n";
};
print "not ok 6\n" if $@;
if ( $interactive )
{
if(@speeds) {
print "Apparently, you are connected at ",join("/",@speeds)," baud.\n";
} else {
print "GetSpeed couldn't tell your connection baud rate.\n\n";
}
print "\n";
}
eval
{
%chars = GetControlChars(IN);
print "ok 7\n";
};
print "not ok 7\n" if $@;
%origchars = %chars;
if ( $interactive )
{
for $c (keys %chars) { $chars{$c} = makenice($chars{$c}) }
print "Control chars = (",join(', ',map("$_ => $chars{$_}",keys %chars)),")\n";
}
eval
{
SetControlChars(%origchars, IN);
print "ok 8\n";
};
print "not ok 8\n" if $@;
#SetControlChars("FOOFOO"=>"Q");
#SetControlChars("INTERRUPT"=>"\x5");
END { ReadMode 0, IN; } # Just if something goes weird
exit(0) unless $interactive;
print "\nAnd now for the interactive tests.\n";
print "\nThis is ReadMode 1. It's guarranteed to give you cooked input. All the\n";
print "signals and editing characters may be used as usual.\n";
ReadMode 1, IN;
print "\nYou may enter some text here: ";
$t = ReadLine 0, IN;
chop $t;
print "\nYou entered `$t'.\n";
ReadMode 2, IN;
print "\nThis is ReadMode 2. It's just like #1, but echo is turned off. Great\n";
print "for passwords.\n";
print "\nYou may enter some invisible text here: ";
$t = ReadLine 0, IN;
chop $t;
print "\nYou entered `$t'.\n";
ReadMode 3, IN;
print "\nI won't demonstrate ReadMode 3 here. It's your standard cbreak mode,\n";
print "with editing characters disabled, single character at a time input, but\n";
print "with the control characters still enabled.\n";
print "\n";
print "I'm now putting the terminal into ReadMode 4 and using non-blocking reads.\n";
print "All signals should be disabled, including xon-xoff. You should only be\n";
print "able to exit this loop via 'q'.\n";
ReadMode 4, IN;
$k = "";
#$in = *STDIN;
$in = \*IN; # or *IN or "IN"
while($k ne "q")
{
print "Press a key, or \"q\" to stop: ";
$count=0;
#print "IN = $in\n";
$count++ while !defined($k=ReadKey(-1, $in));
#print "IN2 = $in\n";
print "\nYou pressed `",makenice($k),"' after the loop rolled over $count times\n";
}
ReadMode 0, IN;
print "\nHere is a similar loop which times out after two seconds:\n";
ReadMode 4, IN;
$k = "";
#$in = *STDIN;
$in = \*IN; # or *IN or "IN"
while($k ne "q")
{
print "Press a key, or \"q\" to stop: ";
$count=0;
#print "IN = $in\n";
print "Timeout! " while !defined($k=ReadKey(2, $in));
#print "IN2 = $in\n";
print "\nYou pressed `",makenice($k),"'\n";
}
print "\nLastly, ReadMode 5, which also affects output (except under Win32).\n\n";
ReadMode 5, IN;
print "This should be a diagonal line (except under Win32): *\n*\n*\n\*\n*\n*\r\n\r\n";
print "And this should be a moving spot:\r\n\r\n";
$width = (GetTerminalSize(OUT))[0];
$width/=2;
$width--;
if($width<10) { $width=10;}
for ($i=0;$i<20;$i+=.15) {
print "\r";
print (" " x ((cos($i)+1)*$width));
print "*";
select(undef, undef, undef, 0.01);
print "\r";
print (" " x ((cos($i)+1)*$width));
print " ";
}
print "\r ";
print "\n\r\n";
ReadMode 0, IN;
print "That's all, folks!\n";
|