File Coverage

blib/lib/Ragnetto/Console.pm

Criterion	Covered	Total	%
statement	51	91	56.0
branch	12	48	25.0
condition	3	24	12.5
subroutine	16	22	72.7
pod	13	13	100.0
total	95	198	47.9

# ------------------------------------------------------------------------------
#  Ragnetto-Console
# ------------------------------------------------------------------------------
#  File	: console.pm
#  Description	: ANSI console control utility
#  Language	: Perl
# ------------------------------------------------------------------------------
#  Project	: ragnetto-console
#  Author		: Gabriele Secci
#  Editor		: Ragnetto(R) Software
#  E-Mail		: [e-mail]
# ------------------------------------------------------------------------------
#  Notes
#  - This module provides terminal manipulation functions.
#  - It is part of the Ragnetto module suite.
# ------------------------------------------------------------------------------
#  Copyright (C) 2026 - All Rights Reserved
# ------------------------------------------------------------------------------

package Ragnetto::Console;
our $VERSION = '0.01';

use strict;
use warnings;
use utf8;
use Exporter 'import';
use IO::Handle;

our (@EXPORT_OK, %EXPORT_TAGS);

BEGIN {
    my @color_names = qw(BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE GRAY LIGHT_RED LIGHT_GREEN LIGHT_YELLOW LIGHT_BLUE LIGHT_MAGENTA LIGHT_CYAN LIGHT_WHITE);
    my @state_names = qw(OFF ON);
    my @shape_names = qw(BLOCK_BLINK BLOCK_STEADY UNDER_BLINK UNDER_STEADY BAR_BLINK BAR_STEADY);
    my @func_names  = qw(clear forecolor backcolor cursor caret position write reset title width height getkey putkey);

    @EXPORT_OK = (@color_names, @state_names, @shape_names, @func_names);
    %EXPORT_TAGS = (
        colors => \@color_names,
        states => \@state_names,
        shapes => \@shape_names,
        all    => \@EXPORT_OK,
    );
}

# ------------------------------------------------------------------------------
#  CORE CONSTANTS
# ------------------------------------------------------------------------------

use constant {
    BLACK => 0, RED => 1, GREEN => 2, YELLOW => 3, BLUE => 4, MAGENTA => 5, CYAN => 6, WHITE => 7,
    GRAY => 8, LIGHT_RED => 9, LIGHT_GREEN => 10, LIGHT_YELLOW => 11, LIGHT_BLUE => 12, LIGHT_MAGENTA => 13, LIGHT_CYAN => 14, LIGHT_WHITE => 15,
    OFF => 0, ON => 1,
    BLOCK_BLINK => 1, BLOCK_STEADY => 2, UNDER_BLINK => 3, UNDER_STEADY => 4, BAR_BLINK => 5, BAR_STEADY => 6,
};

my %COLORS;
BEGIN {
    %COLORS = (
        BLACK => 0, RED => 1, GREEN => 2, YELLOW => 3, BLUE => 4, MAGENTA => 5, CYAN => 6, WHITE => 7,
        GRAY => 8, LIGHT_RED => 9, LIGHT_GREEN => 10, LIGHT_YELLOW => 11, LIGHT_BLUE => 12, LIGHT_MAGENTA => 13, LIGHT_CYAN => 14, LIGHT_WHITE => 15
    );
}

STDOUT->autoflush(1);

# ------------------------------------------------------------------------------
#  HELPER FUNCTION
# ------------------------------------------------------------------------------

sub _get_color_val {
    my ($val) = @_;

    return $val if $val =~ /^\d+$/;
    return $COLORS{uc($val)} if defined $val;
    return undef;
}

# ------------------------------------------------------------------------------
#  CORE FUNCTION
# ------------------------------------------------------------------------------

# Clears the screen completely and resets the cursor
sub clear {
    print "\e[2J\e[H";
}

