File Coverage

blib/lib/Convert/Color/HSL.pm
Criterion Covered Total %
statement 60 62 96.7
branch 18 24 75.0
condition n/a
subroutine 14 14 100.0
pod 9 10 90.0
total 101 110 91.8


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