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__ sub parse_rgbs_color { return (@_) if @_ == 3 && ! grep /[^\d.+eE-]/, @_; if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) { return (hex($1), hex($2), hex($3), hex($4)); } if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) { return (hex($1), hex($2), hex($3), 255); } if ($_[0] =~ /^\#([\da-f])([\da-f])([\da-f])$/i) { return (hex($1) * 17, hex($2) * 17, hex($3) * 17, 255); } return value2rgb $_[0] if 1 == @_; }