package ActiveState::Color; use strict; use base 'Exporter'; our @EXPORT_OK = qw(rgb_from_name name_from_rgb hex_from_rgb hsv_from_rgb rgb_from_hsv); use Carp; my %hex_from_name = ( black => '#000000', blue => '#0000ff', cyan => '#00ffff', green => '#00ff00', magenta => '#ff00ff', red => '#ff0000', yellow => '#ffff00', white => '#ffffff', ); my %name_from_hex = reverse %hex_from_name; sub rgb_from_name { my $c = lc(shift); $c = $hex_from_name{$c} if exists $hex_from_name{$c}; croak("Bad rgb value $c") unless $c =~ /^\#?([0-9a-f]+)/ && (length($1) % 3) == 0; croak("Need to be called in array context") unless wantarray; my $len = length($1) / 3; my @t = map hex(substr($1, $_*$len, $len)) / ((1 << 4*$len) - 1), 0 .. 2; return @t; } sub hex_from_rgb { die unless @_ == 3; my @rgb = @_; for (@rgb) { $_ *= 256; $_ = 0 if $_ < 0; $_ = 255 if $_ > 255; } return sprintf "#%02x%02x%02x", @rgb; } sub name_from_rgb { my $hex = hex_from_rgb(@_); return $name_from_hex{$hex} || $hex; } sub hsv_from_rgb { croak("Must be called with 3 argument and in array context") unless @_ == 3 && wantarray; my ($r, $g, $b)= @_; my $min = _min($r, $g, $b); my $max = _max($r, $g, $b); my $v = $max; my $delta = $max - $min; my $s; if ($delta) { $s = $delta / $max; } else { return 0, 0, $v; } my $h; if ($r == $max) { $h = ($g - $b) / $delta; } elsif ($g == $max) { $h = 2 + ($b - $r) / $delta; } else { # $b == $max $h = 4 + ($r - $g) / $delta; } $h *= 60; $h += 360 if $h < 0; return $h, $s, $v; } sub rgb_from_hsv { croak("Must be called with 3 argument and in array context") unless @_ == 3 && wantarray; my($h, $s, $v)= @_; return $v, $v, $v if $s == 0; $h /= 60; my $i = int($h); my $f = $h - $i; my $p = $v * ( 1 - $s ); my $q = $v * ( 1 - $s * $f ); my $t = $v * ( 1 - $s * ( 1 - $f ) ); if ($i == 0) { return $v, $t, $p; } elsif ($i == 1) { return $q, $v, $p; } elsif ($i == 2) { return $p, $v, $t; } elsif ($i == 3) { return $p, $q, $v; } elsif ($i == 4) { return $t, $p, $v; } else { # $i == 5 return $v, $p, $q; } } sub _min { my $min = shift; while (@_) { my $n = shift; $min = $n if $n < $min; } return $min; } sub _max { my $max = shift; while (@_) { my $n = shift; $max = $n if $n > $max; } return $max; } 1; =head1 NAME ActiveState::Color - Collection of color conversion functions =head1 SYNOPSIS use ActiveState::Color qw(name_from_rgb rgb_from_name rgb_from_hsv hsv_from_rgb ); my($h, $s, $v) = hsv_from_rgb(rgb_from_name(shift)); # make the color fully saturated and a bit lighter $s = 1; $v *= 1.2; print name_from_rgb(rgb_from_hsv($h, $s, $v)), "\n"; =head1 DESCRIPTION The following functions are provided: =over 4 =item ($r, $g, $b) = rgb_from_name( $name ) This will convert a color name or a hex RGB-tripplet to a decimal RGB value with $r, $g, $b in the range 0.0 to 1.0. The hex tripplet can have any precision and can optionally be prefixed with "#". If the name is not recognized this function will croak. Examples of valid names are: #F0F #FF00FF #FFF000FFF ff00ff black BLACK yellow =item $hexname = hex_from_rgb( $r, $g, $b ) This converts a decimal RGB value with $r, $g, $b in the range 0.0 to 1.0 to an 8-bit hex RGB-tripplet. The output will be on the form: #ff00ff =item $name = name_from_rgb( $r, $g, $b ) This will convert a decimal RGB value to a color name. If the color is one of the 8 primary RGB colors then the name will be returned, otherwise a hex RGB-tripplet is returned. The 8 primary color names are: black blue cyan green magenta red yellow white =item ($r, $g, $b) = rgb_from_hsv( $h, $s, $v ) =item ($h, $s, $v) = rgb_from_hsv( $r, $g, $b ) These functions convert between the RGB and HSV color space. The range of $s, $v, $r, $g, and $b is 0.0 to 1.0. The range of $h is 0.0 to 360.0. =back =head1 BUGS none. =cut