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   703 use v5.12;
  8         28  
2 8     8   42 use warnings;
  8         23  
  8         344  
3              
4             # HSL color space specific code
5              
6             package Graphics::Toolkit::Color::Space::Instance::HSL;
7 8     8   49 use Graphics::Toolkit::Color::Space::Util ':all';
  8         50  
  8         935  
8 8     8   492 use Graphics::Toolkit::Color::Space;
  8         18  
  8         2811  
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 155     155 0 271 my ($r, $g, $b) = @_;
19 155         340 my $vmax = max($r, $g, $b),
20             my $vmin = min($r, $g, $b);
21 155         313 my $l = ($vmax + $vmin) / 2;
22 155 100       341 return (0, 0, $l) if $vmax == $vmin;
23 132         193 my $d = $vmax - $vmin;
24 132 50       285 my $s = ($l > 0.5) ? ($d / (2 - $vmax - $vmin)) : ($d / ($vmax + $vmin));
25 132 100       383 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 132         484 return ($h/6, $s, $l);
29             }
30              
31             sub to_rgb {
32 121     121 0 244 my ($h, $s, $l) = @_;
33 121         182 $h *= 6;
34 121         282 my $C = $s * (1 - abs($l * 2 - 1));
35 121         261 my $X = $C * (1 - abs( rmod($h, 2) - 1) );
36 121         214 my $m = $l - ($C / 2);
37 121 100       766 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;