6 our $VERSION = "1.013";
8 # It's just a front end to the XS creation functions.
10 # used in converting hsv to rgb
13 'vkm', 'nvm', 'mvk', 'mnv', 'kmv', 'vmn'
17 my ($hue, $sat, $val) = @_;
19 # HSV conversions from pages 401-403 "Procedural Elements for Computer
20 # Graphics", 1985, ISBN 0-07-053534-5.
24 return ( 255 * $val, 255 * $val, 255 * $val );
27 $val >= 0 or $val = 0;
28 $val <= 1 or $val = 1;
29 $sat <= 1 or $sat = 1;
30 $hue >= 360 and $hue %= 360;
31 $hue < 0 and $hue += 360;
36 my $m = $val * (1.0 - $sat);
37 my $n = $val * (1.0 - $sat * $f);
38 my $k = $val * (1.0 - $sat * (1 - $f));
40 my %fields = ( 'm'=>$m, 'n'=>$n, 'v'=>$v, 'k'=>$k, );
41 return @fields{split //, $hsv_map[$i]};
45 # cache of loaded gimp files
46 # each key is a filename, under each key is a hashref with the following
48 # mod_time => last mod_time of file
49 # colors => hashref name to arrayref of colors
52 # palette search locations
54 # $HOME is replaced at runtime
57 '$HOME/.gimp-1.2/palettes/Named_Colors',
58 '$HOME/.gimp-1.1/palettes/Named_Colors',
59 '$HOME/.gimp/palettes/Named_Colors',
60 '/usr/share/gimp/1.2/palettes/Named_Colors',
61 '/usr/share/gimp/1.1/palettes/Named_Colors',
62 '/usr/share/gimp/palettes/Named_Colors',
65 my $default_gimp_palette;
67 sub _load_gimp_palette {
70 if (open PAL, "< $filename") {
73 unless ($hdr =~ /GIMP Palette/) {
75 $Imager::ERRSTR = "$filename is not a GIMP palette file";
80 my $mod_time = (stat PAL)[9];
81 while (defined($line = <PAL>)) {
82 next if $line =~ /^#/ || $line =~ /^\s*$/;
84 my ($r,$g, $b, $name) = split ' ', $line, 4;
86 $name =~ s/\s*\([\d\s]+\)\s*$//;
87 $pal{lc $name} = [ $r, $g, $b ];
92 $gimp_cache{$filename} = { mod_time=>$mod_time, colors=>\%pal };
97 $Imager::ERRSTR = "Cannot open palette file $filename: $!";
102 sub _get_gimp_color {
106 if ($args{palette}) {
107 $filename = $args{palette};
109 elsif (defined $default_gimp_palette) {
110 # don't search again and again and again ...
111 if (!length $default_gimp_palette
112 || !-f $default_gimp_palette) {
113 $Imager::ERRSTR = "No GIMP palette found";
114 $default_gimp_palette = "";
118 $filename = $default_gimp_palette;
121 # try to make one up - this is intended to die if tainting is
122 # enabled and $ENV{HOME} is tainted. To avoid that untaint $ENV{HOME}
123 # or set the palette parameter
124 for my $attempt (@gimp_search) {
125 my $work = $attempt; # don't modify the source array
126 $work =~ /\$HOME/ && !defined $ENV{HOME}
128 $work =~ s/\$HOME/$ENV{HOME}/;
135 $Imager::ERRSTR = "No GIMP palette found";
136 $default_gimp_palette = "";
140 $default_gimp_palette = $filename;
143 if ((!$gimp_cache{$filename}
144 || (stat $filename)[9] != $gimp_cache{$filename})
145 && !_load_gimp_palette($filename)) {
149 if (!$gimp_cache{$filename}{colors}{lc $args{name}}) {
150 $Imager::ERRSTR = "Color '$args{name}' isn't in $filename";
154 return @{$gimp_cache{$filename}{colors}{lc $args{name}}};
159 '/usr/share/X11/rgb.txt', # newer Xorg X11 dists use this
160 '/usr/lib/X11/rgb.txt', # seems fairly standard
161 '/usr/local/lib/X11/rgb.txt', # seems possible
162 '/usr/X11R6/lib/X11/rgb.txt', # probably the same as the first
163 '/usr/openwin/lib/rgb.txt',
164 '/usr/openwin/lib/X11/rgb.txt',
169 # called by the test code to check if we can test this stuff
170 sub _test_x_palettes {
175 # same structure as %gimp_cache
182 if (open RGB, "< $filename") {
185 my $mod_time = (stat RGB)[9];
186 while (defined($line = <RGB>)) {
187 # the version of rgb.txt supplied with GNU Emacs uses # for comments
188 next if $line =~ /^[!#]/ || $line =~ /^\s*$/;
190 my ($r,$g, $b, $name) = split ' ', $line, 4;
192 $pal{lc $name} = [ $r, $g, $b ];
197 $x_cache{$filename} = { mod_time=>$mod_time, colors=>\%pal };
202 $Imager::ERRSTR = "Cannot open palette file $filename: $!";
211 if ($args{palette}) {
212 $filename = $args{palette};
214 elsif (defined $default_x_rgb) {
215 unless (length $default_x_rgb) {
216 $Imager::ERRSTR = "No X rgb.txt palette found";
219 $filename = $default_x_rgb;
222 for my $attempt (@x_search) {
224 $filename = $attempt;
229 $Imager::ERRSTR = "No X rgb.txt palette found";
235 if ((!$x_cache{$filename}
236 || (stat $filename)[9] != $x_cache{$filename}{mod_time})
237 && !_load_x_rgb($filename)) {
241 $default_x_rgb = $filename;
243 if (!$x_cache{$filename}{colors}{lc $args{name}}) {
244 $Imager::ERRSTR = "Color '$args{name}' isn't in $filename";
248 return @{$x_cache{$filename}{colors}{lc $args{name}}};
251 # Parse color spec into an a set of 4 colors
254 return (@_,255) if @_ == 3 && !grep /[^\d.+eE-]/, @_;
255 return (@_ ) if @_ == 4 && !grep /[^\d.+eE-]/, @_;
257 /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
258 return (hex($1),hex($2),hex($3),hex($4));
260 if ($_[0] =~ /^\#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])/i) {
261 return (hex($1),hex($2),hex($3),255);
263 if ($_[0] =~ /^\#([\da-f])([\da-f])([\da-f])$/i) {
264 return (hex($1) * 17, hex($2) * 17, hex($3) * 17, 255);
269 %args = ( name => @_ );
275 if (exists $args{gray}) {
276 @result = $args{gray};
278 elsif (exists $args{grey}) {
279 @result = $args{grey};
281 elsif ((exists $args{red} || exists $args{r})
282 && (exists $args{green} || exists $args{g})
283 && (exists $args{blue} || exists $args{b})) {
284 @result = ( exists $args{red} ? $args{red} : $args{r},
285 exists $args{green} ? $args{green} : $args{g},
286 exists $args{blue} ? $args{blue} : $args{b} );
288 elsif ((exists $args{hue} || exists $args{h})
289 && (exists $args{saturation} || exists $args{'s'})
290 && (exists $args{value} || exists $args{v})) {
291 my $hue = exists $args{hue} ? $args{hue} : $args{h};
292 my $sat = exists $args{saturation} ? $args{saturation} : $args{'s'};
293 my $val = exists $args{value} ? $args{value} : $args{v};
295 @result = _hsv_to_rgb($hue, $sat, $val);
297 elsif (exists $args{web}) {
298 if ($args{web} =~ /^#?([\da-f][\da-f])([\da-f][\da-f])([\da-f][\da-f])$/i) {
299 @result = (hex($1),hex($2),hex($3));
301 elsif ($args{web} =~ /^#?([\da-f])([\da-f])([\da-f])$/i) {
302 @result = (hex($1) * 17, hex($2) * 17, hex($3) * 17);
305 elsif ($args{name}) {
306 unless (@result = _get_gimp_color(%args)) {
307 unless (@result = _get_x_color(%args)) {
308 require Imager::Color::Table;
309 unless (@result = Imager::Color::Table->get($args{name})) {
310 $Imager::ERRSTR = "No color named $args{name} found";
316 elsif ($args{gimp}) {
317 @result = _get_gimp_color(name=>$args{gimp}, %args);
319 elsif ($args{xname}) {
320 @result = _get_x_color(name=>$args{xname}, %args);
322 elsif ($args{builtin}) {
323 require Imager::Color::Table;
324 @result = Imager::Color::Table->get($args{builtin});
327 @result = @{$args{rgb}};
329 elsif ($args{rgba}) {
330 @result = @{$args{rgba}};
331 return @result if @result == 4;
334 @result = _hsv_to_rgb(@{$args{hsv}});
336 elsif ($args{channels}) {
337 my @ch = @{$args{channels}};
338 return ( @ch, (0) x (4 - @ch) );
340 elsif (exists $args{channel0} || $args{c0}) {
342 while (exists $args{"channel$i"} || exists $args{"c$i"}) {
344 exists $args{"channel$i"} ? $args{"channel$i"} : $args{"c$i"});
349 $Imager::ERRSTR = "No color specification found";
353 if (exists $args{alpha} || exists $args{a}) {
354 push(@result, exists $args{alpha} ? $args{alpha} : $args{a});
356 while (@result < 4) {
365 shift; # get rid of class name.
366 my @arg = _pspec(@_);
367 return @arg ? new_internal($arg[0],$arg[1],$arg[2],$arg[3]) : ();
372 my @arg = _pspec(@_);
373 return @arg ? set_internal($self, $arg[0],$arg[1],$arg[2],$arg[3]) : ();
377 my ($self, %opts) = @_;
379 my $other = $opts{other}
380 or return Imager->_set_error("'other' parameter required");
381 my $ignore_alpha = $opts{ignore_alpha} || 0;
383 my @left = $self->rgba;
384 my @right = $other->rgba;
385 my $last_chan = $ignore_alpha ? 2 : 3;
386 for my $ch (0 .. $last_chan) {
387 $left[$ch] == $right[$ch]
396 # Lifted from Graphics::Color::RGB
397 # Thank you very much
401 my( $red, $green, $blue, $alpha ) = $self->rgba;
427 elsif($maxc eq 'r') {
428 $h = 60 * (($green - $blue) / ($max - $min)) % 360;
430 elsif($maxc eq 'g') {
431 $h = (60 * (($blue - $red) / ($max - $min)) + 120);
433 elsif($maxc eq 'b') {
434 $h = (60 * (($red - $green) / ($max - $min)) + 240);
442 $s = 1 - ($min / $max);
445 return int($h), $s, $v, $alpha;
455 Imager::Color - Color handling for Imager.
461 $color = Imager::Color->new($red, $green, $blue);
462 $color = Imager::Color->new($red, $green, $blue, $alpha);
463 $color = Imager::Color->new("#C0C0FF"); # html color specification
465 $color->set($red, $green, $blue);
466 $color->set($red, $green, $blue, $alpha);
467 $color->set("#C0C0FF"); # html color specification
469 ($red, $green, $blue, $alpha) = $color->rgba();
470 @hsv = $color->hsv();
474 if ($color->equals(other=>$other_color)) {
481 This module handles creating color objects used by Imager. The idea
482 is that in the future this module will be able to handle color space
483 calculations as well.
485 An Imager color consists of up to four components, each in the range 0
486 to 255. Unfortunately the meaning of the components can change
487 depending on the type of image you're dealing with:
493 for 3 or 4 channel images the color components are red, green, blue,
498 for 1 or 2 channel images the color components are gray, alpha, with
499 the other two components ignored.
503 An alpha value of zero is fully transparent, an alpha value of 255 is
512 This creates a color object to pass to functions that need a color argument.
516 This changes an already defined color. Note that this does not affect any places
517 where the color has been used previously.
521 This returns the red, green, blue and alpha channels of the color the
526 Calling info merely dumps the relevant color to the log.
528 =item equals(other=>$other_color)
530 =item equals(other=>$other_color, ignore_alpha=>1)
532 Compares $self and color $other_color returning true if the color
533 components are the same.
535 Compares all four channels unless C<ignore_alpha> is set. If
536 C<ignore_alpha> is set only the first three channels are compared.
540 You can specify colors in several different ways, you can just supply
547 simple numeric parameters - if you supply 3 or 4 numeric arguments, you get a color made up of those RGB (and possibly A) components.
551 a six hex digit web color, either C<RRGGBB> or C<#RRGGBB>
555 an eight hex digit web color, either C<RRGGBBAA> or C<#RRGGBBAA>.
559 a 3 hex digit web color, C<#RGB> - a value of F becomes 255.
563 a color name, from whichever of the gimp C<Named_Colors> file or X
564 C<rgb.txt> is found first. The same as using the C<name> keyword.
568 You can supply named parameters:
574 'red', 'green' and 'blue', optionally shortened to 'r', 'g' and 'b'.
575 The color components in the range 0 to 255.
577 # all of the following are equivalent
578 my $c1 = Imager::Color->new(red=>100, blue=>255, green=>0);
579 my $c2 = Imager::Color->new(r=>100, b=>255, g=>0);
580 my $c3 = Imager::Color->new(r=>100, blue=>255, g=>0);
584 C<hue>, C<saturation> and C<value>, optionally shortened to C<h>, C<s> and
585 C<v>, to specify a HSV color. 0 <= hue < 360, 0 <= s <= 1 and 0 <= v
588 # the same as RGB(127,255,127)
589 my $c1 = Imager::Color->new(hue=>120, v=>1, s=>0.5);
590 my $c1 = Imager::Color->new(hue=>120, value=>1, saturation=>0.5);
594 C<web>, which can specify a 6 or 3 hex digit web color, in any of the
595 forms C<#RRGGBB>, C<#RGB>, C<RRGGBB> or C<RGB>.
597 my $c1 = Imager::Color->new(web=>'#FFC0C0'); # pale red
601 C<gray> or C<grey> which specifies a single channel, from 0 to 255.
604 my $c1 = Imager::Color->new(gray=>128);
605 my $c1 = Imager::Color->new(grey=>128);
609 C<rgb> which takes a 3 member arrayref, containing each of the red,
610 green and blue values.
613 my $c1 = Imager::Color->new(rgb=>[255, 100, 0]);
614 my $c1 = Imager::Color->new(r=>255, g=>100, b=>0);
618 C<hsv> which takes a 3 member arrayref, containing each of hue,
619 saturation and value.
622 my $c1 = Imager::Color->new(hsv=>[120, 0.5, 1]);
623 my $c1 = Imager::Color->new(hue=>120, v=>1, s=>0.5);
627 C<gimp> which specifies a color from a GIMP palette file. You can
628 specify the file name of the palette file with the 'palette'
629 parameter, or let Imager::Color look in various places, typically
630 C<$HOME/gimp-1.x/palettes/Named_Colors> with and without the version
631 number, and in C</usr/share/gimp/palettes/>. The palette file must
634 my $c1 = Imager::Color->new(gimp=>'snow');
635 my $c1 = Imager::Color->new(gimp=>'snow', palette=>'testimg/test_gimp_pal);
639 C<xname> which specifies a color from an X11 C<rgb.txt> file. You can
640 specify the file name of the C<rgb.txt> file with the C<palette>
641 parameter, or let Imager::Color look in various places, typically
642 C</usr/lib/X11/rgb.txt>.
644 my $c1 = Imager::Color->new(xname=>'blue') # usually RGB(0, 0, 255)
648 C<builtin> which specifies a color from the built-in color table in
649 Imager::Color::Table. The colors in this module are the same as the
650 default X11 C<rgb.txt> file.
652 my $c1 = Imager::Color->new(builtin=>'black') # always RGB(0, 0, 0)
656 C<name> which specifies a name from either a GIMP palette, an X
657 C<rgb.txt> file or the built-in color table, whichever is found first.
661 'channel0', 'channel1', etc, each of which specifies a single channel. These can be abbreviated to 'c0', 'c1' etc.
665 'channels' which takes an arrayref of the channel values.
669 Optionally you can add an alpha channel to a color with the 'alpha' or
672 These color specifications can be used for both constructing new
673 colors with the new() method and modifying existing colors with the
682 my($h, $s, $v, $alpha) = $color->hsv();
684 Returns the color as a Hue/Saturation/Value/Alpha tuple.
694 Returns the respective component as an integer from 0 to 255.
700 Arnar M. Hrafnkelsson, addi@umich.edu
701 And a great deal of help from others - see the C<README> for a complete
706 Imager(3), Imager::Color
707 http://imager.perl.org/