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.17; |
7
|
|
|
|
|
|
|
|
8
|
13
|
|
|
13
|
|
675245
|
use v5.14; |
|
13
|
|
|
|
|
60
|
|
9
|
13
|
|
|
13
|
|
75
|
use warnings; |
|
13
|
|
|
|
|
32
|
|
|
13
|
|
|
|
|
392
|
|
10
|
13
|
|
|
13
|
|
101
|
use base qw( Convert::Color::HueChromaBased ); |
|
13
|
|
|
|
|
25
|
|
|
13
|
|
|
|
|
2652
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
__PACKAGE__->register_color_space( 'hsv' ); |
13
|
|
|
|
|
|
|
|
14
|
13
|
|
|
13
|
|
107
|
use Carp; |
|
13
|
|
|
|
|
38
|
|
|
13
|
|
|
|
|
10119
|
|
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
|
334
|
my $class = shift; |
85
|
|
|
|
|
|
|
|
86
|
23
|
|
|
|
|
49
|
my ( $h, $s, $v ); |
87
|
|
|
|
|
|
|
|
88
|
23
|
100
|
|
|
|
77
|
if( @_ == 1 ) { |
|
|
50
|
|
|
|
|
|
89
|
4
|
|
|
|
|
9
|
local $_ = $_[0]; |
90
|
4
|
50
|
|
|
|
31
|
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
|
|
|
|
|
41
|
( $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
|
|
|
|
|
48
|
for ( $s, $v ) { |
106
|
46
|
50
|
|
|
|
107
|
$_ = 0 if $_ < 0; |
107
|
46
|
50
|
|
|
|
108
|
$_ = 1 if $_ > 1; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
# Fit to range [0,360) |
111
|
23
|
|
|
|
|
57
|
$h += 360 while $h < 0; |
112
|
23
|
|
|
|
|
50
|
$h -= 360 while $h >= 360; |
113
|
|
|
|
|
|
|
|
114
|
23
|
|
|
|
|
96
|
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
|
551
|
sub hue { shift->[0] } |
139
|
42
|
|
|
42
|
1
|
124
|
sub saturation { shift->[1] } |
140
|
66
|
|
|
66
|
1
|
183
|
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
|
41
|
my $self = shift; |
156
|
30
|
|
|
|
|
54
|
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
|
|
|
|
|
45
|
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
|
|
|
|
|
10
|
my ( $h, $s, $v ) = $self->hsv; |
183
|
|
|
|
|
|
|
|
184
|
5
|
|
|
|
|
13
|
my $hi = int( $h / 60 ); |
185
|
|
|
|
|
|
|
|
186
|
5
|
|
|
|
|
11
|
my $f = $h / 60 - $hi; |
187
|
|
|
|
|
|
|
|
188
|
5
|
|
|
|
|
10
|
my $p = $v * ( 1 - $s ); |
189
|
5
|
|
|
|
|
8
|
my $q = $v * ( 1 - $f * $s ); |
190
|
5
|
|
|
|
|
9
|
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
|
|
|
|
|
6
|
( $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
|
|
|
|
|
4
|
( $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
|
|
|
|
|
4
|
( $r, $g, $b ) = ( $t, $p, $v ); |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
elsif( $hi == 5 ) { |
210
|
0
|
|
|
|
|
0
|
( $r, $g, $b ) = ( $v, $p, $q ); |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
5
|
|
|
|
|
21
|
return ( $r, $g, $b ); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub new_rgb |
217
|
|
|
|
|
|
|
{ |
218
|
5
|
|
|
5
|
0
|
9
|
my $class = shift; |
219
|
5
|
|
|
|
|
10
|
my ( $r, $g, $b ) = @_; |
220
|
|
|
|
|
|
|
|
221
|
5
|
|
|
|
|
18
|
my ( $hue, $min, $max ) = $class->_hue_min_max( $r, $g, $b ); |
222
|
|
|
|
|
|
|
|
223
|
5
|
100
|
|
|
|
22
|
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
|
13
|
my $self = shift; |
243
|
6
|
|
|
|
|
12
|
my ( $other ) = @_; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# ... / sqrt(4) |
246
|
6
|
|
|
|
|
12
|
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
|
|
|
|
|
20
|
my ( $other ) = @_; |
266
|
|
|
|
|
|
|
|
267
|
12
|
|
|
|
|
23
|
my $dv = $self->value - $other->value; |
268
|
|
|
|
|
|
|
|
269
|
12
|
|
|
|
|
38
|
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; |