lib/Convert/Color/LUV.pm

   1 package Convert::Color::LUV;
   2
   3 use 5.008009;
   4 use strict;
   5 use warnings;
   6 use parent qw/Convert::Color/;
   7
   8 use Convert::Color::XYZ;
   9
  10 our $VERSION = '0.002';
  11
  12 use constant +{ ## no critic (Capitalization)
  13         KAPPA => (29/3) ** 3,
  14         EPS => (6/29) ** 3,
  15
  16         REF_X => 3127/3290,
  17         REF_Z => 3583/3290,
  18 };
  19
  20 use constant +{ ## no critic (Capitalization)
  21         REF_U => 4 * REF_X / (REF_X + 15 + 3 * REF_Z),
  22         REF_V => 9         / (REF_X + 15 + 3 * REF_Z),
  23 };
  24
  25 __PACKAGE__->register_color_space('luv');
  26
  27 sub new {
  28         my ($class, $l, $u, $v) = @_;
  29         ($l, $u, $v) = split /,/s, $l unless defined $u;
  30         bless [$l, $u, $v], $class
  31 }
  32
  33 sub L { shift->[0] }
  34 sub u { shift->[1] }
  35 sub v { shift->[2] }
  36
  37 sub luv { @{$_[0]} }
  38
  39 sub _y_to_l {
  40         my ($y) = @_;
  41         $y <= EPS ? $y * KAPPA : 116 * ($y ** (1/3)) - 16
  42 }
  43
  44 sub _l_to_y {
  45         my ($l) = @_;
  46         $l <= 8 ? $l / KAPPA : (($l + 16) / 116) ** 3
  47 }
  48
  49 sub convert_to_xyz {
  50         my ($self) = @_;
  51         my ($l, $u, $v) = @$self;
  52         return Convert::Color::XYZ->new(0, 0, 0) unless $l;
  53         my $var_u = $u / (13 * $l) + REF_U;
  54         my $var_v = $v / (13 * $l) + REF_V;
  55         my $y = _l_to_y $l;
  56         my $x = 9 * $y * $var_u / (4 * $var_v);
  57         my $z = (9 * $y - (15 * $var_v * $y) - ($var_v * $x)) / (3 * $var_v);
  58         Convert::Color::XYZ->new($x, $y, $z)
  59 }
  60
  61 sub new_from_xyz {
  62         my ($class, $xyz) = @_;
  63         my ($x, $y, $z) = @$xyz;
  64         my $l = _y_to_l $y;
  65         return $class->new(0, 0, 0) unless $l;
  66         my $var_u = (4 * $x) / ($x + 15 * $y + 3 * $z);
  67         my $var_v = (9 * $y) / ($x + 15 * $y + 3 * $z);
  68         my $u = 13 * $l * ($var_u - REF_U);
  69         my $v = 13 * $l * ($var_v - REF_V);
  70         $class->new($l, $u, $v)
  71 }
  72
  73 sub rgb { shift->convert_to_xyz->rgb }
  74 sub new_rgb { shift->new_from_xyz(Convert::Color::XYZ->new_rgb(@_)) }
  75
  76 1;
  77 __END__
  78
  79 =encoding utf-8
  80
  81 =head1 NAME
  82
  83 Convert::Color::LUV - a color value in the CIE 1976 (L*, u*, v*) color space
  84
  85 =head1 SYNOPSIS
  86
  87   use Convert::Color::LUV;
  88   my $red = Convert::Color::LUV->new(53.23711, 175.00982, 37.76509);
  89   my $green = Convert::Color::LUV->new('87.73552,-83.06712,107.41811');
  90
  91   use Convert::Color;
  92   my $blue = Convert::Color->new('luv:32.30087,-9.40241,-130.35109');
  93
  94   say $red->L; # 53.23711
  95   say $red->u; # 175.00982
  96   say $red->v; # 37.76509
  97   say join ',', $blue->luv; # 32.30087,-9.40241,-130.35109
  98
  99 =head1 DESCRIPTION
 100
 101 Objects of this class represent colors in the CIE 1976 (L*, u*, v*) color space.
 102
 103 Methods:
 104
 105 =over
 106
 107 =item Convert::Color::LUV->B<new>(I<$l>, I<$u>, I<$v>)
 108
 109 Construct a color from its components.
 110
 111 =item Convert::Color::LUV->B<new>(I<"$l,$u,$v">)
 112
 113 Construct a color from a string. The string should contain the three
 114 components, separated by commas.
 115
 116 =item $luv->B<L>
 117
 118 =item $luv->B<u>
 119
 120 =item $luv->B<v>
 121
 122 Accessors for the three components of the color.
 123
 124 =item $luv->B<luv>
 125
 126 Returns the three components as a list.
 127
 128 =back
 129
 130 =head1 SEE ALSO
 131
 132 L<Convert::Color>
 133
 134 =head1 AUTHOR
 135
 136 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 137
 138 =head1 COPYRIGHT AND LICENSE
 139
 140 Copyright (C) 2015 by Marius Gavrilescu
 141
 142 This library is free software; you can redistribute it and/or modify
 143 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 144 at your option, any later version of Perl 5 you may have available.
 145
 146
 147 =cut