#========================================================================
#
# 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 strip_ANSI_escapes',
        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
    );
}


sub strip_ANSI_escapes {
    my $text = join('', grep { defined $_ } @_);
    $text =~ s/ \e .*? m//gx;
    return $text;
}




1;

__END__

=head1 NAME

Badger::Rainbow - colour functionality

=head1 SYNOPSIS

    use Badger::Rainbow ANSI => 'red green blue';
    
    print red("This is red");
    print green("This is green");
    print blue("This is blue");

=head1 DESCRIPTION

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

=head1 EXPORTABLE ITEMS

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

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

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

=head2 strip_ANSI_escapes($text)

This function removes any ANSI escapes from the text passed as an argument.

=head2 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: C<black>, C<red>, C<green>, C<yellow>, C<blue>,
C<magenta>, C<cyan> and C<white>.  The C<bold> and C<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'];

=head1 AUTHOR

Andy Wardley L<http://wardley.org/>

=head1 COPYRIGHT

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.

=cut

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