File Coverage

blib/lib/Convert/Color/LUV.pm
Criterion Covered Total %
statement 52 52 100.0
branch 10 10 100.0
condition n/a
subroutine 18 18 100.0
pod 6 9 66.6
total 86 89 96.6


line stmt bran cond sub pod time code
1             package Convert::Color::LUV;
2              
3 2     2   47 use 5.008009;
  2         4  
4 2     2   6 use strict;
  2         2  
  2         28  
5 2     2   20 use warnings;
  2         3  
  2         42  
6 2     2   5 use parent qw/Convert::Color/;
  2         3  
  2         11  
7              
8 2     2   78 use Convert::Color::XYZ;
  2         2  
  2         153  
9              
10             our $VERSION = '1.000001';
11              
12             use constant +{ ## no critic (Capitalization)
13 2         166 KAPPA => (29/3) ** 3,
14             EPS => (6/29) ** 3,
15              
16             REF_X => 3127/3290,
17             REF_Z => 3583/3290,
18 2     2   21 };
  2         4  
19              
20             use constant +{ ## no critic (Capitalization)
21 2         804 REF_U => 4 * REF_X / (REF_X + 15 + 3 * REF_Z),
22             REF_V => 9 / (REF_X + 15 + 3 * REF_Z),
23 2     2   18 };
  2         2  
24              
25             __PACKAGE__->register_color_space('luv');
26              
27             sub new {
28 4097     4097 1 3984 my ($class, $l, $u, $v) = @_;
29 4097 100       5427 ($l, $u, $v) = split /,/s, $l unless defined $u;
30 4097         11953 bless [$l, $u, $v], $class
31             }
32              
33 1     1 1 8 sub L { shift->[0] }
34 1     1 1 4 sub u { shift->[1] }
35 1     1 1 4 sub v { shift->[2] }
36              
37 1     1 1 2 sub luv { @{$_[0]} }
  1         6  
38              
39             sub _y_to_l {
40 3072     3072   2008 my ($y) = @_;
41 3072 100       7436 $y <= EPS ? $y * KAPPA : 116 * ($y ** (1/3)) - 16
42             }
43              
44             sub _l_to_y {
45 1022     1022   766 my ($l) = @_;
46 1022 100       2143 $l <= 8 ? $l / KAPPA : (($l + 16) / 116) ** 3
47             }
48              
49             sub convert_to_xyz {
50 1024     1024 0 719 my ($self) = @_;
51 1024         838 my ($l, $u, $v) = @$self;
52 1024 100       1311 return Convert::Color::XYZ->new(0, 0, 0) unless $l;
53 1022         956 my $var_u = $u / (13 * $l) + REF_U;
54 1022         754 my $var_v = $v / (13 * $l) + REF_V;
55 1022         1085 my $y = _l_to_y $l;
56 1022         1043 my $x = 9 * $y * $var_u / (4 * $var_v);
57 1022         1116 my $z = (9 * $y - (15 * $var_v * $y) - ($var_v * $x)) / (3 * $var_v);
58 1022         1740 Convert::Color::XYZ->new($x, $y, $z)
59             }
60              
61             sub new_from_xyz {
62 3072     3072 0 2456 my ($class, $xyz) = @_;
63 3072         3010 my ($x, $y, $z) = @$xyz;
64 3072         3706 my $l = _y_to_l $y;
65 3072 100       4362 return $class->new(0, 0, 0) unless $l;
66 3066         3647 my $var_u = (4 * $x) / ($x + 15 * $y + 3 * $z);
67 3066         2699 my $var_v = (9 * $y) / ($x + 15 * $y + 3 * $z);
68 3066         2571 my $u = 13 * $l * ($var_u - REF_U);
69 3066         2133 my $v = 13 * $l * ($var_v - REF_V);
70 3066         3470 $class->new($l, $u, $v)
71             }
72              
73 1024     1024 1 1168 sub rgb { shift->convert_to_xyz->rgb }
74 3072     3072 0 118776 sub new_rgb { shift->new_from_xyz(Convert::Color::XYZ->new_rgb(@_)) }
75              
76             1;
77             __END__