package Terminal::Control;
# This package provides the basis for improving and studying Terminal Window
# control. Essentially, the Perl header 'sys/ioctl.ph', the SHELL command stty
# and ASCII escape sequences are used.

# Load the basic Perl pragmas.
use 5.030000;
use strict;
use warnings;

# Load the Perl pragma Exporter.
use Exporter;

# Load the neccessary Perl modules.
use bytes;
use Try::Catch;
use Time::HiRes qw(ualarm);

# Set the package version. 
our $VERSION = '0.05';

# Base class of this module.
our @ISA = qw(Exporter);

# Exporting the implemented subroutines.
our @EXPORT = qw(
    reset_screen
    clear_screen
    reset_terminal  
    clear_terminal  
    reset
    clear
    winsize
    chars
    pixels
    get_cursor_position
    set_cursor_position
    echo_on
    echo_off 
    cursor_on
    cursor_off
    winsize_pixels
    screen_size_pixels
    screen_size_chars
    window_size_chars
    window_size_pixels
    ctlseqs_request
);

# Set the global variables.
our($ESC, $CSI, $OSC);

# Set some constants.
$ESC = "\033";  # Escape
$CSI = "\033["; # Control Sequence Introducer
$OSC = "\033]"; # Operating System Command

# Declare global variable
my $is_eval;

# BEGIN block.
BEGIN {
    # Try to load sys/ioctl.ph.
    $is_eval = ((eval "require 'sys/ioctl1.ph'") ? 1 : 0);
    if ($is_eval ne 1) {
        # Print message into the terminal window.
        print "sys/ioctl.ph is missing\n";
        # Assign winsize to winsize_stty.
        *winsize = \&winsize_stty;
    } else {
        # Assign winsize to winsize_ioctl.
        *winsize = \&winsize_ioctl;
    };
    # Define some subroutine aliases.
    *reset_terminal = \&reset_screen;
    *clear_terminal = \&clear_screen;
    *reset = \&reset_screen;
    *clear = \&clear_screen;
};

#------------------------------------------------------------------------------# 
# Subroutine clear_screen                                                      #
#                                                                              #
# Description:                                                                 #
# Clear the terminal window using escape sequences.                            #
#------------------------------------------------------------------------------# 
sub clear_screen {
    # Clear screen.
    my $escseq = "${CSI}2J${CSI}1;1H";
    # Get length of the escape sequence.
    my $buflen = length($escseq);
    # Write escape sequence to STDOUT.
    syswrite(STDOUT, $escseq, $buflen, 0);
};

#------------------------------------------------------------------------------# 
# Subroutine reset_screen                                                      #
#                                                                              #
# Description:                                                                 #
# Reset the terminal window using escape sequences.                            #
#------------------------------------------------------------------------------# 
sub reset_screen {
    # Reset screen. 
    my $escseq = "${ESC}c";
    # Get length of the escape sequence.
    my $buflen = length($escseq);
    # Write escape sequence to STDOUT.
    syswrite(STDOUT, $escseq, $buflen, 0);
};

#------------------------------------------------------------------------------# 
# Subroutine cursor_on                                                         #
#                                                                              #
# Description:                                                                 # 
# Shows the cursor in the terminal window. Perform a system call on stty. Use  #
# stty for reading from tty and writing to tty. Redirect stderr to stdout.     #
#------------------------------------------------------------------------------# 
sub cursor_on {
    # Show the cursor.
    print "${CSI}?25h";
};

#------------------------------------------------------------------------------# 
# Subroutine cursor_off                                                        #
#                                                                              #
# Description:                                                                 # 
# Hides the cursor in the terminal window. Perform a system call on stty. Use  #
# stty for reading from tty and writing to tty. Redirect stderr to stdout.     #
#------------------------------------------------------------------------------# 
sub cursor_off {
    # Hide the cursor.
    print "${CSI}?25l";
};

#------------------------------------------------------------------------------# 
# Subroutine echo_on                                                           #
#                                                                              #
# Description:                                                                 # 
# Shows user input in the terminal window. Perform a system call on stty. Use  #
# stty for reading from tty and writing to tty. Redirect stderr to stdout.     #
#------------------------------------------------------------------------------# 
sub echo_on {
    # Turn echo on.
    system("stty echo </dev/tty >/dev/tty 2>&1");
};

