File Coverage

blib/lib/Convert/Color/XYZ.pm
Criterion Covered Total %
statement 35 45 77.7
branch 3 6 50.0
condition n/a
subroutine 11 17 64.7
pod 6 7 85.7
total 55 75 73.3


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__