File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/HSL.pm
Criterion Covered Total %
statement 25 25 100.0
branch 19 20 95.0
condition n/a
subroutine 6 6 100.0
pod 0 2 0.0
total 50 53 94.3


line stmt bran cond sub pod time code
1 8     8   793 use v5.12;
  8         26  
2 8     8   42 use warnings;
  8         14  
  8         380  
3              
4             # HSL color space specific code
5              
6             package Graphics::Toolkit::Color::Space::Instance::HSL;
7 8     8   50 use Graphics::Toolkit::Color::Space::Util ':all';
  8         49  
  8         990  
8 8     8   494 use Graphics::Toolkit::Color::Space;
  8         15  
  8         3169  
9              
10             my $hsl_def = Graphics::Toolkit::Color::Space->new( axis => [qw/hue saturation lightness/],
11             range => [ 360, 100, 100 ],
12             type => [qw/angle linear linear/]);
13              
14             $hsl_def->add_converter('RGB', \&to_rgb, \&from_rgb );
15              
16              
17             sub from_rgb {
18 162     162 0 314 my ($r, $g, $b) = @_;
19 162         350 my $vmax = max($r, $g, $b),
20             my $vmin = min($r, $g, $b);
21 162         337 my $l = ($vmax + $vmin) / 2;
22 162 100       388 return (0, 0, $l) if $vmax == $vmin;
23 139         203 my $d = $vmax - $vmin;
24 139 50       313 my $s = ($l > 0.5) ? ($d / (2 - $vmax - $vmin)) : ($d / ($vmax + $vmin));
25 139 100       425 my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
    100          
    100          
26             ($vmax == $g) ? (($b - $r) / $d + 2)
27             : (($r - $g) / $d + 4);
28 139         554 return ($h/6, $s, $l);
29             }
30              
31             sub to_rgb {
32 109     109 0 223 my ($h, $s, $l) = @_;
33 109         184 $h *= 6;
34 109         251 my $C = $s * (1 - abs($l * 2 - 1));
35 109         228 my $X = $C * (1 - abs( rmod($h, 2) - 1) );
36 109         212 my $m = $l - ($C / 2);
37 109 100       689 return ($h < 1) ? ($C + $m, $X + $m, $m)
    100          
    100          
    100          
    100          
38             : ($h < 2) ? ($X + $m, $C + $m, $m)
39             : ($h < 3) ? ( $m, $C + $m, $X + $m)
40             : ($h < 4) ? ( $m, $X + $m, $C + $m)
41             : ($h < 5) ? ($X + $m, $m, $C + $m)
42             : ($C + $m, $m, $X + $m);
43             }
44              
45             $hsl_def;