line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Convert::Color::XYZ; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
23
|
use 5.008009; |
|
2
|
|
|
|
|
4
|
|
4
|
2
|
|
|
2
|
|
5
|
use strict; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
26
|
|
5
|
2
|
|
|
2
|
|
5
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
39
|
|
6
|
2
|
|
|
2
|
|
6
|
use parent qw/Convert::Color/; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
6
|
|
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
868
|
use Convert::Color::RGB; |
|
2
|
|
|
|
|
1160
|
|
|
2
|
|
|
|
|
41
|
|
9
|
2
|
|
|
2
|
|
8
|
use List::Util qw/sum/; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
173
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '1.000001'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use constant +{ ## no critic (Capitalization) |
14
|
2
|
|
|
|
|
745
|
MAT_R => [ 3.2409699419045214, -1.5373831775700935, -0.49861076029300328 ], |
15
|
|
|
|
|
|
|
MAT_G => [ -0.96924363628087983, 1.8759675015077207, 0.041555057407175613 ], |
16
|
|
|
|
|
|
|
MAT_B => [ 0.055630079696993609, -0.20397695888897657, 1.0569715142428786 ], |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
IMAT_X => [ 0.41239079926595948, 0.35758433938387796, 0.18048078840183429 ], |
19
|
|
|
|
|
|
|
IMAT_Y => [ 0.21263900587151036, 0.71516867876775593, 0.072192315360733715 ], |
20
|
|
|
|
|
|
|
IMAT_Z => [ 0.019330818715591851, 0.11919477979462599, 0.95053215224966058 ], |
21
|
2
|
|
|
2
|
|
8
|
}; |
|
2
|
|
|
|
|
3
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
__PACKAGE__->register_color_space('xyz'); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new { |
26
|
4609
|
|
|
4609
|
1
|
4647
|
my ($class, $x, $y, $z) = @_; |
27
|
4609
|
100
|
|
|
|
7210
|
($x, $y, $z) = split /,/s, $x unless defined $y; |
28
|
4609
|
|
|
|
|
14135
|
bless [$x, $y, $z], $class |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
1
|
|
|
1
|
1
|
9
|
sub X { shift->[0] } |
32
|
1
|
|
|
1
|
1
|
4
|
sub Y { shift->[1] } |
33
|
1
|
|
|
1
|
1
|
4
|
sub Z { shift->[2] } |
34
|
|
|
|
|
|
|
|
35
|
1
|
|
|
1
|
1
|
2
|
sub xyz { @{$_[0]} } |
|
1
|
|
|
|
|
6
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub _dot_product { |
38
|
13824
|
|
|
13824
|
|
9685
|
my ($x, $y) = @_; |
39
|
13824
|
|
|
|
|
8892
|
sum map { $x->[$_] * $y->[$_] } 0 .. $#{$x} |
|
41472
|
|
|
|
|
51311
|
|
|
13824
|
|
|
|
|
11763
|
|
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _from_linear { |
43
|
3072
|
|
|
3072
|
|
2032
|
my ($c) = @_; |
44
|
3072
|
100
|
|
|
|
10021
|
$c <= 0.0031308 ? 12.92 * $c : 1.055 * $c ** (1 / 2.4) - 0.055 |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _to_linear { |
48
|
10752
|
|
|
10752
|
|
7150
|
my ($c) = @_; |
49
|
10752
|
100
|
|
|
|
23535
|
$c <= 0.04045 ? $c / 12.92 : (($c + 0.055) / 1.055) ** 2.4 |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub rgb { |
53
|
1024
|
|
|
1024
|
1
|
714
|
my ($self) = @_; |
54
|
1024
|
|
|
|
|
901
|
map { _from_linear _dot_product $_, $self } MAT_R, MAT_G, MAT_B; |
|
3072
|
|
|
|
|
3042
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub new_rgb { |
58
|
3584
|
|
|
3584
|
0
|
142915
|
my $class = shift; |
59
|
3584
|
|
|
|
|
3460
|
my $vector = [map { _to_linear $_ } @_]; |
|
10752
|
|
|
|
|
9789
|
|
60
|
3584
|
|
|
|
|
3948
|
$class->new(map { _dot_product $_, $vector } IMAT_X, IMAT_Y, IMAT_Z) |
|
10752
|
|
|
|
|
9593
|
|
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
1; |
64
|
|
|
|
|
|
|
__END__ |