Term::TermKey: How to enable wide mouse support? - perl

When I run this script, the position of the mouse works up to the column 255 - then the count begins by 0. Does this mean that my terminal does not support SGR/mode 1006?
(edited due ak2's answer)
#!/usr/bin/env perl
use warnings;
use 5.12.0;
use utf8;
use Term::TermKey qw(FLAG_UTF8 FORMAT_LONGMOD FORMAT_MOUSE_POS);
my $tk = Term::TermKey->new( \*STDIN );
binmode STDOUT, ':encoding(UTF-8)' if $tk->get_flags & FLAG_UTF8;
$|++;
print "\e[?1003h";
print "\e[?1006h";
say "Quit with \"q\"";
while( 1 ) {
$tk->waitkey( my $key );
say $tk->format_key( $key, FORMAT_LONGMOD | FORMAT_MOUSE_POS );
last if $tk->format_key( $key, 0 ) eq 'q';
}
print "\e[?1006l";
print "\e[?1003l";

No.
It means you're not using the very lastest libtermkey library yet, the one that supports positions greater than column 255. Possibly because I haven't actually released it yet ;)
I'll let you know once that's up, along with the extra CSI capture support for position reporting, etc..
Also: If you have more libtermkey-specific questions, you might want to let me know more directly. E.g. you could email me to let me know you've posted a question; I don't always make a habit of searching them out. :)
Edit 2012/04/26: I've now released libtermkey 0.15 and Term::TermKey 0.14, which supports these columns above 255, along with the position report API.

Switching on mode 1006 changes the mouse event encoding, but it doesn't actually enable mouse reporting. For that, you'll need to switch on mode 1000 (click and release only), 1002 (click, release and drag), or 1003 (click, release, and any mouse movement).

Related

sleep function stops script [duplicate]

Today in my college a teacher asked me a question. He wrote this code on the paper and said
"What will be the output of this code?"
use warnings;
for (1 .. 20)
{
print ".";
}
I found it easy and said that it will loop 20 times and at each iteration it will print a dot (.) and hence total 20 dots will be the output.
He said you are right and then he made some changes in the code. The code was:
use warnings;
for (1 .. 20)
{
print ".";
sleep 1;
}
He said the what will be the output now? I didn't know about the sleep function, I guessed that at each iteration it will print the dot (.) and then it will wait for 1 second (because of the sleep function) and then again it will iterate and then again it will print (.) then it will wait for 1 second and so on...
The teacher told me to check it at home. I tried it at home and I came to know that the second code waits for 20 seconds and then it prints all dots (20 dots) at once. I want to know how this happened? Why isn't the dot (.) is getting print on each iteration?
The real issue has nothing to do with sleep, but rather that............
You are Suffering from Buffering. The link provided takes you to an excellent article from The Perl Journal circa 1998 from Marc Jason Dominus (the author of Higher-Order Perl). The article may be over a decade old, but the topic is as relevant today as it was when he wrote it.
Others have explained the $| = 1; technique. I would add to those comments that in the predominant thinking of the Perl community seems to be that $| = 1 is preferable over $|++ simply because it is clearer in its meaning. I know, autoincrement is pretty simple too, but does everyone who will ever look at your code know $|'s behavior when ++ or -- are applied (without looking it up in perlvar). I happen to also prefer to localize any modification of Perl's "special variables" so that the effects are not washing over into other portions of code that may not play nice with a particular change to default Perl behavior. So that being the case, I would write it as:
use strict;
use warnings;
{
local $| = 1;
for ( 1 .. 20 ) {
print '.';
sleep 1;
}
}
Perl, and many other programs, line-buffer output by default. You can set $| to 1 if you need unbuffered output.
It's not clearing the buffer. If there is a newline at the end of the print statement it will do that for you automatically:
use warnings;
for (1 .. 20) {
print ".\n";
sleep 1;
}
If you don't want the newline (I don't imagine you do) you can use the special autoflush variable $|. Try setting it to 1 or incrementing it.
use warnings;
$|++;
for (1 .. 20) {
print ".";
sleep 1;
}

Why does opening a file in utf 8 mode change the behaviour of seek?

