File Coverage

blib/lib/Convert/Color/XYZ.pm
Criterion Covered Total %
statement 45 45 100.0
branch 6 6 100.0
condition n/a
subroutine 17 17 100.0
pod 6 7 85.7
total 74 75 98.6


line stmt bran cond sub pod time code
1             package Convert::Color::XYZ;
2              
3 2     2   30 use 5.008009;
  2         7  
  2         72  
4 2     2   7 use strict;
  2         2  
  2         50  
5 2     2   6 use warnings;
  2         2  
  2         42  
6 2     2   7 use parent qw/Convert::Color/;
  2         2  
  2         6  
7              
8 2     2   1057 use Convert::Color::RGB;
  2         1354  
  2         47  
9 2     2   9 use List::Util qw/sum/;
  2         2  
  2         166  
10              
11             our $VERSION = '0.002001';
12              
13             use constant +{ ## no critic (Capitalization)
14 2         772 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         2  
22              
23             __PACKAGE__->register_color_space('xyz');
24              
25             sub new {
26 4609     4609 1 5782 my ($class, $x, $y, $z) = @_;
27 4609 100       8549 ($x, $y, $z) = split /,/s, $x unless defined $y;
28 4609         19570 bless [$x, $y, $z], $class
29             }
30              
31 1     1 1 10 sub X { shift->[0] }
32 1     1 1 5 sub Y { shift->[1] }
33 1     1 1 5 sub Z { shift->[2] }
34              
35 1     1 1 1 sub xyz { @{$_[0]} }
  1         7  
36              
37             sub _dot_product {
38 13824     13824   12115 my ($x, $y) = @_;
39 13824         10646 sum map { $x->[$_] * $y->[$_] } 0 .. $#{$x}
  41472         68857  
  13824         17535  
40             }
41              
42             sub _from_linear {
43 3072     3072   2507 my ($c) = @_;
44 3072 100       12949 $c <= 0.0031308 ? 12.92 * $c : 1.055 * $c ** (1 / 2.4) - 0.055
45             }
46              
47             sub _to_linear {
48 10752     10752   8241 my ($c) = @_;
49 10752 100       28460 $c <= 0.04045 ? $c / 12.92 : (($c + 0.055) / 1.055) ** 2.4
50             }
51              
52             sub rgb {
53 1024     1024 1 1090 my ($self) = @_;
54 1024         1141 map { _from_linear _dot_product $_, $self } MAT_R, MAT_G, MAT_B;
  3072         3577  
55             }
56              
57             sub new_rgb {
58 3584     3584 0 168369 my $class = shift;
59 3584         4070 my $vector = [map { _to_linear $_ } @_];
  10752         12416  
60 3584         4740 $class->new(map { _dot_product $_, $vector } IMAT_X, IMAT_Y, IMAT_Z)
  10752         13096  
61             }
62              
63             1;
64             __END__