#------------------------------------------------------------------------------# 
# Subroutine echo_off                                                          #
#                                                                              #
# Description:                                                                 # 
# Hides user input in the terminal window. Perform a system call on stty. Use  #
# stty for reading from tty and writing to tty. Redirect stderr to stdout.     #
#------------------------------------------------------------------------------# 
sub echo_off {
    # Turn echo off.
    system("stty -echo </dev/tty >/dev/tty 2>&1");
};

#------------------------------------------------------------------------------# 
# Subroutine get_cursor_position                                               #
#                                                                              #
# Description:                                                                 #
# Get the position of the cursor in the terminal window.                       #
#------------------------------------------------------------------------------# 
sub get_cursor_position {
    # Initialise the local variables.
    my $seq = '';
    my $chr = '';
    # Change the settings of the terminal window.
    system "stty cbreak -echo </dev/tty >/dev/tty 2>&1";
    # Print escape sequence.
    print STDOUT "${CSI}6n";
    # Read chars von STDIN.
    while (($chr = getc(STDIN)) ne "R") {
        $seq .= $chr;
    };
    # Restore the settings of the terminal window.
    system "stty -cbreak echo </dev/tty >/dev/tty 2>&1";
    # Get rows and cols.
    my ($y, $x) = $seq =~ /(\d+)\;(\d+)/;
    # Return rows and cols.
    return ($y, $x);
};

#------------------------------------------------------------------------------# 
# Subroutine set_cursor_position                                               #
#                                                                              #
# Description:                                                                 #
# Set the position of the cursor in the terminal window. Moves the cursor to   #
# row n and column m. The top left corner is row 1 and column 1.               #
#------------------------------------------------------------------------------# 
sub set_cursor_position {
    # Assign the subroutine arguments to the local variables.
    my ($n, $m) = @_;
    # Set the new cursor position.
    print "${CSI}${n};${m}H";
};

#------------------------------------------------------------------------------# 
# Subroutine ctlseqs_request                                                   #
#                                                                              #
# Description:                                                                 #
# Get the response from escape sequence.                                       #
#------------------------------------------------------------------------------# 
sub ctlseqs_request {
    # Assign the subroutine arguments to the local variables.
    my ($Ps, $user_timeout) = @_;
    # Define the signal handler.
    local $SIG{ALRM} = sub {die "timeout"};
    # Initialise the local variables.
    my ($width, $height) = undef;
    my $buf = '';
    my $chr = '';
    my $timeout = 1_000_000;
    # Change the timeout.
    $timeout = (defined $user_timeout) ? $user_timeout : $timeout;
    # Change the settings of the terminal window.
    system "stty cbreak -echo </dev/tty >/dev/tty 2>&1";
    # Print the escape sequence.
    print STDOUT "${CSI}${Ps}t";
    # Non blocking reading from STDIN.
    eval {
        # Invoke an alarm.
        ualarm $timeout;
        # Read chars from STDIN. 
        while (($chr = getc(STDIN)) ne "") {
            $buf .= $chr;
        };
        # Stop the alarm.
        ualarm 0;
    };
    if ($buf eq '') {
        # Set width and height.
        ($width, $height) = (-1, -1);
    } else {
        # Get width and height.
        my $re = qr/\d+;(\d+)\;(\d+)/;
        ($width, $height) = ($buf =~ $re) ? ($buf =~ $re) : (-2, -2);
    };
    # Restore the settings of the terminal window.
    system "stty -cbreak echo </dev/tty >/dev/tty 2>&1";
    # Return width and height.
    return ($width, $height);
};

#------------------------------------------------------------------------------# 
# Subroutine window_size_pixels                                                #
#                                                                              #
# Description:                                                                 #
# Xterm Control Sequences                                                      #
# Request: CSI Ps t                                                            #
# Response: Ps = 14 -> Reports xterm window size in pixels as                  #
#                      CSI 4 ; width ; height t                                #
#------------------------------------------------------------------------------# 
sub window_size_pixels {
    # Set the timeout.
    my $timeout = $_[0];
    # Get width and height.
    my ($x, $y) = ctlseqs_request("14", $timeout);
    # Return width and height.
    return ($x, $y);
};

#------------------------------------------------------------------------------# 
# Subroutine screen_size_pixels                                                #
#                                                                              #
# Description:                                                                 #
# Xterm Control Sequences                                                      #
# Request: CSI Ps t                                                            #
# Response: Ps = 15 -> Reports xterm screen size in pixels as                  #
#                      CSI 5 ; width ; height t                                #
#------------------------------------------------------------------------------# 
sub screen_size_pixels {
    # Set the timeout.
    my $timeout = $_[0];
    # Get width and height.
    my ($x, $y) = ctlseqs_request("15", $timeout);
    # Return width and height.
    return ($x, $y);
};

