File Coverage

lib/Graphics/Toolkit/Color/Space/Instance/AppleRGB.pm
Criterion Covered Total %
statement 20 20 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod 0 2 0.0
total 25 27 92.5


line stmt bran cond sub pod time code
1              
2             # Apple RGB 1998 (illuminant D65, gamma 1.8)
3              
4             package Graphics::Toolkit::Color::Space::Instance::AppleRGB;
5 16     16   260747 use v5.12;
  16         46  
6 16     16   60 use warnings;
  16         31  
  16         738  
7 16     16   460 use Graphics::Toolkit::Color::Space qw/spow mult_matrix_vector_3/;
  16         21  
  16         5182  
8              
9             my @D65 = (.95047, 1, 1.08883);
10             my $gamma = 1.8;
11              
12             sub from_rgb {
13 4     4 0 5 my $rgb = shift;
14 4         6 $rgb = [map {spow($_, $gamma)} @$rgb];
  12         17  
15 4         14 my @xyz = mult_matrix_vector_3( [[ 0.4497288, 0.3162486, 0.1844926 ],
16             [ 0.2446525, 0.6720283, 0.0833192 ],
17             [ 0.0251848, 0.1411824, 0.9224628 ] ], @$rgb);
18 4         19 $xyz[$_] /= $D65[ $_ ] for 0 .. 2;
19 4         10 return \@xyz;
20             }
21             sub to_rgb {
22 4     4 0 5 my ($xyz) = [ @{$_[0]} ];
  4         7  
23 4         13 $xyz->[$_] *= $D65[ $_ ] for 0 .. 2;
24 4         14 my @rgb = mult_matrix_vector_3( [[ 2.9515373, -1.2894116, -0.4738445 ],
25             [ -1.0851093, 1.9908566, 0.0372026 ],
26             [ 0.0854934, -0.2694964, 1.0912975 ] ], @$xyz);
27 4         9 return [map {spow($_, 1 / $gamma)} @rgb];
  12         17  
28             }
29            
30             Graphics::Toolkit::Color::Space->new(
31             name => 'AppleRGB',
32             family => 'RGB',
33             axis => [qw/red green blue/],
34             precision => 6,
35             convert => {XYZ => [\&from_rgb, \&to_rgb]},
36             );