line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Convert::Color::XYZ; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
13
|
use 5.008009; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
31
|
|
4
|
1
|
|
|
1
|
|
3
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
22
|
|
5
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
26
|
|
6
|
1
|
|
|
1
|
|
3
|
use parent qw/Convert::Color/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
3
|
|
7
|
|
|
|
|
|
|
|
8
|
1
|
|
|
1
|
|
471
|
use Convert::Color::RGB; |
|
1
|
|
|
|
|
679
|
|
|
1
|
|
|
|
|
26
|
|
9
|
1
|
|
|
1
|
|
5
|
use List::Util qw/sum/; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
82
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.002'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
use constant +{ ## no critic (Capitalization) |
14
|
1
|
|
|
|
|
377
|
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
|
1
|
|
|
1
|
|
4
|
}; |
|
1
|
|
|
|
|
1
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
__PACKAGE__->register_color_space('xyz'); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new { |
26
|
20480
|
|
|
20480
|
1
|
22992
|
my ($class, $x, $y, $z) = @_; |
27
|
20480
|
50
|
|
|
|
37145
|
($x, $y, $z) = split /,/s, $x unless defined $y; |
28
|
20480
|
|
|
|
|
95358
|
bless [$x, $y, $z], $class |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
0
|
|
|
0
|
1
|
0
|
sub X { shift->[0] } |
32
|
0
|
|
|
0
|
1
|
0
|
sub Y { shift->[1] } |
33
|
0
|
|
|
0
|
1
|
0
|
sub Z { shift->[2] } |
34
|
|
|
|
|
|
|
|
35
|
0
|
|
|
0
|
1
|
0
|
sub xyz { @{$_[0]} } |
|
0
|
|
|
|
|
0
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub _dot_product { |
38
|
61440
|
|
|
61440
|
|
50814
|
my ($x, $y) = @_; |
39
|
61440
|
|
|
|
|
50620
|
sum map { $x->[$_] * $y->[$_] } 0 .. $#{$x} |
|
184320
|
|
|
|
|
307581
|
|
|
61440
|
|
|
|
|
75083
|
|
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
sub _from_linear { |
43
|
0
|
|
|
0
|
|
0
|
my ($c) = @_; |
44
|
0
|
0
|
|
|
|
0
|
$c <= 0.0031308 ? 12.92 * $c : 1.055 * $c ** (1 / 2.4) - 0.055 |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _to_linear { |
48
|
61440
|
|
|
61440
|
|
50110
|
my ($c) = @_; |
49
|
61440
|
100
|
|
|
|
164583
|
$c <= 0.04045 ? $c / 12.92 : (($c + 0.055) / 1.055) ** 2.4 |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub rgb { |
53
|
0
|
|
|
0
|
1
|
0
|
my ($self) = @_; |
54
|
0
|
|
|
|
|
0
|
map { _from_linear _dot_product $_, $self } MAT_R, MAT_G, MAT_B; |
|
0
|
|
|
|
|
0
|
|
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub new_rgb { |
58
|
20480
|
|
|
20480
|
0
|
1510303
|
my $class = shift; |
59
|
20480
|
|
|
|
|
23459
|
my $vector = [map { _to_linear $_ } @_]; |
|
61440
|
|
|
|
|
69993
|
|
60
|
20480
|
|
|
|
|
26639
|
$class->new(map { _dot_product $_, $vector } IMAT_X, IMAT_Y, IMAT_Z) |
|
61440
|
|
|
|
|
71293
|
|
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
1; |
64
|
|
|
|
|
|
|
__END__ |