#------------------------------------------------------------------------------# 
# Subroutine window_size_chars                                                 #
#                                                                              #
# Description:                                                                 #
# Xterm Control Sequences                                                      #
# Request: CSI Ps t                                                            #
# Response: Ps = 18 -> Reports xterm window size in chars as                   #
#                      CSI 8 ; width ; height t                                #
#------------------------------------------------------------------------------# 
sub window_size_chars {
    # Set the timeout.
    my $timeout = $_[0];
    # Get width and height.
    my ($x, $y) = ctlseqs_request("18", $timeout);
    # Return width and height.
    return ($x, $y);
};

#------------------------------------------------------------------------------# 
# Subroutine screen_size_chars                                                 #
#                                                                              #
# Description:                                                                 #
# Xterm Control Sequences                                                      #
# Request: CSI Ps t                                                            #
# Response: Ps = 19 -> Reports xterm window size in chars as                   #
#                      CSI 9 ; width ; height t                                #
#------------------------------------------------------------------------------# 
sub screen_size_chars {
    # Set the timeout.
    my $timeout = $_[0];
    # Get width and height.
    my ($height, $width) = ctlseqs_request("19", $timeout);
    # Return width and height.
    return ($height, $width);
};

#------------------------------------------------------------------------------# 
# Subroutine winsizwe_pixels                                                   #
#                                                                              #
# Description:                                                                 #
# Get winsize in pixels.                                                       #
#------------------------------------------------------------------------------# 
sub winsize_pixels {
    # Initialise the local variables.
    my $seq = '';
    my $chr = '';
    # Change the settings of the terminal window.
    system "stty cbreak -echo </dev/tty >/dev/tty 2>&1";
    # Print escape sequence.
    print STDOUT "${CSI}14t";
    # Read chars von STDIN.
    while (($chr = getc(STDIN)) ne "t") {
        $seq .= $chr;
    };
    # Restore the settings of the terminal window.
    system "stty -cbreak echo </dev/tty >/dev/tty 2>&1";
    # Get rows and cols.
    my ($x, $y) = $seq =~ m/(\d+)\;(\d+)$/;
    # Return rows and cols.
    return ($x, $y)
};

#------------------------------------------------------------------------------# 
# Subroutine winsize                                                           #
#                                                                              #
# Description:                                                                 #
# Get winsize using system ioctl call.                                         #
#------------------------------------------------------------------------------# 
sub winsize_ioctl {
    # Initialise the local variables.
    my ($rows, $cols, $xpix, $ypix) = (undef, undef, undef, undef);
    my $winsize = "";
    # Try to get the winsize.
    try {
        # Check the ioctl call of TIOCGWINSZ.
        ($rows, $cols, $xpix, $ypix) = (
            (ioctl(STDOUT, TIOCGWINSZ(), $winsize)) ?
            (unpack 'S4', $winsize) :
            (map {$_ * 0} (1..4))
            );
    } catch {
        ($rows, $cols, $xpix, $ypix) = (-1, -1, -1, -1);
    };
    # Return rows, cols and xpix, ypix.
    return ($rows, $cols, $xpix, $ypix);
};

#------------------------------------------------------------------------------# 
# Subroutine winsize                                                           #
#                                                                              #
# Description:                                                                 #
# Get winsize using system stty.                                               #
#------------------------------------------------------------------------------# 
sub winsize_stty {
    # Initialise the local variable.
    my $winsize = "";
    # Get winsize from stty.
    $winsize = qx/stty size/;
    my ($y, $x) = $winsize =~ m/(\d+) (\d+)/s;
    # Create list with rows, cols, xpix and ypix. 
    my ($rows, $cols, $xpix, $ypix) = ($y, $x, -1, -1);
    # Return rows, cols and xpix, ypix.
    return ($rows, $cols, $xpix, $ypix);
};

#------------------------------------------------------------------------------# 
# Subroutine chars                                                             #
#                                                                              #
# Description:                                                                 #
# Get rows and columns using system ioctl call.                                #
#------------------------------------------------------------------------------# 
sub chars {
    # Declare rows and columns.
    my ($rows, $cols) = (undef, undef);
    # Get a list from winsize.
    my @list = winsize();
    # Extract rows and columns.
    ($rows, $cols) = ($list[0], $list[1]);
    # Return chars.
    return ($rows, $cols);
};