# Set the background color (0-15)
sub backcolor {
    my ($color) = @_;
    my $c = _get_color_val($color);

    return unless defined $c;

    printf("\e[%dm", ($c < 8 ? 40 + $c : 100 + ($c - 8)));
}

# Set the text color (0-15)
sub forecolor {
    my ($color) = @_;
    my $c = _get_color_val($color);

    return unless defined $c;

    printf("\e[%dm", ($c < 8 ? 30 + $c : 90 + ($c - 8)));
}

# Manages the visibility of the cursor
sub cursor {
    my ($state) = @_;
    my $s = uc($state // '');

    if ($s eq '1' || $s eq 'ON' || $s eq 'TRUE') {
        print "\e[?25h";
    }
    else {
        print "\e[?25l";
    }
}

# Change the shape of the cursor (Caret)
sub caret {
    my ($shape) = @_;
    my %shapes = (BLOCK_BLINK => 1, BLOCK_STEADY => 2, UNDER_BLINK => 3, UNDER_STEADY => 4, BAR_BLINK => 5, BAR_STEADY => 6);
    my $s = $shape =~ /^\d+$/ ? $shape : $shapes{uc($shape)};

    print "\e[$s q" if $s && $s >= 1 && $s <= 6;
}

# Move the cursor to a specific position
sub position {
    my ($x, $y) = @_;

    printf("\e[%d;%dH", $y, $x);
}

# Writes text with attributes and positioning
sub write {
    my ($text, $fore, $back, $x, $y) = @_;
    my $out = "";

    $out .= sprintf("\e[%d;%dH", $y, $x) if defined $x && defined $y;

    if (defined $back) {
        my $c = _get_color_val($back);

        $out .= sprintf("\e[%dm", ($c < 8 ? 40 + $c : 100 + ($c - 8))) if defined $c;
    }

    if (defined $fore) {
        my $c = _get_color_val($fore);

        $out .= sprintf("\e[%dm", ($c < 8 ? 30 + $c : 90 + ($c - 8))) if defined $c;
    }

    print $out . $text . "\e[0m";
}

# Reads a single character
sub getkey {
    my $char;

    if ($^O eq 'MSWin32') {
        $char = `powershell -Command "[console]::ReadKey(\$true).KeyChar"`;
        $char =~ s/[\r\n]+$//;
    }
    else {
        system("stty -icanon -echo");
        sysread(STDIN, $char, 1);
        system("stty icanon echo");
    }

    return $char;
}

# Reads a single character and prints it to the screen
sub putkey {
    my $char;

    if ($^O eq 'MSWin32') {
        $char = `powershell -Command "[console]::ReadKey(\$true).KeyChar"`;
        $char =~ s/[\r\n]+$//;
    }
    else {
        system("stty -icanon -echo");
        sysread(STDIN, $char, 1);
        system("stty icanon");
    }

    if (defined $char && $char ne '') {
        local $| = 1;

        print $char;
    }

    return $char;
}

# Set the terminal window title
sub title {
    my ($title) = @_;

    print "\e]0;$title\a" if defined $title;
}

# Gets the current width of the console (columns)
sub width {
    my $w;

    if ($^O eq 'MSWin32') {
        $w = `powershell -command "\$host.ui.rawui.WindowSize.Width"` || 80;
    }
    else {
        $w = `stty size 2>/dev/null` =~ /\d+\s+(\d+)/ ? $1 : 80;
    }

    return int($w);
}

# Gets the current height of the console (rows)
sub height {
    my $h;

    if ($^O eq 'MSWin32') {
        $h = `powershell -command "\$host.ui.rawui.WindowSize.Height"` || 24;
    }
    else {
        $h = `stty size 2>/dev/null` =~ /(\d+)/ ? $1 : 24;
    }

    return int($h);
}

# Reset all styles to default values
sub reset {
    print "\e[0m\e[?25h\e[0 q";
}

1;

__END__