File Coverage

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


line stmt bran cond sub pod time code
1             package Convert::Color::LUV;
2              
3 2     2   29 use 5.008009;
  2         4  
  2         60  
4 2     2   7 use strict;
  2         3  
  2         44  
5 2     2   6 use warnings;
  2         2  
  2         84  
6 2     2   8 use parent qw/Convert::Color/;
  2         4  
  2         9  
7              
8 2     2   83 use Convert::Color::XYZ;
  2         2  
  2         117  
9              
10             our $VERSION = '0.002001';
11              
12             use constant +{ ## no critic (Capitalization)
13 2         205 KAPPA => (29/3) ** 3,
14             EPS => (6/29) ** 3,
15              
16             REF_X => 3127/3290,
17             REF_Z => 3583/3290,
18 2     2   8 };
  2         2  
19              
20             use constant +{ ## no critic (Capitalization)
21 2         926 REF_U => 4 * REF_X / (REF_X + 15 + 3 * REF_Z),
22             REF_V => 9 / (REF_X + 15 + 3 * REF_Z),
23 2     2   22 };
  2         3  
24              
25             __PACKAGE__->register_color_space('luv');
26              
27             sub new {
28 4097     4097 1 4659 my ($class, $l, $u, $v) = @_;
29 4097 100       6431 ($l, $u, $v) = split /,/s, $l unless defined $u;
30 4097         15858 bless [$l, $u, $v], $class
31             }
32              
33 1     1 1 10 sub L { shift->[0] }
34 1     1 1 7 sub u { shift->[1] }
35 1     1 1 4 sub v { shift->[2] }
36              
37 1     1 1 2 sub luv { @{$_[0]} }
  1         7  
38              
39             sub _y_to_l {
40 3072     3072   2560 my ($y) = @_;
41 3072 100       8000 $y <= EPS ? $y * KAPPA : 116 * ($y ** (1/3)) - 16
42             }
43              
44             sub _l_to_y {
45 1022     1022   962 my ($l) = @_;
46 1022 100       3044 $l <= 8 ? $l / KAPPA : (($l + 16) / 116) ** 3
47             }
48              
49             sub convert_to_xyz {
50 1024     1024 0 1002 my ($self) = @_;
51 1024         1072 my ($l, $u, $v) = @$self;
52 1024 100       1554 return Convert::Color::XYZ->new(0, 0, 0) unless $l;
53 1022         1268 my $var_u = $u / (13 * $l) + REF_U;
54 1022         1026 my $var_v = $v / (13 * $l) + REF_V;
55 1022         1431 my $y = _l_to_y $l;
56 1022         1349 my $x = 9 * $y * $var_u / (4 * $var_v);
57 1022         1384 my $z = (9 * $y - (15 * $var_v * $y) - ($var_v * $x)) / (3 * $var_v);
58 1022         2343 Convert::Color::XYZ->new($x, $y, $z)
59             }
60              
61             sub new_from_xyz {
62 3072     3072 0 3404 my ($class, $xyz) = @_;
63 3072         3459 my ($x, $y, $z) = @$xyz;
64 3072         4011 my $l = _y_to_l $y;
65 3072 100       4848 return $class->new(0, 0, 0) unless $l;
66 3066         4634 my $var_u = (4 * $x) / ($x + 15 * $y + 3 * $z);
67 3066         3641 my $var_v = (9 * $y) / ($x + 15 * $y + 3 * $z);
68 3066         2843 my $u = 13 * $l * ($var_u - REF_U);
69 3066         2744 my $v = 13 * $l * ($var_v - REF_V);
70 3066         4937 $class->new($l, $u, $v)
71             }
72              
73 1024     1024 1 1426 sub rgb { shift->convert_to_xyz->rgb }
74 3072     3072 0 151203 sub new_rgb { shift->new_from_xyz(Convert::Color::XYZ->new_rgb(@_)) }
75              
76             1;
77             __END__