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__ |