bump Imager::Test version, which should have been done for 0.94_02

[imager.git] / lib / Imager / Color.pm

diff --git a/lib/Imager/Color.pm b/lib/Imager/Color.pm
index 0d2d19fafec0055b93e11471e040a64e23a2bc13..478f437ec46e2d8f8dab947df2ab72c58bf21eab 100644 (file)
--- a/lib/Imager/Color.pm
+++ b/lib/Imager/Color.pm
@@ -4,12 +4,12 @@ use Imager;
 use strict;
 use vars qw($VERSION);
 
 use strict;
 use vars qw($VERSION);
 

-$VERSION = "1.010";
+$VERSION = "1.011";

 
 # It's just a front end to the XS creation functions.
 
 # used in converting hsv to rgb
 
 # 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'
   );
   (
    'vkm', 'nvm', 'mvk', 'mnv', 'kmv', 'vmn'
   );


@@ -17,7 +17,7 @@ my @hsv_map =
 sub _hsv_to_rgb {
   my ($hue, $sat, $val) = @_;
 
 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;
   # Graphics", 1985, ISBN 0-07-053534-5.
 
   my @result;


@@ -63,6 +63,8 @@ my @gimp_search =
    '/usr/share/gimp/palettes/Named_Colors',
   );
 
    '/usr/share/gimp/palettes/Named_Colors',
   );
 

+my $default_gimp_palette;
+

 sub _load_gimp_palette {
   my ($filename) = @_;
 
 sub _load_gimp_palette {
   my ($filename) = @_;
 


@@ -105,6 +107,17 @@ sub _get_gimp_color {
   if ($args{palette}) {
     $filename = $args{palette};
   }
   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}
   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}


@@ -121,11 +134,14 @@ sub _get_gimp_color {
     }
     if (!$filename) {
       $Imager::ERRSTR = "No GIMP palette found";
     }
     if (!$filename) {
       $Imager::ERRSTR = "No GIMP palette found";

+      $default_gimp_palette = "";

       return ();
     }
       return ();
     }

+
+    $default_gimp_palette = $filename;

   }
 
   }
 

-  if ((!$gimp_cache{$filename} 
+  if ((!$gimp_cache{$filename}

       || (stat $filename)[9] != $gimp_cache{$filename})
      && !_load_gimp_palette($filename)) {
     return ();
       || (stat $filename)[9] != $gimp_cache{$filename})
      && !_load_gimp_palette($filename)) {
     return ();


@@ -139,7 +155,7 @@ sub _get_gimp_color {
   return @{$gimp_cache{$filename}{colors}{lc $args{name}}};
 }
 
   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/share/X11/rgb.txt', # newer Xorg X11 dists use this
    '/usr/lib/X11/rgb.txt', # seems fairly standard


@@ -149,6 +165,8 @@ my @x_search =
    '/usr/openwin/lib/X11/rgb.txt',
   );
 
    '/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;
 # called by the test code to check if we can test this stuff
 sub _test_x_palettes {
   @x_search;


@@ -194,6 +212,13 @@ sub _get_x_color {
   if ($args{palette}) {
     $filename = $args{palette};
   }
   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) {
   else {
     for my $attempt (@x_search) {
       if (-e $attempt) {


@@ -203,16 +228,19 @@ sub _get_x_color {
     }
     if (!$filename) {
       $Imager::ERRSTR = "No X rgb.txt palette found";
     }
     if (!$filename) {
       $Imager::ERRSTR = "No X rgb.txt palette found";

+      $default_x_rgb = "";

       return ();
     }
   }
 
       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 ();
   }
 
      && !_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 ();
   if (!$x_cache{$filename}{colors}{lc $args{name}}) {
     $Imager::ERRSTR = "Color '$args{name}' isn't in $filename";
     return ();


@@ -226,7 +254,7 @@ sub _get_x_color {
 sub _pspec {
   return (@_,255) if @_ == 3 && !grep /[^\d.+eE-]/, @_;
   return (@_    ) if @_ == 4 && !grep /[^\d.+eE-]/, @_;
 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));
   }
       /^\#?([\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));
   }


@@ -251,14 +279,14 @@ sub _pspec {
   elsif (exists $args{grey}) {
     @result = $args{grey};
   }
   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} );
   }
          && (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};
          && (exists $args{saturation} || exists $args{'s'})
          && (exists $args{value} || exists $args{v})) {
     my $hue = exists $args{hue}        ? $args{hue}        : $args{h};


@@ -312,7 +340,7 @@ sub _pspec {
   elsif (exists $args{channel0} || $args{c0}) {
     my $i = 0;
     while (exists $args{"channel$i"} || exists $args{"c$i"}) {
   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;
     }
            exists $args{"channel$i"} ? $args{"channel$i"} : $args{"c$i"});
       ++$i;
     }


@@ -359,10 +387,65 @@ sub equals {
     $left[$ch] == $right[$ch]
       or return;
   }
     $left[$ch] == $right[$ch]
       or return;
   }

