use Imager;
use strict;
-use vars qw();
+use vars qw($VERSION);
+
+$VERSION = "1.011";
# It's just a front end to the XS creation functions.
# used in converting hsv to rgb
-my @hsv_map =
+my @hsv_map =
(
'vkm', 'nvm', 'mvk', 'mnv', 'kmv', 'vmn'
);
sub _hsv_to_rgb {
my ($hue, $sat, $val) = @_;
- # HSV conversions from pages 401-403 "Procedural Elements for Computer
+ # HSV conversions from pages 401-403 "Procedural Elements for Computer
# Graphics", 1985, ISBN 0-07-053534-5.
my @result;
'/usr/share/gimp/palettes/Named_Colors',
);
+my $default_gimp_palette;
+
sub _load_gimp_palette {
my ($filename) = @_;
if ($args{palette}) {
$filename = $args{palette};
}
+ elsif (defined $default_gimp_palette) {
+ # don't search again and again and again ...
+ if (!length $default_gimp_palette
+ || !-f $default_gimp_palette) {
+ $Imager::ERRSTR = "No GIMP palette found";
+ $default_gimp_palette = "";
+ return;
+ }
+
+ $filename = $default_gimp_palette;
+ }
else {
# try to make one up - this is intended to die if tainting is
# enabled and $ENV{HOME} is tainted. To avoid that untaint $ENV{HOME}
# or set the palette parameter
for my $attempt (@gimp_search) {
my $work = $attempt; # don't modify the source array
+ $work =~ /\$HOME/ && !defined $ENV{HOME}
+ and next;
$work =~ s/\$HOME/$ENV{HOME}/;
if (-e $work) {
$filename = $work;
}
if (!$filename) {
$Imager::ERRSTR = "No GIMP palette found";
+ $default_gimp_palette = "";
return ();
}
+
+ $default_gimp_palette = $filename;
}
- if ((!$gimp_cache{$filename}
+ if ((!$gimp_cache{$filename}
|| (stat $filename)[9] != $gimp_cache{$filename})
&& !_load_gimp_palette($filename)) {
return ();
return @{$gimp_cache{$filename}{colors}{lc $args{name}}};
}
-my @x_search =
+my @x_search =
(
+ '/usr/share/X11/rgb.txt', # newer Xorg X11 dists use this
'/usr/lib/X11/rgb.txt', # seems fairly standard
'/usr/local/lib/X11/rgb.txt', # seems possible
'/usr/X11R6/lib/X11/rgb.txt', # probably the same as the first
'/usr/openwin/lib/X11/rgb.txt',
);
+my $default_x_rgb;
+
+# called by the test code to check if we can test this stuff
+sub _test_x_palettes {
+ @x_search;
+}
+
# x rgb.txt cache
# same structure as %gimp_cache
my %x_cache;
if ($args{palette}) {
$filename = $args{palette};
}
+ elsif (defined $default_x_rgb) {
+ unless (length $default_x_rgb) {
+ $Imager::ERRSTR = "No X rgb.txt palette found";
+ return ();
+ }
+ $filename = $default_x_rgb;
+ }
else {
for my $attempt (@x_search) {
if (-e $attempt) {
}
if (!$filename) {
$Imager::ERRSTR = "No X rgb.txt palette found";
+ $default_x_rgb = "";
return ();
}
}
- if ((!$x_cache{$filename}
- || (stat $filename)[9] != $x_cache{$filename})
+ if ((!$x_cache{$filename}
+ || (stat $filename)[9] != $x_cache{$filename}{mod_time})
&& !_load_x_rgb($filename)) {
return ();
}
+ $default_x_rgb = $filename;
+
if (!$x_cache{$filename}{colors}{lc $args{name}}) {
$Imager::ERRSTR = "Color '$args{name}' isn't in $filename";
return ();
# Parse color spec into an a set of 4 colors
-sub pspec {
+sub _pspec {
return (@_,255) if @_ == 3 && !grep /[^\d.+eE-]/, @_;
return (@_ ) if @_ == 4 && !grep /[^\d.+eE-]/, @_;
- if ($_[0] =~
+ 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));
}
elsif (exists $args{grey}) {
@result = $args{grey};
}
- elsif ((exists $args{red} || exists $args{r})
+ elsif ((exists $args{red} || exists $args{r})
&& (exists $args{green} || exists $args{g})
&& (exists $args{blue} || exists $args{b})) {
@result = ( exists $args{red} ? $args{red} : $args{r},
exists $args{green} ? $args{green} : $args{g},
exists $args{blue} ? $args{blue} : $args{b} );
}
- elsif ((exists $args{hue} || exists $args{h})
+ elsif ((exists $args{hue} || exists $args{h})
&& (exists $args{saturation} || exists $args{'s'})
&& (exists $args{value} || exists $args{v})) {
my $hue = exists $args{hue} ? $args{hue} : $args{h};
elsif (exists $args{channel0} || $args{c0}) {
my $i = 0;
while (exists $args{"channel$i"} || exists $args{"c$i"}) {
- push(@result,
+ push(@result,
exists $args{"channel$i"} ? $args{"channel$i"} : $args{"c$i"});
++$i;
}
sub new {
shift; # get rid of class name.
- my @arg = pspec(@_);
+ my @arg = _pspec(@_);
return @arg ? new_internal($arg[0],$arg[1],$arg[2],$arg[3]) : ();
}
sub set {
my $self = shift;
- my @arg = pspec(@_);
+ my @arg = _pspec(@_);
return @arg ? set_internal($self, $arg[0],$arg[1],$arg[2],$arg[3]) : ();
}
+sub equals {
+ my ($self, %opts) = @_;
+
+ my $other = $opts{other}
+ or return Imager->_set_error("'other' parameter required");
+ my $ignore_alpha = $opts{ignore_alpha} || 0;
+
+ my @left = $self->rgba;
+ my @right = $other->rgba;
+ my $last_chan = $ignore_alpha ? 2 : 3;
+ for my $ch (0 .. $last_chan) {
+ $left[$ch] == $right[$ch]
+ or return;
+ }
+
+ return 1;
+}
+
+sub CLONE_SKIP { 1 }
+
+# Lifted from Graphics::Color::RGB
+# Thank you very much
+sub hsv {
+ my( $self ) = @_;
+
+ my( $red, $green, $blue, $alpha ) = $self->rgba;
+ my $max = $red;
+ my $maxc = 'r';
+ my $min = $red;
+
+ if($green > $max) {
+ $max = $green;
+ $maxc = 'g';
+ }
+ if($blue > $max) {
+ $max = $blue;
+ $maxc = 'b';
+ }
+
+ if($green < $min) {
+ $min = $green;
+ }
+ if($blue < $min) {
+ $min = $blue;
+ }
+
+ my ($h, $s, $v);
+
+ if($max == $min) {
+ $h = 0;
+ }
+ elsif($maxc eq 'r') {
+ $h = 60 * (($green - $blue) / ($max - $min)) % 360;
+ }
+ elsif($maxc eq 'g') {
+ $h = (60 * (($blue - $red) / ($max - $min)) + 120);
+ }
+ elsif($maxc eq 'b') {
+ $h = (60 * (($red - $green) / ($max - $min)) + 240);
+ }
+
+ $v = $max/255;
+ if($max == 0) {
+ $s = 0;
+ }
+ else {
+ $s = 1 - ($min / $max);
+ }
+
+ return int($h), $s, $v, $alpha;
+
+}
+
1;
__END__
=head1 SYNOPSIS
+ use Imager;
+
$color = Imager::Color->new($red, $green, $blue);
$color = Imager::Color->new($red, $green, $blue, $alpha);
$color = Imager::Color->new("#C0C0FF"); # html color specification
$color->set("#C0C0FF"); # html color specification
($red, $green, $blue, $alpha) = $color->rgba();
- @hsv = $color->hsv(); # not implemented but proposed
+ @hsv = $color->hsv();
$color->info();
+ if ($color->equals(other=>$other_color)) {
+ ...
+ }
+
=head1 DESCRIPTION
-This module handles creating color objects used by imager. The idea is
-that in the future this module will be able to handle colorspace calculations
-as well.
+This module handles creating color objects used by Imager. The idea
+is that in the future this module will be able to handle color space
+calculations as well.
+
+An Imager color consists of up to four components, each in the range 0
+to 255. Unfortunately the meaning of the components can change
+depending on the type of image you're dealing with:
+
+=over
+
+=item *
+
+for 3 or 4 channel images the color components are red, green, blue,
+alpha.
+
+=item *
+
+for 1 or 2 channel images the color components are gray, alpha, with
+the other two components ignored.
+
+=back
+
+An alpha value of zero is fully transparent, an alpha value of 255 is
+fully opaque.
+
+=head1 METHODS
=over 4
This changes an already defined color. Note that this does not affect any places
where the color has been used previously.
-=item rgba
+=item rgba()
-This returns the rgba code of the color the object contains.
+This returns the red, green, blue and alpha channels of the color the
+object contains.
=item info
-Calling info merely dumps the relevant colorcode to the log.
+Calling info merely dumps the relevant color to the log.
+
+=item equals(other=>$other_color)
+
+=item equals(other=>$other_color, ignore_alpha=>1)
+
+Compares $self and color $other_color returning true if the color
+components are the same.
+
+Compares all four channels unless C<ignore_alpha> is set. If
+C<ignore_alpha> is set only the first three channels are compared.
=back
=item *
-a six hex digit web color, either 'RRGGBB' or '#RRGGBB'
+a six hex digit web color, either C<RRGGBB> or C<#RRGGBB>
=item *
-an eight hex digit web color, either 'RRGGBBAA' or '#RRGGBBAA'.
+an eight hex digit web color, either C<RRGGBBAA> or C<#RRGGBBAA>.
=item *
-a 3 hex digit web color, '#RGB' - a value of F becomes 255.
+a 3 hex digit web color, C<#RGB> - a value of F becomes 255.
=item *
-a color name, from whichever of the gimp Named_Colors file or X
-rgb.txt is found first. The same as using the name keyword.
+a color name, from whichever of the gimp C<Named_Colors> file or X
+C<rgb.txt> is found first. The same as using the C<name> keyword.
=back
=item *
-'hue', 'saturation' and 'value', optionally shortened to 'h', 's' and
-'v', to specify a HSV color. 0 <= hue < 360, 0 <= s <= 1 and 0 <= v
+C<hue>, C<saturation> and C<value>, optionally shortened to C<h>, C<s> and
+C<v>, to specify a HSV color. 0 <= hue < 360, 0 <= s <= 1 and 0 <= v
<= 1.
# the same as RGB(127,255,127)
=item *
-'web', which can specify a 6 or 3 hex digit web color, in any of the
-forms '#RRGGBB', '#RGB', 'RRGGBB' or 'RGB'.
+C<web>, which can specify a 6 or 3 hex digit web color, in any of the
+forms C<#RRGGBB>, C<#RGB>, C<RRGGBB> or C<RGB>.
my $c1 = Imager::Color->new(web=>'#FFC0C0'); # pale red
=item *
-'gray' or 'grey' which specifies a single channel, from 0 to 255.
+C<gray> or C<grey> which specifies a single channel, from 0 to 255.
# exactly the same
my $c1 = Imager::Color->new(gray=>128);
=item *
-'rgb' which takes a 3 member arrayref, containing each of the red,
+C<rgb> which takes a 3 member arrayref, containing each of the red,
green and blue values.
# the same
=item *
-'hsv' which takes a 3 member arrayref, containting each of hue,
+C<hsv> which takes a 3 member arrayref, containing each of hue,
saturation and value.
# the same
=item *
-'gimp' which specifies a color from a GIMP palette file. You can
-specify the filename of the palette file with the 'palette' parameter,
-or let Imager::Color look in various places, typically
-"$HOME/gimp-1.x/palettes/Named_Colors" with and without the version
-number, and in /usr/share/gimp/palettes/. The palette file must have
-color names.
+C<gimp> which specifies a color from a GIMP palette file. You can
+specify the file name of the palette file with the 'palette'
+parameter, or let Imager::Color look in various places, typically
+C<$HOME/gimp-1.x/palettes/Named_Colors> with and without the version
+number, and in C</usr/share/gimp/palettes/>. The palette file must
+have color names.
my $c1 = Imager::Color->new(gimp=>'snow');
my $c1 = Imager::Color->new(gimp=>'snow', palette=>'testimg/test_gimp_pal);
=item *
-'xname' which specifies a color from an X11 rgb.txt file. You can
-specify the filename of the rgb.txt file with the 'palette' parameter,
-or let Imager::Color look in various places, typically
-'/usr/lib/X11/rgb.txt'.
+C<xname> which specifies a color from an X11 C<rgb.txt> file. You can
+specify the file name of the C<rgb.txt> file with the C<palette>
+parameter, or let Imager::Color look in various places, typically
+C</usr/lib/X11/rgb.txt>.
my $c1 = Imager::Color->new(xname=>'blue') # usually RGB(0, 0, 255)
=item *
-'builtin' which specifies a color from the built-in color table in
+C<builtin> which specifies a color from the built-in color table in
Imager::Color::Table. The colors in this module are the same as the
-default X11 rgb.txt file.
+default X11 C<rgb.txt> file.
my $c1 = Imager::Color->new(builtin=>'black') # always RGB(0, 0, 0)
=item *
-'name' which specifies a name from either a GIMP palette, an X rgb.txt
-file or the built-in color table, whichever is found first.
+C<name> which specifies a name from either a GIMP palette, an X
+C<rgb.txt> file or the built-in color table, whichever is found first.
=item *
'channel0', 'channel1', etc, each of which specifies a single channel. These can be abbreviated to 'c0', 'c1' etc.
-=item *
+=item *
'channels' which takes an arrayref of the channel values.
colors with the new() method and modifying existing colors with the
set() method.
+=head1 METHODS
+
+=over
+
+=item hsv()
+
+ my($h, $s, $v, $alpha) = $color->hsv();
+
+Returns the color as a Hue/Saturation/Value/Alpha tuple.
+
+=back
+
=head1 AUTHOR
Arnar M. Hrafnkelsson, addi@umich.edu
-And a great deal of help from others - see the README for a complete
+And a great deal of help from others - see the C<README> for a complete
list.
=head1 SEE ALSO
-Imager(3)
-http://www.eecs.umich.edu/~addi/perl/Imager/
+Imager(3), Imager::Color
+http://imager.perl.org/
=cut
projects / imager.git / blobdiff