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 5 5 100.0
pod 0 2 0.0
total 49 52 94.2


line stmt bran cond sub pod time code
1              
2             # HSL color space specific code
3              
4             package Graphics::Toolkit::Color::Space::Instance::HSL;
5 15     15   206867 use v5.12;
  15         61  
6 15     15   96 use warnings;
  15         39  
  15         970  
7 15     15   809 use Graphics::Toolkit::Color::Space qw/min max mod_real/;
  15         64  
  15         8230  
8              
9             sub from_rgb {
10 72     72 0 114 my ($r, $g, $b) = @{$_[0]};
  72         211  
11 72         258 my $vmax = max($r, $g, $b),
12             my $vmin = min($r, $g, $b);
13 72         198 my $l = ($vmax + $vmin) / 2;
14 72 100       241 return ([0, 0, $l]) if $vmax == $vmin;
15 43         90 my $d = $vmax - $vmin;
16 43 100       140 my $s = ($l > 0.5) ? ($d / (2 - $vmax - $vmin)) : ($d / ($vmax + $vmin));
17 43 50       195 my $h = ($vmax == $r) ? (($g - $b) / $d + ($g < $b ? 6 : 0)) :
    100          
    100          
18             ($vmax == $g) ? (($b - $r) / $d + 2)
19             : (($r - $g) / $d + 4);
20 43         183 return ([$h/6, $s, $l]);
21             }
22             sub to_rgb {
23 90     90 0 266 my ($h, $s, $l) = @{$_[0]};
  90         229  
24 90         184 $h *= 6;
25 90         283 my $C = $s * (1 - abs($l * 2 - 1));
26 90         262 my $X = $C * (1 - abs( mod_real($h, 2) - 1) );
27 90         191 my $m = $l - ($C / 2);
28 90 100       585 my @rgb = ($h < 1) ? ($C + $m, $X + $m, $m)
    100          
    100          
    100          
    100          
29             : ($h < 2) ? ($X + $m, $C + $m, $m)
30             : ($h < 3) ? ( $m, $C + $m, $X + $m)
31             : ($h < 4) ? ( $m, $X + $m, $C + $m)
32             : ($h < 5) ? ($X + $m, $m, $C + $m)
33             : ($C + $m, $m, $X + $m);
34 90         291 return \@rgb;
35             }
36              
37             Graphics::Toolkit::Color::Space->new(
38             axis => [qw/hue saturation lightness/],
39             range => [ 360, 100, 100 ],
40             precision => 0,
41             type => [qw/angular linear linear/],
42             # suffix => ['', '%', '%'],
43             convert => {RGB => [\&to_rgb, \&from_rgb]},
44             );