-  
+

   return 1;
 }
 
   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__
 1;
 
 __END__


@@ -384,20 +467,20 @@ Imager::Color - Color handling for Imager.
   $color->set("#C0C0FF"); # html color specification
 
   ($red, $green, $blue, $alpha) = $color->rgba();
   $color->set("#C0C0FF"); # html color specification
 
   ($red, $green, $blue, $alpha) = $color->rgba();

-  @hsv = $color->hsv(); # not implemented but proposed
+  @hsv = $color->hsv();

 
   $color->info();
 
 
   $color->info();
 

-  if ($color->equals(other=>$other_color)) { 
+  if ($color->equals(other=>$other_color)) {

     ...
   }
 
 
 =head1 DESCRIPTION
 
     ...
   }
 
 
 =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
 
 An Imager color consists of up to four components, each in the range 0
 to 255. Unfortunately the meaning of the components can change


@@ -433,13 +516,14 @@ This creates a color object to pass to functions that need a color argument.
 This changes an already defined color.  Note that this does not affect any places
 where the color has been used previously.
 
 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
 
 
 =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)
 


@@ -464,20 +548,20 @@ simple numeric parameters - if you supply 3 or 4 numeric arguments, you get a co
 
 =item *
 
 
 =item *
 

-a six hex digit web color, either 'RRGGBB' or '#RRGGBB'
+a six hex digit web color, either C<RRGGBB> or C<#RRGGBB>

 
 =item *
 
 
 =item *
 

-an eight hex digit web color, either 'RRGGBBAA' or '#RRGGBBAA'.
+an eight hex digit web color, either C<RRGGBBAA> or C<#RRGGBBAA>.

 
 =item *
 
 
 =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 *
 
 
 =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
 
 
 =back
 


@@ -497,8 +581,8 @@ The color components in the range 0 to 255.
 
 =item *
 
 
 =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)
 <= 1.
 
   # the same as RGB(127,255,127)


@@ -507,14 +591,14 @@ The color components in the range 0 to 255.
 
 =item *
 
 
 =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 *
 
 
   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);
 
   # exactly the same
   my $c1 = Imager::Color->new(gray=>128);


@@ -522,7 +606,7 @@ forms '#RRGGBB', '#RGB', 'RRGGBB' or 'RGB'.
 
 =item *
 
 
 =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
 green and blue values.
 
   # the same


@@ -531,7 +615,7 @@ green and blue values.
 
 =item *
 
 
 =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
 saturation and value.
 
   # the same


@@ -540,43 +624,43 @@ saturation and value.
 
 =item *
 
 
 =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 *
 
 
   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 *
 
 
   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
 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 *
 
 
   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 *
 
 '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.
 
 
 'channels' which takes an arrayref of the channel values.
 


@@ -589,10 +673,22 @@ These color specifications can be used for both constructing new
 colors with the new() method and modifying existing colors with the
 set() method.
 
 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
 =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
 list.
 
 =head1 SEE ALSO