#------------------------------------------------------------------------------# 
# Subroutine pixels                                                            #
#                                                                              #
# Description:                                                                 #
# Get pixels using system ioctl call.                                          #
#------------------------------------------------------------------------------# 
sub pixels {
    # Declare xpix and ypix.
    my ($xpix, $ypix) = (undef, undef);
    # Get a list from winsize.
    my @list = winsize();
    # Extract xpix and ypix.
    ($xpix, $ypix) = ($list[2], $list[3]);
    # Return pixels.
    return ($xpix, $ypix);
};

1;

__END__
# Below is the package documentation.

=head1 NAME

Terminal::Control - Perl extension for the terminal window control

=head1 SYNOPSIS

  use Terminal::Control;

  # Clear screen.
  clear_screen();

  # Reset screen.
  reset_screen();

  # Get terminal size and print to screen.
  my ($rows, $cols, $xpix, $ypix) = winsize();
  printf ("%s\n%s\n%s\n%s\n", $rows, $cols, $xpix, $ypix);

  # Get chars and print to screen.
  ($rows, $cols) = chars();
  printf ("%s\n%s\n", $rows, $cols);

  # Get pixels and print to screen. 
  ($xpix, $ypix) = pixels();
  printf ("%s\n%s\n", $xpix, $ypix);

  # Get cursor position.
  my ($y, $x) = get_cursor_position();
  printf ("%s\n%s\n", $y, $x);

  # Set cursor position.
  my $y = 20; 
  my $x = 80; 
  set_cursor_position($y, $x);

=head1 Requirement

The Perl header 'sys/ioctl.ph' is required for the ioctl call of the function
TIOCGWINSZ. The equivalent C/C++ header is 'sys/ioctl.h'. The Perl command h2ph
converts '.h' C/C++ header files to '.ph' Perl header files.

In contrast to modules in general, the module installation process cannot be told
to create a sys/ioctl.ph. This is necessary manually via the h2ph command.

To prevent tests within CPAN from failing due to a missing sys/ioctl.ph, a fallback
solution based on the BASH command stty is programmed.   

=head1 Motivation

The idea for the necessity of the module arises from the fact that especially 
the system call system("reset") of the BASH command reset is noticeably slow.
The BASH command reset is slow, the system call system("reset") is slower. By
using so-called ASCII escape sequences, a significant acceleration can be
achieved. The logical consequence is the programming of a Perl command that
replaces the system call. A simple method is the best way to realise this. There
is no need to implement a special Class to achive this.  

=head1 Benchmark

Exemplary comparison comparison of time of execution:

system("reset")  =>  1.026892 Seconds = 1026,892 Milliseconds = 1026892 Microseconds
  
reset_screen()   =>  0.000076 Seconds =    0,076 Milliseconds = 76 Microseconds

This one example already shows a significant advantage of the new routine.

=head1 DESCRIPTION

=head2 Implemented Methods

The following methods have been implemented so far:

=over 4 

=item * clear_screen()

=item * reset_screen()

=item * get_cursor_position()

=item * set_cursor_position()

=item * winsize()

=item * chars()

=item * pixels()

=item * echo_on()

=item * echo_off()

=item * cursor_on()

=item * cursor_off()

=back

=head1 Aliases

clear_screen and reset_screen can also be used with this aliases:

  reset_terminal  <=  reset_screen
  clear_terminal  <=  clear_screen
  reset           <=  reset_screen
  clear           <=  clear_screen

=head2 Method description

The method clear_screen is clearing the terminal. This is similar to the system call system('clear').
The method reset_screen is reseting the terminal. This is similar to the system call system('reset').

The method winsize gets the dimensions in x-direction and y-direction of the terminal. The methods chars
and pixels extract chars (rows and cols) and pixels (xpix and ypix.)

The method get_cursor_position() gets the current cursor position in the terminal window. The method
set_cursor_position() sets the cursor position in the terminal window.
 
echo_on and echo_off turnes echo of commands on or off. cursor_on and cursor_off shows or hides the cursor.

=head1 Programmable background

The methods clear_screen and reset_screen are using escape sequences. Doing this
no other Perl modules are needed to clear and reset a screen. Both are in principle
one liners.

The method winsize is using the C/C++ header for the system ioctl call and there
the command TIOCGWINSZ. The call return winsize in rows and cols and xpix and ypix.

=head1 SEE ALSO

ASCII escape sequences

=head1 AUTHOR

Dr. Peter Netz, E<lt>ztenretep@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2022 by Dr. Peter Netz

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.30.0 or,
at your option, any later version of Perl 5 you may have available.

=cut
