lib/Convert/Color/LUV.pm

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