Here's a simple text file with no special characters, called utf-8.txt with the following content.
foo bar baz
one two three
The new line is following the unix convention (one byte), so that the entire size of the file is 26 = 11 + 1 + 13 + 1. (11 = foo bar baz, 13 = one two three.
If I read the file with the following perl script
use warnings;
use strict;
open (my $f, '<', 'utf8.txt');
<$f>;
seek($f, -4, 1);
my $xyz = <$f>;
print "$xyz<";
it prints
baz
<
This is expected, since the seek command goes back four characters, the new line and the three belonging to baz.
If I now change the open statement to
open (my $f, '<:encoding(UTF-8)', 'utf8.txt');
the output changes to
baz
<
that is, the seek command goes back five characters (or it goes back four characters but skips the new line).
Is this behaviour expected? Is there a flag or somthing to turn this behaviour off?
Edit
As per Andrzej A. Filip suggestion, when I add print join("+",PerlIO::get_layers($f)),"\n"; just after the open statement, it prints in the "normal" open case: unix+crlf and in the open...encoding case: unix+crlf+encoding(utf-8-strict)+utf8.
For those looking for a TL;DR, seek and tell work in bytes. seek should always be okay if it uses values returned by tell
The documentation for Perl's seek operator is rather clumsy but it has this
seek FILEHANDLE,POSITION,WHENCE
The values for WHENCE are 0 to set the new position in bytes to POSITION ...
and
Note the in bytes: even if the filehandle has been set to operate on characters (for example by using the :encoding(utf8) open layer), tell() will return byte offsets, not character offsets (because implementing that would render seek() and tell() rather slow).
While this alludes to the problem it isn't stated explicitly
seek and tell use and return byte offsets within the file, regardless of any other PerlIO layer. That means they work on similar terms to sysread which is independent of Perl's streaming IO, although seek and tell respect Perl's buffering whereas sysread does not
It isn't just :utf8 or :encoding layers that confuse what units you may expect: the Windows :crlf layer also has an effect because it converts CR LF pairs to LF before streaming input and after output. That clearly causes a discrepancy for every line of text, but as far as I can tell this isn't mentioned in Perl's documentation; Linux and OSX being the pushy ugly sisters of pretty much every other Perl platform
Let's look at your code. I've run this code (it's identical to the code in your question, I promise) on my Windows 10 and Windows 7 systems, and even booted a VM with Windows 98 to try the same thing
use warnings;
use strict;
open (my $f, '<', 'utf8.txt');
print join("+",PerlIO::get_layers($f)),"\n";
<$f>;
seek($f, -4, 1);
my $xyz = <$f>;
print "$xyz<";
All of them output this
unix+crlf
az
which is what I expected, and not what you say you get. This is central since we're talking about single-byte offsets
Your file contains this
foo bar baz\r\none two three
The first read takes us to 13 characters from the start. Perl has read foo bar baz\r\n and removed the CR, handing foo bar baz\n to the program, which it discards. Fine
Now you seek($f, -4, 1)
That third parameter 1 is SEEK_CUR, which means you want to move the current read pointer relative to the current position.
Please
Please don't use magic numbers. Perl is pretty much exposing the underlying C file library to you here and you need to be responsible with it. Passing 1 as the third parameter is arcane and irresponsible. No one who reads your code will know what you have written
Do this
use Fcntl ':seek'
and then you can write more intelligible code like this. At least people can google SEEK_CUR whereas trying the same with 1 would be worse than fruitless
seek($f, -4, SEEK_CUR)
as it gives the rest of us a chance to understand your code
So you're seeking to 13 bytes, add -4 which is 9. That's just after the b of baz, and so I get az
That's what all my runs of your code produced on all of those different Windows machines. I have to think that the problem is with your code control and not with Perl, except for the issue with CRLF
I hope that this explained some anomalies for you, but please check your code and your results.

Perl printf Spacing

I'm using printf to print out data in 2 columns. The first column is max 12 characters, but the data in the second column can get quite long. Is there a way to make it start from the same indentation that it starts on the first line after it line-wraps?
printf("%-12s\t%s", $key, $result);
I suggest that you use the core library Text::Wrap.
The following would implement what you're talking about:
use strict;
use warnings;
use Text::Wrap;
local $Text::Wrap::columns = 72;
while (<DATA>) {
my ($word, $paragraph) = split ' ', $_, 2;
print wrap(sprintf("%-12s", $word), ' 'x12, $paragraph), "\n";
}
__DATA__
one The fallen python hurts behind your entering delight. A leader defects within the birth! The torture overflows? The verdict beams behind the energy.
two A convinced undergraduate seasons the bonus. The present alert mends inside the gesture. How will the publicized coordinate swallow a log panic?
three A tourist faints? An alive biography behaves on top of a grief. A storm scares a conductor throughout an anxious initiate.
Outputs:
one The fallen python hurts behind your entering delight. A
leader defects within the birth! The torture overflows?
The verdict beams behind the energy.
two A convinced undergraduate seasons the bonus. The present
alert mends inside the gesture. How will the publicized
coordinate swallow a log panic?
three A tourist faints? An alive biography behaves on top of a
grief. A storm scares a conductor throughout an anxious
initiate.
I don't think printf can do what you want by itself, but you can do the wrapping yourself. The following example is primitive but usable:
sub wrap {
my ($str, $first_col_size, $max_col_size) = #_;
my $ret = $str;
$ret =~ s/(.{$max_col_size})/"$1\n" . (' ' x $first_col_size) . "\t"/ge;
$ret;
}
printf("%-12s\t%s\n", $key, wrap($result, 12, 60));
Or maybe you could use something like Text::ASCIITable on CPAN to do what you need.

terminal: where am I?

Is there a variable or a function, which can tell me the actual position of the cursor?
#!/usr/bin/env perl
use warnings;
use 5.012;
use Term::ReadKey;
use Term::Cap;
use POSIX;
my( $col, $row ) = GetTerminalSize();
my $termios = new POSIX::Termios;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
# some movement ...
# at which position (x/y) is the cursor now?
You could use curses instead. It has getcurx() and getcurx(). There is a CPAN module for it (and the libcurses-perl package in Debian or Ubuntu).
I don't think you can determine the cursor position using termcap.
The termutils manual says:
If you plan to use the relative cursor motion commands in an application program, you must know what the starting cursor position is. To do this, you must keep track of the cursor position and update the records each time anything is output to the terminal, including graphic characters.
Some terminals may support querying the position, as CSI 6 n. If supported, the position will be reported as CSI Pl;Pc R. For example
$ echo -e "\e[6n"; xxd
^[[4;1R
0000000: 1b5b 343b 3152 0a .[4;1R.
This reports the cursor as being at the 1st column of the 4th line (counting from 1).
However, this probably ought not be relied upon, as not very many terminals actually support this.
Printing ESC[6n at ANSI compatible terminals will give you the current cursor position as ESC[n;mR, where n is the row and m is the column
So try reading it with terminal escape characters. Something like that:
perl -e '$/ = "R";' -e 'print "\033[6n";my $x=<STDIN>;my($n, $m)=$x=~m/(\d+)\;(\d+)/;print "Current position: $m, $n\n";'

Is it possible to clear the terminal with Term::ReadKey?

Is there a way to do this with the Term::ReadKey-module?
#!/usr/bin/env perl
use warnings;
use 5.012;
use Term::Screen;
say( "Hello!\n" x 5 );
sleep 2;
my $scr = Term::Screen->new();
$scr->clrscr();
I don't know why Term::ReadKey would provide such a feature or if it does. But, how about:
#!/usr/bin/env perl
use strict; use warnings;
*clrscr = $^O eq 'MSWin32'
? sub { system('cls') }
: sub { system('clear') };
print "Hello\n" for 1 .. 5;
sleep 2;
clrscr();
Not sure why you want to use Term::Readkey for clearing the screen. It definitely does not have that capability. Are you trying to use something that's part of the standard Perl installation? You can use Term::Caps which is part of the standard Perl installation. Unfortunately, it requires the Termcaps file to be on the system, and Windows doesn't have that.
use Term::Cap;
#
# Use eval to catch the error when TERM isn't defined or their is no
# Termcap file on the system.
#
my $terminal;
eval {$terminal = Term::Cap->Tgetent();};
#
# Use 'cl' to get the Screen Clearing sequence
#
if ($#) { #Most likely a Windows Terminal
system('cls'); #We really should be doing the 2 line below
# my $clear = "\e[2J"; #But, it doesn't seem to work.
# print "$clear"; #Curse You! I'll get you yet Bill Gates!
} else { #A Real Computer
my $clear = $terminal->Tputs('cl');
print "$clear";
}
print "All nice and squeeky clean!\n";
I tried printing the ANSI Escape sequence if it was a Windows Terminal, but it doesn't seem to work.
I hate doing system calls because there is a security risk . What if someone changed the cls command on you?
Term::Readkey does not provide this function directly, but usually the key combination to clear the screen in a Terminal is ^L (Control-L):
Binary
Oct
Dec
Hex
Asc
Sym
Text
00001100
14
12
c
ff
^L
Form Feed (Next Page)
So, if you want to build this in to your application using that module, you can do something like this:
use Term::ReadKey;
# Perform a normal read using getc
my $key = ReadKey( 0 );
# If ^L was pressed, clear the screen
if ( ord $key == 12 ) { print "\e[2J" }
The above example uses the raw escape sequence \e[2J which clears the entire screen. You also have the following alternatives:
Sequence
Function
\e[J
Clears from cursor until end of screen
\e[0J
Clears from cursor until end of screen
\e[1J
Clears from cursor to beginning of screen
\e[2J
Clears entire screen
\e[K
Clears from cursor to end of line
\e[0K
Clears from cursor to end of line
\e[1K
Clears from cursor to start of line
\e[2K
Clears entire line
The escape code \e refers to ASCII character number 27:
Binary
Oct
Dec
Hex
Asc
Sym
Text
00011011
33
27
1b
esc
^[
Escape
See VT100 Escape Sequences for more information.
This should even work if you're using Windows, since apparently this works there nowadays.