Badger::Rainbow - colour functionality

Badger documentation Contained in the Badger distribution.

Index

Code Index:

NAME

Top

Badger::Rainbow - colour functionality

SYNOPSIS

Top

    use Badger::Rainbow ANSI => 'red green blue';

    print red("This is red");
    print green("This is green");
    print blue("This is blue");

DESCRIPTION

Top

This module implements colour-related functionality. It is currently only used for debugging purposes but may be extended in the future.

EXPORTABLE ITEMS

Top

ANSI_escape($code, $line1, $line2, ...)

This function applies an ANSI escape code to each line of text, with the effect of colourising output on compatible terminals.

    use Badger::Rainbow 'ANSI_escape';
    print ANSI_escape(31, 'Hello World');     # 31 is red

ANSI

This is an export hook which allows you to import subroutines which apply the correct ANSI escape codes to render text in colour on compatible terminals.

    use Badger::Rainbox ANSI => 'red green blue';

    print red("This is red");
    print green("This is green");
    print blue("This is blue");

Available colours are: black, red, green, yellow, blue, magenta, cyan and white. The bold and dark styles can also be specified.

    use Badger::Rainbox ANSI => 'dark bold red green blue';

    print bold red "Hello World\n";
    print dark blue "Hello Badger\n";

Colours and styles can be specified as a single whitespace-delimited string or as a reference to a list of individual items.

    use Badger::Rainbox ANSI => 'red green blue';
    use Badger::Rainbox ANSI => ['red', 'green', 'blue'];

AUTHOR

Top

Andy Wardley http://wardley.org/

COPYRIGHT

Top

Copyright (C) 1996-2009 Andy Wardley. All Rights Reserved.

This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Badger documentation Contained in the Badger distribution. 
#========================================================================
#
# Badger::Rainbow
#
# DESCRIPTION
#   Colour-related functionality, used primarily for debugging.
#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
#========================================================================

package Badger::Rainbow;

use Carp;
#use Badger::Debug ':debug';
use Badger::Class
    version   => 0.01,
    base      => 'Badger::Exporter',
    constants => 'DELIMITER ARRAY REFS PKG',
    exports   => {
        any   => 'ANSI_escape ANSI_colours',
        hooks => {
            ANSI => \&_export_ANSI_colours,
        },
    },
    constant => {
        ANSI_colours => {
            bold    =>  1,
            dark    =>  2,
            black   => 30,
            red     => 31,
            green   => 32,
            yellow  => 33,
            blue    => 34,
            magenta => 35,
            cyan    => 36, 
            white   => 37,
        },
    };

# can't import this via Badger::Debug as it depends on Badger::Rainbow
our $DEBUG = 0 unless defined $DEBUG;

sub _export_ANSI_colours {
    my ($class, $target, $symbol, $more_symbols) = @_;
    my $ansi = ANSI_colours;
    my $cols = shift(@$more_symbols)
        || croak "You didn't specify any ANSI colours to import";

    no strict REFS;
        
    $cols = [ split(DELIMITER, $cols) ]
        unless ref $cols eq ARRAY;

    foreach my $col (@$cols) {
#        $class->debug("Exporting ANSI clolour $col to $target\n") if $DEBUG;
        my $val = $ansi->{ $col }
            || croak "Invalid ANSI colour specified to import: $col";
        *{ $target.PKG.$col } = sub(@) {
            ANSI_escape($val, @_) 
        };
    }
}


#-----------------------------------------------------------------------
# ANSI_escape($attr, $text)
#
# Adds ANSI escape codes to each line of text to colour output.
#-----------------------------------------------------------------------

sub ANSI_escape {
    my $attr = shift;
    my $text = join('', grep { defined $_ } @_);
    return join("\n", 
        map {
            # look for an existing escape start sequence and add new 
            # attribute to it, otherwise add escape start/end sequences
            s/ \e \[ ([1-9][\d;]*) m/\e[$1;${attr}m/gx 
                ? $_
                : "\e[${attr}m" . $_ . "\e[0m";
        }
        split(/\n/, $text, -1)   # -1 prevents it from ignoring trailing fields
    );
}




1;

__END__


# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: