Term::ScreenColor - Term::Screen based screen positioning and coloring module
Index
Code Index:
NAME
Term::ScreenColor - Term::Screen based screen positioning and coloring module
SYNOPSIS
A Term::Screen based screen positioning module with ANSI
color support.
use Term::ScreenColor;
$scr = new Term::ScreenColor;
$scr->colorizable(1);
$scr->at(2,0)->red()->on_yellow()->puts("Hello, Tau Ceti!");
$scr->putcolored('cyan bold on blue', 'Betelgeuse');
$scr->putcolored('36;1;44', 'Altair');
DESCRIPTION
Term::ScreenColor adds ANSI coloring support, along with a few other useful
methods, to those provided in Term::Screen.
PUBLIC INTERFACE
Most methods return the Term::ScreenColor object so you can string things
together, e.g.
$scr->at(2,3)->cyan()->on_white()->puts("hello");
In addition to the methods described in Term::Screen(3pm),
Term::ScreenColor offers the following methods:
- new()
-
Creates a new Term::ScreenColor object. Note that the constructor
of the inherited class Term::Screen homes the cursor and switches
the terminal to raw input mode.
- colorizable()
- colorizable($boolean)
-
Returns (if called with no arguments) or sets (if called with one
boolean argument) whether the terminal is believed to support ANSI
color codes. If this is set to false, no ANSI codes will be printed
or generated. This provides an easy way for turning color on/off.
Note that the constructor above takes an initial guess at whether
the terminal supports color (based on the value of the TERM
environment variable).
- black()
- red()
- on_white()
- on_cyan()
- inverse()
-
etc.
Prints an ANSI escape sequence for a specific color.
The color names understood are:
ANSI color names:
-----------------------------------
0 clear
0 reset
1 ansibold 22 noansibold
3 italic 23 noitalic
4 underscore 24 nounderscore
5 blink 25 noblink
7 inverse 27 noinverse
8 concealed 28 noconcealed
-----------------------------------
30 black 40 on_black
31 red 41 on_red
32 green 42 on_green
33 yellow 43 on_yellow
34 blue 44 on_blue
35 magenta 45 on_magenta
36 cyan 46 on_cyan
37 white 47 on_white
------------------------------------
Additionally, the following names are understood
(inherited from Term::Screen):
termcap names:
---------------
normal
bold
underline
reverse
---------------
These termcap names send termcap-based escapes, which are not
considered 'colors' and can therefore not be turned off by
colorizable().
As of version 1.12, underline() is termcap-based instead of
ANSI-based.
- color2esc($colorstring)
-
Creates a string containing the escape codes corresponding to the
color names or numbers given.
If the terminal is considered to be colorizable, This method will
translate any termcap-names to their ANSI equivalents. This algorithm was
chosen to improve performance.
Examples:
$scr->colorizable(1);
$scr->color2esc('bold yellow'); # returns "\e[1;33m"
$scr->color2esc('blue reverse'); # returns "\e[34;7m"
$scr->color2esc('yellow on red'); # returns "\e[33;41m"
$scr->color2esc('37;42'); # returns "\e[37;42m"
If the terminal is not colorizable, the ANSI names are discarded
and only the termcap-names are respected. They will send the escape
sequences as defined in the termcap database.
Examples:
$scr->colorizable(0);
$scr->color2esc('bold yellow');
# returns 'md' from termcap, probably "\e[1m"
$scr->color2esc('blue reverse');
# returns 'mr' from termcap, probably "\e[7m"
$scr->color2esc('yellow on red');
# returns ""
- color($colorstring)
-
(Deprecated). Identical to putcolor($colorstring).
- putcolor($colorstring)
-
Prints the escape sequence corresponding to this color string,
in other words: the escape sequence that color2esc() generates.
- colored($colorstring, @strings)
-
Returns a string containing a concatenation of the string parts,
wrapped in ANSI color sequences, using the first argument as
color specification.
Example:
# the next two lines return "\e[36;1;44mSirius\e[0m"
$scr->colored('cyan bold on blue', 'Sirius');
$scr->colored('36;1;44', 'Sirius');
- putcolored($colorstring, @strings)
-
Identical to puts(), but wraps its arguments in ANSI color
sequences first, using the first argument as color specification.
Example:
# the next two lines print "\e[32;40mSirius\e[0m"
$scr->colored('green on black', 'Sirius');
$scr->colored('32;40', 'Sirius');
FIXES TO Term::Screen
As of version 1.11, Term::ScreenColor is bundled with some bugfixes,
enhancements and convenience functions that should have gone in
Term::Screen. They are therefore contained in a separate package
Term::Screen::Fixes.
PUBLIC INTERFACE
Term::Screen::Fixes offers the following methods:
- new()
-
Creates a new object. Initializes a timeout property, used for keys
that generate escape sequences.
- timeout()
- timeout($float)
-
Returns (if called with no arguments) or sets (if called with one float
argument) the function key timeout.
- getch()
-
This duplicates the functionality of Term::Screen::getch(), but makes
the following improvements:
- getc() was replaced by sysread(). Since getc() does internal buffering,
it does not work well with select(). This led in certain cases to the
application not receiving input as soon as it was available.
- If the received character(s) started off as a possible function
key escape sequence, but turn out not to be one after all, then the
keys are put back in the input buffer in the correct order.
(Term::Screen::getch() put them back at the wrong end of the buffer).
- If the first received character(s) are part of a possible function
key escape sequence, it will wait the timeout number of seconds for
a next character. This eliminates the need to press escape twice.
- normal()
-
Sends the escape sequence to turn off any highlightling (bold, reverse).
- bold()
-
Sends the md value from termcap, which usually turns on bold.
- reverse()
-
Sends the mr value from termcap, which often turns on reverse text.
- underline()
-
Turns on underline using the us value from termcap.
- flash()
-
Sends the visual bell escape sequence to the terminal.
- normal2esc()
- bold2esc()
- reverse2esc()
- underline2esc()
- flash2esc()
-
Return the termcap definitions for normal, bold, reverse, underline and
visual bell.
It was attested that on OpenSolaris 11, Term::Cap cannot provide
the properties normal, bold, and reverse because there is
no termcap and infocmp -C does not provide these properties
(even though infocmp does). In that case, fall back on terminfo.
- raw()
-
Sets raw input mode using stty(1).
- cooked()
-
Sets cooked input mode using stty(1).
- flush_input()
-
Duplicates the functionality of Term::Screen::flush_input(), but
replaces getc() with sysread().
- get_more_fn_keys()
-
Adds more function key escape sequences.
AUTHOR
Rene Uittenbogaard (ruittenb@users.sourceforge.net)
Term::ScreenColor was based on:
- Term::Screen
-
Originally by Mark Kaehny (kaehny@execpc.com),
now maintained by Jonathan Stowe (jns@gellyfish.co.uk).
- Term::ANSIColor
-
By Russ Allbery (rra@cs.stanford.edu) and Zenin (zenin@best.com).
SEE ALSO
Term::Screen(3pm), Term::Cap(3pm), termcap(5), stty(1)
#!/usr/bin/env perl
#
##########################################################################
#
# Name: Term::ScreenColor
# Version: 1.20
# Author: Rene Uittenbogaard
# Date: 2010-10-04
# Usage: require Term::ScreenColor;
# Requires: Term::Screen
# Description: Screen positioning and output coloring module
#
# Copyright: (c) 1999-2010 Rene Uittenbogaard. All Rights Reserved.
# This module is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
##########################################################################
# Term::ScreenColor
package Term::ScreenColor;
use strict;
our @ISA = qw(Term::Screen::Fixes);
our $VERSION = '1.20';
our $AUTOLOAD;
our %ANSI_ATTRIBUTES = (
'clear' => 0,
'reset' => 0,
'ansibold' => 1, 'noansibold' => 22, # 1=on, 22=off
'italic' => 3, 'noitalic' => 23, # not widely supported
'underscore' => 4, 'nounderscore' => 24,
'blink' => 5, 'noblink' => 25,
'inverse' => 7, 'noinverse' => 27,
'concealed' => 8, 'noconcealed' => 28,
'black' => 30, 'on_black' => 40, # also 'on black' etc.
'red' => 31, 'on_red' => 41,
'green' => 32, 'on_green' => 42,
'yellow' => 33, 'on_yellow' => 43,
'blue' => 34, 'on_blue' => 44,
'magenta' => 35, 'on_magenta' => 45,
'cyan' => 36, 'on_cyan' => 46,
'white' => 37, 'on_white' => 47,
);
##########################################################################
# start of manpage
sub new {
my ($this) = @_;
my $classname = ref($this) || $this;
my $ob = Term::ScreenColor->SUPER::new();
# Set colorizability based on terminal names which
# we guess support color (ugly solution, fix this)
$ob->{_is_colorizable} = $ENV{'TERM'} =~ /(^linux$|color|ansi)/i;
bless $ob, $classname;
# Find all attributes: termcap
my %TERMCAP_ATTRIBUTES = (
normal => $ob->normal2esc(),
bold => $ob->bold2esc(),
underline => $ob->underline2esc(),
'reverse' => $ob->reverse2esc(),
);
$ob->{_TERMCAP_ATTRIBUTES} = { %TERMCAP_ATTRIBUTES };
# Find all attributes: ANSI by name and number
$ob->{_ANSI_ATTRIBUTES} = { %ANSI_ATTRIBUTES };
@{
$ob->{_ANSI_ATTRIBUTES}
}{
values %ANSI_ATTRIBUTES
} = (
values %ANSI_ATTRIBUTES
);
# replace termcap colors by ANSI equivalents
# this is WAY faster than using termcap values when colorizable is on.
@{
$ob->{_ANSI_ATTRIBUTES}
}{
qw(normal bold underline reverse)
} = @ANSI_ATTRIBUTES{qw(reset ansibold underscore inverse)};
# Return the new object
return $ob;
}
sub colorizable {
my ($this, $request) = (@_);
if (defined($request)) {
$this->{_is_colorizable} = $request;
return $this;
} else {
return $this->{_is_colorizable};
}
}
sub AUTOLOAD {
my ($this) = @_;
my $color = $AUTOLOAD;
$color =~ s/.*:://;
return if $color eq 'DESTROY';
return $this->putcolor($color);
}
sub color2esc {
# return color sequence
my ($this, $color) = @_;
return '' if $color eq '';
if ($this->{_is_colorizable}) {
return $this->_ansi2esc($color);
} else {
return $this->_termcap2esc($color);
}
}
sub _ansi2esc {
my ($this, $color) = @_;
$color =~ s/on\s+/on_/go;
# translation has been done in the constructor
return "\e[" . join(
';',
map { $this->{_ANSI_ATTRIBUTES}{$_} }
split(/(?:\s+|;)/o, $color)
) . 'm';
}
sub _termcap2esc {
# return color sequence
my ($this, $color) = @_;
my @elements =
grep { defined }
map { $this->{_TERMCAP_ATTRIBUTES}{$_} }
split(/(?:\s+|;)/o, $color);
return '' unless @elements;
return join '', @elements;
}
sub color {
# for backward compatibility
goto &putcolor;
}
sub putcolor {
# print color sequence
my ($this, $color) = @_;
print $this->color2esc($color);
return $this;
}
sub colored {
# return string wrapped in color sequence
my ($this, $color, @args) = @_;
return join('', @args) if $color eq '';
my $initstring = $this->color2esc($color);
return join('', @args) unless $initstring;
return join('', $initstring, @args, "\e[0m");
}
sub putcolored {
# print string wrapped in color sequence
my ($this, $color, @args) = @_;
print $this->colored($color, @args);
return $this;
}
##########################################################################
# return true
1;
##########################################################################
# manpage transition
##########################################################################
# Term::Screen::Fixes
package Term::Screen::Fixes;
require Term::Screen;
use strict;
our @ISA = qw(Term::Screen);
sub new
{
my ( $prototype, @args ) = @_;
my $classname = ref($prototype) || $prototype;
my $this = Term::Screen::Fixes->SUPER::new();
bless $this, $prototype;
$this->{FN_TIMEOUT} = 0.4; # timeout for FN keys, in seconds
$this->get_more_fn_keys(); # define function key table from defaults
return $this;
}
sub timeout
{
my ( $self, $timeout ) = @_;
if ( defined $timeout )
{
$self->{FN_TIMEOUT} = $timeout;
}
return $self->{FN_TIMEOUT};
}
# Unfortunately, for our fixes and extensions, we need to
# duplicate the entire subroutine here.
sub getch
{
my $this = shift;
my ( $c, $nc, $fn_flag) = ('', '', 0);
my $partial_fn_str = '';
if ( $this->{IN} ) { $c = chop( $this->{IN} ); }
else { sysread( STDIN, $c, 1 ); }
$partial_fn_str = $c;
while ( exists( $this->{KEYS}{$partial_fn_str} ) )
{ # in a possible function key sequence
$fn_flag = 1;
if ( $this->{KEYS}{$partial_fn_str} ) # key found
{
$c = $this->{KEYS}{$partial_fn_str};
$partial_fn_str = '';
last;
}
else # wait for another key to see if were in FN yet
{
if ( $this->{IN} ) { $partial_fn_str .= chop( $this->{IN} ); }
elsif ( !$this->key_pressed(0) && !$this->key_pressed( $this->{FN_TIMEOUT} ) )
{
last;
}
else
{
sysread(STDIN, $nc, 1);
$partial_fn_str .= $nc;
}
}
}
if ($fn_flag) # seemed like a fn key
{
if ($partial_fn_str) # oops not a fn key
{
# buffer up the received chars
$this->{IN} = $this->{IN} . CORE::reverse($partial_fn_str);
$c = chop( $this->{IN} );
$this->puts($c) if ( $this->{ECHO} && ( $c ne "\e" ) );
}
# if fn_key then never echo so do nothing here
}
elsif ( $this->{ECHO} && ( $c ne "\e" ) ) { $this->puts($c); } # regular key
return $c;
}
sub normal
{
my $this = shift;
print $this->normal2esc();
return $this;
}
sub bold
{
my $this = shift;
print $this->bold2esc();
return $this;
}
sub reverse
{
my $this = shift;
print $this->reverse2esc();
return $this;
}
sub underline
{
my $this = shift;
print $this->underline2esc();
return $this;
}
sub flash {
my $this = shift;
print $this->flash2esc();
return $this;
}
sub normal2esc
{
my $this = shift;
my $prop = $this->{'_me'};
if (!defined $prop) {
$prop = $this->term()->{'_me'};
if (!defined $prop) {
# fallback on terminfo
eval { $prop = `tput sgr0` };
}
}
# cache it
$this->{'_me'} = $prop;
return $prop;
}
sub bold2esc
{
my $this = shift;
my $prop = $this->{'_md'};
if (!defined $prop) {
$prop = $this->term()->{'_md'};
if (!defined $prop) {
# fallback on terminfo
eval { $prop = `tput bold` };
}
}
# cache it
$this->{'_md'} = $prop;
return $prop;
}
sub reverse2esc
{
my $this = shift;
my $prop = $this->{'_mr'};
if (!defined $prop) {
$prop = $this->term()->{'_mr'};
if (!defined $prop) {
# fallback on terminfo
eval { $prop = `tput rev` };
}
}
# cache it
$this->{'_mr'} = $prop;
return $prop;
}
sub underline2esc
{
my $this = shift;
my $prop = $this->{'_us'};
if (!defined $prop) {
$prop = $this->term()->{'_us'};
if (!defined $prop) {
# fallback on terminfo
eval { $prop = `tput smul` };
}
}
# cache it
$this->{'_us'} = $prop;
return $prop;
}
sub flash2esc
{
my $this = shift;
my $prop = $this->{'_vb'};
if (!defined $prop) {
$prop = $this->term()->{'_vb'};
if (!defined $prop) {
# fallback on terminfo
eval { $prop = `tput flash` };
}
}
# cache it
$this->{'_vb'} = $prop;
return $prop;
}
sub raw
{
my $this = shift;
eval { system qw(stty raw -echo) };
return $this;
}
sub cooked
{
my $this = shift;
eval { system qw(stty -raw echo) };
return $this;
}
sub flush_input
{
my $this = shift;
my $discard;
$this->{IN} = '';
while ( $this->key_pressed() ) { sysread(STDIN, $discard, 1); }
return $this;
}
sub get_more_fn_keys
{
my $this = shift;
my $term = $this->term();
my ($fn, $count, %keys);
# $this->def_key( "ku", "\e[A" ); # vt100
# $this->def_key( "kd", "\e[B" ); # vt100
# $this->def_key( "kr", "\e[C" ); # vt100
# $this->def_key( "kl", "\e[D" ); # vt100
$this->def_key( "ku", "\eOA" ); # xterm
$this->def_key( "kd", "\eOB" ); # xterm
$this->def_key( "kr", "\eOC" ); # xterm
$this->def_key( "kl", "\eOD" ); # xterm
# $this->def_key( "k1", "\e[11~" ); # vt100
# $this->def_key( "k2", "\e[12~" ); # vt100
# $this->def_key( "k3", "\e[13~" ); # vt100
# $this->def_key( "k4", "\e[14~" ); # vt100
# $this->def_key( "k5", "\e[15~" ); # vt100
# $this->def_key( "k6", "\e[17~" ); # vt100
# $this->def_key( "k7", "\e[18~" ); # vt100
# $this->def_key( "k8", "\e[19~" ); # vt100
# $this->def_key( "k9", "\e[20~" ); # vt100
# $this->def_key( "k10", "\e[21~" ); # vt100
# $this->def_key( "k11", "\e[23~" ); # vt100
# $this->def_key( "k12", "\e[24~" ); # vt100
$this->def_key( "k1", "\eOP" ); # xterm
$this->def_key( "k2", "\eOQ" ); # xterm
$this->def_key( "k3", "\eOR" ); # xterm
$this->def_key( "k4", "\eOS" ); # xterm
$this->def_key( "k1", "\e[[A" ); # Linux console
$this->def_key( "k2", "\e[[B" ); # Linux console
$this->def_key( "k3", "\e[[C" ); # Linux console
$this->def_key( "k4", "\e[[D" ); # Linux console
$this->def_key( "k5", "\e[[E" ); # Linux console
# $this->def_key( "ins", "\e[2~" ); # vt100
# $this->def_key( "del", "\e[3~" ); # vt100
# $this->def_key( "pgup", "\e[5~" ); # vt100
# $this->def_key( "pgdn", "\e[6~" ); # vt100
$this->def_key( "home", "\e[H" ); # vt100
$this->def_key( "end", "\e[F" ); # vt100
$this->def_key( "home", "\eOH" ); # xterm
$this->def_key( "end", "\eOF" ); # xterm
$this->def_key( "home", "\e[1~" ); # Linux console
$this->def_key( "end", "\e[4~" ); # Linux console
$this->def_key( "home", "\eO" );
$this->def_key( "end", "\eOw" );
$this->def_key( "end", "\eOe" );
# try to get more useful things out of termcap
%keys = (
kI => "ins",
kD => "del",
kh => "home",
'@7' => "end",
kP => "pgup",
kN => "pgdn",
'k;' => "k10",
F1 => "k11",
F2 => "k12",
);
$count = "0 but true";
foreach $fn (keys %keys) {
if (exists $term->{"_$fn"}) {
# print "Defining $keys{$fn} as $term->{\"_$fn\"}\n";
$this->def_key($keys{$fn}, $term->{"_$fn"});
$count++;
}
}
return $count;
}
##########################################################################
# return true
1;
##########################################################################
# end of manpage
# vim: set tabstop=4 shiftwidth=4 expandtab: