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   26 use 5.008009;
  2         4  
4 2     2   5 use strict;
  2         2  
  2         32  
5 2     2   5 use warnings;
  2         6  
  2         45  
6 2     2   4 use parent qw/Convert::Color/;
  2         2  
  2         7  
7              
8 2     2   81 use Convert::Color::XYZ;
  2         1  
  2         110  
9              
10             our $VERSION = '1.000';
11              
12             use constant +{ ## no critic (Capitalization)
13 2         160 KAPPA => (29/3) ** 3,
14             EPS => (6/29) ** 3,
15              
16             REF_X => 3127/3290,
17             REF_Z => 3583/3290,
18 2     2   7 };
  2         3  
19              
20             use constant +{ ## no critic (Capitalization)
21 2         812 REF_U => 4 * REF_X / (REF_X + 15 + 3 * REF_Z),
22             REF_V => 9 / (REF_X + 15 + 3 * REF_Z),
23 2     2   19 };
  2         2  
24              
25             __PACKAGE__->register_color_space('luv');
26              
27             sub new {
28 4097     4097 1 3698 my ($class, $l, $u, $v) = @_;
29 4097 100       4931 ($l, $u, $v) = split /,/s, $l unless defined $u;
30 4097         11455 bless [$l, $u, $v], $class
31             }
32              
33 1     1 1 7 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         5  
38              
39             sub _y_to_l {
40 3072     3072   2076 my ($y) = @_;
41 3072 100       6064 $y <= EPS ? $y * KAPPA : 116 * ($y ** (1/3)) - 16
42             }
43              
44             sub _l_to_y {
45 1022     1022   696 my ($l) = @_;
46 1022 100       2188 $l <= 8 ? $l / KAPPA : (($l + 16) / 116) ** 3
47             }
48              
49             sub convert_to_xyz {
50 1024     1024 0 760 my ($self) = @_;
51 1024         807 my ($l, $u, $v) = @$self;
52 1024 100       1226 return Convert::Color::XYZ->new(0, 0, 0) unless $l;
53 1022         938 my $var_u = $u / (13 * $l) + REF_U;
54 1022         944 my $var_v = $v / (13 * $l) + REF_V;
55 1022         975 my $y = _l_to_y $l;
56 1022         1002 my $x = 9 * $y * $var_u / (4 * $var_v);
57 1022         979 my $z = (9 * $y - (15 * $var_v * $y) - ($var_v * $x)) / (3 * $var_v);
58 1022         2025 Convert::Color::XYZ->new($x, $y, $z)
59             }
60              
61             sub new_from_xyz {
62 3072     3072 0 2563 my ($class, $xyz) = @_;
63 3072         2956 my ($x, $y, $z) = @$xyz;
64 3072         3805 my $l = _y_to_l $y;
65 3072 100       4476 return $class->new(0, 0, 0) unless $l;
66 3066         3609 my $var_u = (4 * $x) / ($x + 15 * $y + 3 * $z);
67 3066         2849 my $var_v = (9 * $y) / ($x + 15 * $y + 3 * $z);
68 3066         2361 my $u = 13 * $l * ($var_u - REF_U);
69 3066         2186 my $v = 13 * $l * ($var_v - REF_V);
70 3066         3599 $class->new($l, $u, $v)
71             }
72              
73 1024     1024 1 1136 sub rgb { shift->convert_to_xyz->rgb }
74 3072     3072 0 146964 sub new_rgb { shift->new_from_xyz(Convert::Color::XYZ->new_rgb(@_)) }
75              
76             1;
77             __END__