File Coverage

blib/lib/Convert/Color/HSV.pm
Criterion Covered Total %
statement 55 60 91.6
branch 15 24 62.5
condition n/a
subroutine 14 14 100.0
pod 9 10 90.0
total 93 108 86.1


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2009-2022 -- leonerd@leonerd.org.uk
5              
6             package Convert::Color::HSV 0.14;
7              
8 13     13   206576 use v5.14;
  13         74  
9 13     13   68 use warnings;
  13         25  
  13         393  
10 13     13   74 use base qw( Convert::Color::HueChromaBased );
  13         24  
  13         2812  
11              
12             __PACKAGE__->register_color_space( 'hsv' );
13              
14 13     13   88 use Carp;
  13         27  
  13         9931  
15              
16             =head1 NAME
17              
18             C - a color value represented as hue/saturation/value
19              
20             =head1 SYNOPSIS
21              
22             Directly:
23              
24             use Convert::Color::HSV;
25              
26             my $red = Convert::Color::HSV->new( 0, 1, 1 );
27              
28             # Can also parse strings
29             my $pink = Convert::Color::HSV->new( '0,0.7,1' );
30              
31             Via L:
32              
33             use Convert::Color;
34              
35             my $cyan = Convert::Color->new( 'hsv:300,1,1' );
36              
37             =head1 DESCRIPTION
38              
39             Objects in this class represent a color in HSV space, as a set of three
40             floating-point values. Hue is stored as a value in degrees, in the range
41             0 to 360 (exclusive). Saturation and value are in the range 0 to 1.
42              
43             This color space may be considered as a cylinder, of height and radius 1. Hue
44             represents the position of the color as the angle around the axis, the
45             saturation the distance from the axis, and the value the height above the
46             base. In this shape, the entire base of the cylinder is pure black, the axis
47             through the centre represents the range of greys, and the circumference of the
48             top of the cylinder contains the pure-saturated color wheel, with a pure
49             white point at its centre.
50              
51             Because the entire bottom surface of this cylinder contains black, a
52             closely-related color space can be created by reshaping the cylinder into a
53             cone by contracting the base of the cylinder into a point. The radius from the
54             axis is called the chroma (though this is a different definition of "chroma"
55             than that used by CIE).
56              
57             =cut
58              
59             =head1 CONSTRUCTOR
60              
61             =cut
62              
63             =head2 new
64              
65             $color = Convert::Color::HSV->new( $hue, $saturation, $value )
66              
67             Returns a new object to represent the set of values given. The hue should be
68             in the range 0 to 360 (exclusive), and saturation and value should be between
69             0 and 1. Values outside of these ranges will be clamped.
70              
71             $color = Convert::Color::HSV->new( $string )
72              
73             Parses C<$string> for values, and construct a new object similar to the above
74             three-argument form. The string should be in the form
75              
76             hue,saturation,value
77              
78             containing the three floating-point values in decimal notation.
79              
80             =cut
81              
82             sub new
83             {
84 23     23 1 309 my $class = shift;
85              
86 23         38 my ( $h, $s, $v );
87              
88 23 100       72 if( @_ == 1 ) {
    50          
89 4         10 local $_ = $_[0];
90 4 50       28 if( m/^(\d+(?:\.\d+)?),(\d+(?:\.\d+)?),(\d+(?:\.\d+)?)$/ ) {
91 4         18 ( $h, $s, $v ) = ( $1, $2, $3 );
92             }
93             else {
94 0         0 croak "Unrecognised HSV string spec '$_'";
95             }
96             }
97             elsif( @_ == 3 ) {
98 19         68 ( $h, $s, $v ) = @_;
99             }
100             else {
101 0         0 croak "usage: Convert::Color::HSV->new( SPEC ) or ->new( H, S, V )";
102             }
103              
104             # Clamp
105 23         52 for ( $s, $v ) {
106 46 50       103 $_ = 0 if $_ < 0;
107 46 50       94 $_ = 1 if $_ > 1;
108             }
109              
110             # Fit to range [0,360)
111 23         50 $h += 360 while $h < 0;
112 23         53 $h -= 360 while $h >= 360;
113              
114 23         86 return bless [ $h, $s, $v ], $class;
115             }
116              
117             =head1 METHODS
118              
119             =cut
120              
121             =head2 hue
122              
123             $h = $color->hue
124              
125             =head2 saturation
126              
127             $s = $color->saturation
128              
129             =head2 value
130              
131             $v = $color->value
132              
133             Accessors for the three components of the color.
134              
135             =cut
136              
137             # Simple accessors
138 35     35 1 483 sub hue { shift->[0] }
139 42     42 1 144 sub saturation { shift->[1] }
140 66     66 1 184 sub value { shift->[2] }
141              
142             =head2 chroma
143              
144             $c = $color->chroma
145              
146             Returns the derived property of "chroma", which maps the color space onto a
147             cone instead of a cylinder. This more closely measures the intuitive concept
148             of how "colorful" the color is than the saturation value and is useful for
149             distance calculations.
150              
151             =cut
152              
153             sub chroma
154             {
155 30     30 1 42 my $self = shift;
156 30         67 return $self->saturation * $self->value;
157             }
158              
159             =head2 hsv
160              
161             ( $hue, $saturation, $value ) = $color->hsv
162              
163             Returns the individual hue, saturation and value components of the color
164             value.
165              
166             =cut
167              
168             sub hsv
169             {
170 9     9 1 16 my $self = shift;
171 9         40 return @$self;
172             }
173              
174             # Conversions
175             sub rgb
176             {
177 5     5 1 8 my $self = shift;
178              
179             # See also
180             # http://en.wikipedia.org/wiki/HSV_color_space
181              
182 5         9 my ( $h, $s, $v ) = $self->hsv;
183              
184 5         16 my $hi = int( $h / 60 );
185              
186 5         10 my $f = $h / 60 - $hi;
187              
188 5         9 my $p = $v * ( 1 - $s );
189 5         8 my $q = $v * ( 1 - $f * $s );
190 5         10 my $t = $v * ( 1 - ( 1 - $f ) * $s );
191              
192 5         8 my ( $r, $g, $b );
193              
194 5 100       18 if( $hi == 0 ) {
    50          
    100          
    50          
    50          
    0          
195 3         8 ( $r, $g, $b ) = ( $v, $t, $p );
196             }
197             elsif( $hi == 1 ) {
198 0         0 ( $r, $g, $b ) = ( $q, $v, $p );
199             }
200             elsif( $hi == 2 ) {
201 1         3 ( $r, $g, $b ) = ( $p, $v, $t );
202             }
203             elsif( $hi == 3 ) {
204 0         0 ( $r, $g, $b ) = ( $p, $q, $v );
205             }
206             elsif( $hi == 4 ) {
207 1         3 ( $r, $g, $b ) = ( $t, $p, $v );
208             }
209             elsif( $hi == 5 ) {
210 0         0 ( $r, $g, $b ) = ( $v, $p, $q );
211             }
212              
213 5         17 return ( $r, $g, $b );
214             }
215              
216             sub new_rgb
217             {
218 5     5 0 7 my $class = shift;
219 5         13 my ( $r, $g, $b ) = @_;
220              
221 5         17 my ( $hue, $min, $max ) = $class->_hue_min_max( $r, $g, $b );
222              
223 5 100       24 return $class->new(
224             $hue,
225             $max == 0 ? 0 : 1 - ( $min / $max ),
226             $max
227             );
228             }
229              
230             =head2 dst_hsv
231              
232             $measure = $color->dst_hsv( $other )
233              
234             Returns a measure of the distance between the two colors. This is the
235             Euclidean distance between the two colors as points in the chroma-adjusted
236             cone space.
237              
238             =cut
239              
240             sub dst_hsv
241             {
242 6     6 1 15 my $self = shift;
243 6         10 my ( $other ) = @_;
244              
245             # ... / sqrt(4)
246 6         13 return sqrt( $self->dst_hsv_cheap( $other ) ) / 2;
247             }
248              
249             =head2 dst_hsv_cheap
250              
251             $measure = $color->dst_hsv_cheap( $other )
252              
253             Returns a measure of the distance between the two colors. This is used in the
254             calculation of C but since it omits the final square-root and scaling
255             it is cheaper to calculate, for use in cases where only the relative values
256             matter, such as when picking the "best match" out of a set of colors. It
257             ranges between 0 for identical colors and 4 for the distance between
258             complementary pure-saturated colors.
259              
260             =cut
261              
262             sub dst_hsv_cheap
263             {
264 12     12 1 20 my $self = shift;
265 12         23 my ( $other ) = @_;
266              
267 12         25 my $dv = $self->value - $other->value;
268              
269 12         37 return $self->_huechroma_dst_squ( $other ) + $dv*$dv;
270             }
271              
272             =head1 SEE ALSO
273              
274             =over 4
275              
276             =item *
277              
278             L - color space conversions
279              
280             =item *
281              
282             L - a color value represented as red/green/blue
283              
284             =item *
285              
286             L - HSL and HSV on Wikipedia
287              
288             =back
289              
290             =head1 AUTHOR
291              
292             Paul Evans
293              
294             =cut
295              
296             0x55AA;