Skip Menu |
 

This queue is for tickets about the Imager CPAN distribution.

Report information
The Basics
Id: 65385
Status: resolved
Priority: 0/
Queue: Imager

People
Owner: Nobody in particular
Requestors: perl [...] pied.nu
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 0.80
Fixed in: (no value)

Attachments


Subject: Patch for Imager::Color->hsv
Greatings, Here is a patch that add Imager::Color->hsv(). It includes tests.
Subject: Philip_Gwyn.Imager.to_hsv.01.patch
--- Imager-0.80/lib/Imager/Color.pm 2011-01-14 20:11:52.000000000 -0500 +++ Imager-0.80-PG/lib/Imager/Color.pm 2011-02-02 19:36:06.963179231 -0500 @@ -393,6 +393,59 @@ 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__ @@ -414,7 +467,7 @@ $color->set("#C0C0FF"); # html color specification ($red, $green, $blue, $alpha) = $color->rgba(); - @hsv = $color->hsv(); # not implemented but proposed + @hsv = $color->hsv(); $color->info(); @@ -620,6 +673,14 @@ colors with the new() method and modifying existing colors with the set() method. +=head1 METHODS + +=head2 hsv + + my($h, $s, $v, $alpha) = $colour->hsv(); + +Returns the colour as a Hue/Saturation/Value/Alpha tuple. + =head1 AUTHOR Arnar M. Hrafnkelsson, addi@umich.edu --- Imager-0.80/t/t15color.t 2011-01-14 21:18:44.000000000 -0500 +++ Imager-0.80-PG/t/t15color.t 2011-02-02 19:36:05.013195171 -0500 @@ -7,7 +7,7 @@ # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) -use Test::More tests => 55; +use Test::More tests => 70; use Imager; use Imager::Test qw(is_fcolor4); @@ -156,6 +156,39 @@ ok(!$c->set("-unknown-"), "set to unknown"); } +{ + # test ->hsv + my $c = Imager::Color->new(255, 0, 0); + my($h,$s,$v) = $c->hsv; + is($h,0,'red hue'); + is($s,1,'red saturation'); + is($v,1,'red value'); + + $c = Imager::Color->new(0, 255, 0); + ($h,$s,$v) = $c->hsv; + is($h,120,'green hue'); + is($s,1,'green saturation'); + is($v,1,'green value'); + + $c = Imager::Color->new(0, 0, 255); + ($h,$s,$v) = $c->hsv; + is($h,240,'blue hue'); + is($s,1,'blue saturation'); + is($v,1,'blue value'); + + $c = Imager::Color->new(255, 255, 255); + ($h,$s,$v) = $c->hsv; + is($h,0,'white hue'); + is($s,0,'white saturation'); + is($v,1,'white value'); + + $c = Imager::Color->new(0, 0, 0); + ($h,$s,$v) = $c->hsv; + is($h,0,'black hue'); + is($s,0,'black saturation'); + is($v,0,'black value'); +} + sub test_col { my ($c, $r, $g, $b, $a) = @_; unless ($c) {
Download (untitled) / with headers
text/plain 174b
On Wed Feb 02 19:41:27 2011, GWYN wrote: Show quoted text
> Greatings, > > Here is a patch that add Imager::Color->hsv(). > It includes tests.
Thanks, included in 0.81, just released. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.