File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/CIELCHab.pm
Criterion Covered Total %
statement 21 21 100.0
branch 6 6 100.0
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 32 34 94.1


line stmt bran cond sub pod time code
1              
2             # CIE LCh(ab) cylindrical color space variant of CIELAB
3              
4             package Graphics::Toolkit::Color::Space::Instance::CIELCHab;
5 16     16   351380 use v5.12;
  16         50  
6 16     16   69 use warnings;
  16         20  
  16         825  
7 16     16   741 use Graphics::Toolkit::Color::Space qw/round_decimals/;
  16         23  
  16         5106  
8              
9             my $TAU = 6.283185307;
10              
11             sub from_lch {
12 10     10 0 22 my ($lch) = shift;
13 10         77 my $a = $lch->[1] * cos($lch->[2] * $TAU) * 539;
14 10         24 my $b = $lch->[1] * sin($lch->[2] * $TAU) * 539;
15 10         51 return ([$lch->[0], ($a+500) / 1000, ($b+200) / 400 ]);
16             }
17             sub to_lch {
18 8     8 0 20 my ($lab) = shift;
19 8         22 my $a = $lab->[1] * 1000 - 500;
20 8         14 my $b = $lab->[2] * 400 - 200;
21              
22 8 100       22 $a = 0 if round_decimals($a, 5) == 0;
23 8 100       18 $b = 0 if round_decimals($b, 5) == 0;
24 8         28 my $c = sqrt( ($a**2) + ($b**2));
25 8         37 my $h = atan2($b, $a);
26 8 100       23 $h += $TAU if $h < 0;
27 8         35 return ([$lab->[0], $c / 539, $h / $TAU]);
28             }
29              
30             Graphics::Toolkit::Color::Space->new(
31             name => 'LCH',
32             alias_name => 'CIELCHab',
33             family => 'HSL',
34             axis => [qw/luminance chroma hue/],
35             role => [qw/lightness saturation hue/],
36             type => [qw/linear linear angular/],
37             range => [100, 539, 360],
38             precision => 3,
39             convert => { LAB => [\&from_lch, \&to_lch] },
40             );