File Coverage

blib/lib/Color/Library/Color.pm

Criterion	Covered	Total	%
statement	31	60	51.6
branch	2	22	9.0
condition	0	6	0.0
subroutine	8	12	66.6
pod	6	6	100.0
total	47	106	44.3

package Color::Library::Color;

use strict;
use warnings;

use base qw/Class::Accessor::Fast/;

__PACKAGE__->mk_accessors(qw/_id _name _title _dictionary /);
__PACKAGE__->mk_accessors(qw/_rgb _html _value _hex/);

use overload
    '""' => \&html,
    fallback => 1,
;

sub rgb;
sub rgb2hex;
sub rgb2value;
sub value2rgb($);
sub parse_rgb_color;
sub integer2rgb($);

=head1 NAME

Color::Library::Color - Color entry for a Color::Library color dictionary

=head1 METHODS

=over 4

=item $id = $color->id

Returns the id of the color

A color id is in the format of , e.g.

    svg:aliceblue
    x11:bisque2
    nbs-iscc-f:chromeyellow.66
    vaccc:darkspringyellow

=item $name = $color->name

Returns the name of the color, e.g.

    aliceblue
    bisque2
    chromeyellow
    darkspringyellow

=item $title = $color->title

Returns the title of the color, e.g.

    aliceblue
    bisque2
    chrome yellow
    Dark Spring-Yellow

=item $dictionary = $color->dictionary

Returns the Color::Library::Dictionary object that the color belongs to

=item $hex = $color->hex

Returns the hex value of the color, e.g.

    ff08ff
    eed5b7
    eaa221
    669900

Note that $hex does NOT include the leading #, for that use $color->html, $color->css, or $color->svg

=item $html = $color->html

=item $css = $color->css

=item $svg = $color->svg

Returns the hex value of the color with a leading #, suitable for use in HTML, CSS, or SVG documents, e.g.

    #ff08ff
    #eed5b7
    #eaa221
    #669900

=cut

=item $value = $color->value

Returns the numeric value of the color, e.g.

    15792383
    15652279
    15376929
    6723840

=cut

for my $method (qw/id name title dictionary html value hex/) {
    no strict 'refs';
    my $accessor = "_$method";
    *$method = sub { return $_[0]->$accessor };
}
*css = \&html;
*svg = \&html;

=item ($r, $g, $b) = $color->rgb

Returns r, g, and b values of the color as a 3 element list (list context), e.g.

    (240, 248, 255)

=item $rgb = $color->rgb

Returns r, g, and b values of the color in a 3 element array (scalar context), e.g.

    [ 240, 248, 255 ]

=cut

sub rgb {
    return wantarray ? @{ $_[0]->_rgb } : [ @{ $_[0]->_rgb } ]
}

=item $color = Color::Library::Color->new( id => $id, name => $name, title => $title, value => $value )

=item $color = Color::Library::Color->new( { id => $id, name => $name, title => $title, value => $value } )

=item $color = Color::Library::Color->new( [[ $id, $name, $title, $rgb, $hex, $value ]] )

Returns a new Color::Library::Color object representing the specified color

You probably don't want/need to call this yourself

=cut

# FUTURE Note that $value may be a numeric value, a hex value, or a 3 element r-g-b array

sub new {
    my $self = bless {}, shift;
    if (ref $_[0] eq "ARRAY") {
        my ($id, $name, $title, $rgb, $hex, $value) = @{ shift() };
        $self->_id($id);
        $self->_name($name);
        $self->_title($title);
        $self->_rgb($rgb);
        $self->_hex($hex);
        $self->_html("#" . $hex);
        $self->_value($value);
        $self->_dictionary(shift);
    }
    else {
        local %_ = ref $_[0] eq "HASH" ? %{ $_[0] } : @_;
        $self->_id($_{id});
        $self->_name($_{name});
        $self->_title($_{title});
        $self->_dictionary($_{dictionary});

        my ($r, $g, $b) = parse_rgb_color(ref $_{value} eq "ARRAY" ? @{ $_{value} } : $_{value});

        my $rgb = $self->_rgb([ $r, $g, $b ]);
        my $hex = $self->_hex(rgb2hex $rgb);
        $self->_html("#" . $hex);
        $self->_value(rgb2value $rgb);
    }
    return $self;
}

=back

=head2 FUNCTIONS

=over 4

=item $hex = Color::Library::Color::rgb2hex( $rgb )

=item $hex = Color::Library::Color::rgb2hex( $r, $g, $b )

Converts an rgb value to its hex representation

=cut

sub rgb2hex {
    return ref $_[0] eq "ARRAY" ?
        sprintf("%02lx%02lx%02lx", $_[0][0], $_[0][1], $_[0][2]) :
        sprintf("%02lx%02lx%02lx", $_[0], $_[1], $_[2]);
}

=item $value = Color::Library::Color::rgb2value( $rgb )

=item $value = Color::Library::Color::rgb2value( $r, $g, $b )

Converts an rgb value to its numeric representation

=cut

sub rgb2value {
    my ($r, $g, $b) = ref $_[0] eq "ARRAY" ? @{ $_[0] } : @_;
    return $b + ($g << 8) + ($r << 16);
}

=item $rgb = Color::Library::Color::value2rgb( $value )

=item ($r, $g, $b) = Color::Library::Color::value2rgb( $value )

Converts a numeric color value to its rgb representation

=cut

sub value2rgb($) {
    my $value = shift;
    my ($r, $g, $b);
    $b = ($value & 0x0000ff);

    $g = ($value & 0x00ff00) >> 8;
    $r = ($value & 0xff0000) >> 16;
    return wantarray ? ($r, $g, $b) : [ $r, $g, $b ];
}

=item ($r, $g, $b) = Color::Library::Color::parse_rgb_color( $hex )

=item ($r, $g, $b) = Color::Library::Color::parse_rgb_color( $value )

Makes a best effort to convert a hex or numeric color value to its rgb representation

=cut

# Partly taken from Imager/Color.pm
sub parse_rgb_color {
    return (@_) if @_ == 3 && ! grep /[^\d.+eE-]/, @_;
    if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])$/i) {
        return (hex($1), hex($2), hex($3));
    }
    if ($_[0] =~ /^\#?([\da-f])([\da-f])([\da-f])$/i) {
        return (hex($1) * 17, hex($2) * 17, hex($3) * 17);
    }
    return value2rgb $_[0] if 1 == @_ && $_[0] =~ m/^\d+$/;
}

1;

__END__