Number::RGB - Manipulate RGB Tuples

Number-RGB documentation Contained in the Number-RGB distribution.

Index

Code Index:

NAME

Top

Number::RGB - Manipulate RGB Tuples

SYNOPSIS

Top

  use Number::RGB;
  my $white :RGB(255);
  my $black :RGB(0);

  my $gray = $black + (($white - $black) / 2);

  my @rgb = @{ $white->rgb };
  my $hex = $black->hex;

  my $blue   = Number::RGB->new(rgb => [0,0,255]);
  my $green  = Number::RGB->new(hex => '#00FF00');

  my $red :RGB(255,0,0);

  my $purple = $blue + $green;
  my $yellow = $red  + $green;

DESCRIPTION

Top

This module creates RGB tuple objects and overloads their operators to make RGB math easier. An attribute is also exported to the caller to make construction shorter.

Methods

new()
  my $red   = Number::RGB->new(rgb => [255,0,0])
  my $blue  = Number::RGB->new(hex => '#0000FF');
  my $black = Number::RGB->new(rgb_number => 0);

This constructor accepts named parameters. One of three parameters are required.

rgb is a list reference containing three intergers within the range of 0..255. In order, each interger represents red, green, and blue.

hex is a hexidecimal representation of an RGB tuple commonly used in Cascading Style Sheets. The format begins with an optional hash (#) and follows with three groups of hexidecimal numbers represending red, green, and blue in that order.

rgb_number is a single integer which represents all primary colors. This is shorthand to create white, black, and all shades of gray.

This method throws and exception on error, which should be caught with eval.

r()

Accessor and mutator for the red value.

g()

Accessor and mutator for the green value.

b()

Accessor and mutator for the blue value.

rgb()

Returns a list reference containing three elements. In order they represent red, green, and blue.

hex()

Returns a hexidecimal represention of the tuple conforming to the format used in Cascading Style Sheets.

hex_uc()

Returns the same thing as hex(), but any hexidecimal numbers that include 'A'..'F' will be uppercased.

as_string()

Returns a string representation of the tuple. For example, white would be the string 255,255,255.

new_from_guess()
  my $color = Number::RGB->new_from_guess(input());

This constructor tries to guess the format being used and returns a tuple object. If it can't guess, an exception will be thrown.

Attributes

:RGB()
  my $red   :RGB(255,0,0);
  my $blue  :RGB(#0000FF);
  my $white :RGB(0);

This attribute is exported to the caller and provides a shorthand wrapper around new_from_guess().

AUTHOR

Top

Casey West, <casey@geeknest.com>.

COPYRIGHT

Top

  Copyright (c) 2004 Casey West.  All rights reserved.
  This module is free software; you can redistribute it and/or modify it
  under the same terms as Perl itself.
Number-RGB documentation Contained in the Number-RGB distribution. 
package Number::RGB;
# $Id: RGB.pm,v 1.2 2004/03/06 16:17:02 cwest Exp $
use strict;

use vars qw[$VERSION $CONSTRUCTOR_SPEC];
$VERSION = (qw$Revision: 1.2 $)[1];


use Carp;
use Params::Validate qw[:all];
use base qw[Class::Accessor::Fast];
use Attribute::Handlers;

sub import {
	my $class  = shift;
	my $caller = (caller)[0];
	eval qq[
				package $caller;
				use Attribute::Handlers;
				sub RGB :ATTR(SCALAR) { goto &$class\::RGB }
				package $class;
		];
}

use overload fallback => 1,
	'""'  => \&as_string,
	'+'   => sub { shift->_op_math('+',  @_) },
	'-'   => sub { shift->_op_math('-',  @_) },
	'*'   => sub { shift->_op_math('*',  @_) },
	'/'   => sub { shift->_op_math('/',  @_) },
	'%'   => sub { shift->_op_math('%',  @_) },
	'**'  => sub { shift->_op_math('**', @_) },
	'<<'  => sub { shift->_op_math('<<', @_) },
	'>>'  => sub { shift->_op_math('>>', @_) },
	'&'   => sub { shift->_op_math('&',  @_) },
	'^'   => sub { shift->_op_math('^',  @_) },
	'|'   => sub { shift->_op_math('|',  @_) };


sub new {
	my $class = shift;
	my %params = validate( @_,  $CONSTRUCTOR_SPEC );
	croak "$class->new() requires parameters" unless keys %params;

	my %rgb;
	if ( defined $params{rgb} ) {
		@rgb{qw[r g b]} = @{$params{rgb}};
	} elsif ( defined $params{rgb_number} ) {
		return $class->new(rgb => [($params{rgb_number})x3]);
	} elsif ( defined $params{hex} ) {
		my $hex = $params{hex};
		$hex =~ s/^#//;
		$hex =~ s/(.)/$1$1/g if length($hex) == 3;
		@rgb{qw[r g b]} = map hex, $hex =~ /(.{2})/g;
	}

	$class->SUPER::new(\%rgb);
}


__PACKAGE__->mk_accessors( qw[r g b] );


sub rgb       { [ map $_[0]->$_, qw[r g b] ] }
sub hex       { '#' . join '', map { substr sprintf('0%x',$_[0]->$_), -2 } qw[r g b] }
sub hex_uc    { uc shift->hex }
sub as_string {
	join ',', map $_[0]->$_, qw[r g b]
}

sub _op_math {
	my ($self,$op, $other, $reversed) = @_;
	ref($self)->new(rgb => [
		map {
			my $x = $self->$_;
			my $y = ref($other) && overload::Overloaded($other) ? $other->$_ : $other;
			int eval ($reversed ? "$y $op $x" : "$x $op $y");
		} qw[r g b]
	] );
}


sub new_from_guess {
	my ($class, $value) = @_;
	foreach my $param ( keys %{$CONSTRUCTOR_SPEC} ) {
		my $self = eval { $class->new($param => $value) };
		return $self if defined $self;
	}
	croak "$class->new_from_guess() couldn't guess type for ($value)";
}


sub RGB :ATTR(SCALAR) {
	my ($var, $data) = @_[2,4];
	$$var = __PACKAGE__->new_from_guess($data);
}

$CONSTRUCTOR_SPEC = {
    rgb => {
        type      => ARRAYREF,
        optional  => 1,
        callbacks => {
        	'three elements'    => sub { 3 == @{$_[0]} },
        	'only digits'       => sub { 0 == grep /\D/, @{$_[0]} },
        	'between 0 and 255' => sub { 3 == grep { $_ >= 0 && $_ <= 255 } @{$_[0]} },
        },
    },
    rgb_number => {
    	type      => SCALAR,
    	optional  => 1,
    	callbacks => {
    		'only digits'       => sub { $_[0] !~ /\D/ },
    		'between 0 and 255' => sub { $_[0] >= 0 && $_[0] <= 255 },
    	},
    },
    hex => {
    	type      => SCALAR,
    	optional  => 1,
    	callbacks => {
    		'hex format' => sub { $_[0] =~ /^#?(?:[\da-f]{3}|[\da-f]{6})$/i },
    	},
    }
};

1;

__END__