lib/Convert/Color/XYZ.pm

   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 = '0.002001';
  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