]>
Commit | Line | Data |
---|---|---|
1 | package Convert::Color::XYZ; | |
2 | ||
3 | use 5.008009; | |
4 | use strict; | |
5 | use warnings; | |
6 | use parent qw/Convert::Color/; | |
7 | ||
8 | use Convert::Color::RGB; | |
9 | use List::Util qw/sum/; | |
10 | ||
11 | our $VERSION = '1.000'; | |
12 | ||
13 | use constant +{ ## no critic (Capitalization) | |
14 | 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 | }; | |
22 | ||
23 | __PACKAGE__->register_color_space('xyz'); | |
24 | ||
25 | sub new { | |
26 | my ($class, $x, $y, $z) = @_; | |
27 | ($x, $y, $z) = split /,/s, $x unless defined $y; | |
28 | bless [$x, $y, $z], $class | |
29 | } | |
30 | ||
31 | sub X { shift->[0] } | |
32 | sub Y { shift->[1] } | |
33 | sub Z { shift->[2] } | |
34 | ||
35 | sub xyz { @{$_[0]} } | |
36 | ||
37 | sub _dot_product { | |
38 | my ($x, $y) = @_; | |
39 | sum map { $x->[$_] * $y->[$_] } 0 .. $#{$x} | |
40 | } | |
41 | ||
42 | sub _from_linear { | |
43 | my ($c) = @_; | |
44 | $c <= 0.0031308 ? 12.92 * $c : 1.055 * $c ** (1 / 2.4) - 0.055 | |
45 | } | |
46 | ||
47 | sub _to_linear { | |
48 | my ($c) = @_; | |
49 | $c <= 0.04045 ? $c / 12.92 : (($c + 0.055) / 1.055) ** 2.4 | |
50 | } | |
51 | ||
52 | sub rgb { | |
53 | my ($self) = @_; | |
54 | map { _from_linear _dot_product $_, $self } MAT_R, MAT_G, MAT_B; | |
55 | } | |
56 | ||
57 | sub new_rgb { | |
58 | my $class = shift; | |
59 | my $vector = [map { _to_linear $_ } @_]; | |
60 | $class->new(map { _dot_product $_, $vector } IMAT_X, IMAT_Y, IMAT_Z) | |
61 | } | |
62 | ||
63 | 1; | |
64 | __END__ | |
65 | ||
66 | =encoding utf-8 | |
67 | ||
68 | =head1 NAME | |
69 | ||
70 | Convert::Color::XYZ - a color value in the CIE 1931 XYZ color space | |
71 | ||
72 | =head1 SYNOPSIS | |
73 | ||
74 | use Convert::Color::XYZ; | |
75 | my $red = Convert::Color::XYZ->new(0.41239, 0.21264, 0.01933); | |
76 | my $green = Convert::Color::XYZ->new('0.35758,0.71517,0.11919'); | |
77 | ||
78 | use Convert::Color; | |
79 | my $blue = Convert::Color->new('xyz:0.18048,0.07219,0.95053'); | |
80 | ||
81 | say $red->X; # 0.41239 | |
82 | say $red->Y; # 0.21264 | |
83 | say $red->Z; # 0.01933 | |
84 | say join ',', $blue->xyz; # 0.18048,0.07219,0.95053 | |
85 | ||
86 | =head1 DESCRIPTION | |
87 | ||
88 | Objects of this class represent colors in the CIE 1931 XYZ color space. | |
89 | ||
90 | Methods: | |
91 | ||
92 | =over | |
93 | ||
94 | =item Convert::Color::XYZ->B<new>(I<$x>, I<$y>, I<$z>) | |
95 | ||
96 | Construct a color from its components. | |
97 | ||
98 | =item Convert::Color::XYZ->B<new>(I<"$x,$y,$z">) | |
99 | ||
100 | Construct a color from a string. The string should contain the three | |
101 | components, separated by commas. | |
102 | ||
103 | =item $xyz->B<X> | |
104 | ||
105 | =item $xyz->B<Y> | |
106 | ||
107 | =item $xyz->B<Z> | |
108 | ||
109 | Accessors for the three components of the color. | |
110 | ||
111 | =item $xyz->B<xyz> | |
112 | ||
113 | Returns the three components as a list. | |
114 | ||
115 | =back | |
116 | ||
117 | =head1 SEE ALSO | |
118 | ||
119 | L<Convert::Color> | |
120 | ||
121 | =head1 AUTHOR | |
122 | ||
123 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
124 | ||
125 | =head1 COPYRIGHT AND LICENSE | |
126 | ||
127 | Copyright (C) 2015 by Marius Gavrilescu | |
128 | ||
129 | This library is free software; you can redistribute it and/or modify | |
130 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
131 | at your option, any later version of Perl 5 you may have available. | |
132 | ||
133 | ||
134 | =cut |