package col_space;

use strict;
use warnings;

use Exporter;

our @ISA=qw/Exporter/;

our @EXPORT=qw/rgb_to_hsl rgb_to_hsv rgb_to_cmy rgb_to_xyz
               hsl_to_rgb hsv_to_rgb cmy_to_rgb xyz_to_rgb/;

sub min3($$$){
  my $res=$_[0];
  $res=$_[1] if $res > $_[1];
  $res=$_[2] if $res > $_[2];
  $res;
}

sub max3($$$){
  my $res=$_[0];
  $res=$_[1] if $res < $_[1];
  $res=$_[2] if $res < $_[2];
  $res;
}

sub hue_2_rgb($$$){
   my ($v1,$v2,$vh)=@_;

   $vh+=1.0 if $vh < 0.0;
   $vh-=1.0 if $vh > 1.0;

   return $v1 + ($v2 - $v1) * 6.0 * $vh if 6.0 * $vh < 1;
   return $v2                           if 2.0 * $vh < 1;
   return $v1 + ($v2 - $v1) * ((2.0/3.0) - $vh)*6.0 if 3.0 * $vh < 2;
   return $v1;
}

sub rgb_to_hsl {
  return unless defined wantarray;

  my ($r,$g,$b);
  my ($h,$s,$l)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($r,$g,$b)=($_[0]->{R},$_[0]->{G},$_[0]->{B});
  }else{
    ($r,$g,$b)=@_;
  }

  if($r<0 || $r>1
  || $g<0 || $g>1
  || $b<0 || $b>1){
    die "bad input for rgb_to_hsl: $r $g $b";
  }

  my $var_Min = min3($r,$g,$b);
  my $var_Max = max3($r,$g,$b);
  my $del_Max = $var_Max - $var_Min;

  $l = ( $var_Max + $var_Min ) / 2.0;

  if( $del_Max == 0.0 ){
    $h=$s=0.0;
  }else{
    $s=$del_Max / (2.0 - $var_Max - $var_Min);
    $s=$del_Max / ($var_Max + $var_Min) if $l <  0.5;

    my $del_R=( ( ( $var_Max - $r ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $
+del_Max;
    my $del_G=( ( ( $var_Max - $g ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $
+del_Max;
    my $del_B=( ( ( $var_Max - $b ) / 6.0 ) + ( $del_Max / 2.0 ) ) / $
+del_Max;

    if    ( $r == $var_Max ) {$h = $del_B - $del_G }
    elsif ( $g == $var_Max ) {$h = ( 1.0 / 3.0 ) + $del_R - $del_B}
    elsif ( $b == $var_Max ) {$h = ( 2.0 / 3.0 ) + $del_G - $del_R};

    $h+=1.0 if $h < 0;
    $h-=1.0 if $h > 1.0;
  }

  return ($h,$s,$l) if wantarray;

  return {H=>$h, S=>$s, L=>$l};
}

sub hsl_to_rgb {
  return unless defined wantarray;

  my ($h,$s,$l);
  my ($r,$g,$b)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($h,$s,$l)=($_[0]->{H},$_[0]->{S},$_[0]->{L});
  }else{
    ($h,$s,$l)=@_;
  }

  if($h<0 || $s>1
  || $s<0 || $h>1
  || $l<0 || $l>1){
    die "bad input for hsl_to_rgb $h $s $l";
  }

  my ($var_1,$var_2);

  if (!$s){
      $r=$g=$b=$l;
  }else{
      if( $l < 0.5 ){ $var_2 = $l * ( 1 + $s ); }
      else          { $var_2 = ( $l + $s ) - ( $s * $l ) };

      $var_1 = 2.0 * $l - $var_2;

      $r = hue_2_rgb( $var_1, $var_2, $h + ( 1.0 / 3.0 ) ) ;
      $g = hue_2_rgb( $var_1, $var_2, $h );
      $b = hue_2_rgb( $var_1, $var_2, $h - ( 1.0/ 3.0 ) );
  }

  return ($r,$g,$b) if wantarray;

  return {R=>$r, G=>$g, B=>$b};
}

sub rgb_to_hsv {
  return unless defined wantarray;

  my ($r,$g,$b);
  my ($h,$s,$v)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($r,$g,$b)=($_[0]->{R},$_[0]->{G},$_[0]->{B});
  }else{
    ($r,$g,$b)=@_;
  }

  if($r<0 || $r>1
  || $g<0 || $g>1
  || $b<0 || $b>1){
    die "bad input for rgb_to_hsv: $r $g $b";
  }

  my $var_Min = min3($r,$g,$b);
  my $var_Max = max3($r,$g,$b);
  my $del_Max = $var_Max - $var_Min;

  $v=$var_Max;

  if ( !$del_Max){
    $h=$s=0.0;
  }else{
    $s = $del_Max / $var_Max;

    my $del_R = ( ( ( $var_Max - $r ) / 6.0 ) + ( $del_Max / 2.0 ) ) /
+ $del_Max;
    my $del_G = ( ( ( $var_Max - $g ) / 6.0 ) + ( $del_Max / 2.0 ) ) /
+ $del_Max;
    my $del_B = ( ( ( $var_Max - $b ) / 6.0 ) + ( $del_Max / 2.0 ) ) /
+ $del_Max;

    if    ( $r == $var_Max ) { $h = $del_B - $del_G; }
    elsif ( $g == $var_Max ) { $h = ( 1.0 / 3.0 ) + $del_R - $del_B; }
    elsif ( $b == $var_Max ) { $h = ( 2.0 / 3.0 ) + $del_G - $del_R; }
    else  { die 'internal failure'; }

    $h+=1.0 if $h < 0.0;
    $h-=1.0 if $h > 1.0;
  }

  return ($h,$s,$v) if wantarray;

  return {H=>$h, S=>$s, V=>$v};
}

sub hsv_to_rgb {
  return unless defined wantarray;

  my ($h,$s,$v);
  my ($r,$g,$b)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($h,$s,$v)=($_[0]->{H},$_[0]->{S},$_[0]->{V});
  }else{
    ($h,$s,$v)=@_;
  }

  if($h<0 || $h>1
  || $s<0 || $s>1
  || $v<0 || $v>1){
    die "bad input for hsv_to_rgb: $h $s $v";
  }

  if ( !$s ){
      $r=$g=$b=$v;
  }else{
      my $var_h = $h * 6.0;
      my $var_i =int $var_h;

      my $var_1 = $v * ( 1 - $s );
      my $var_2 = $v * ( 1 - $s * ( $var_h - $var_i ) );
      my $var_3 = $v * ( 1 - $s * ( 1 - ( $var_h - $var_i ) ) );

      if    ( $var_i == 0 ) { $r = $v     ; $g = $var_3 ; $b = $var_1;
+ }
      elsif ( $var_i == 1 ) { $r = $var_2 ; $g = $v     ; $b = $var_1;
+ }
      elsif ( $var_i == 2 ) { $r = $var_1 ; $g = $v     ; $b = $var_3;
+ }
      elsif ( $var_i == 3 ) { $r = $var_1 ; $g = $var_2 ; $b = $v    ;
+ }
      elsif ( $var_i == 4 ) { $r = $var_3 ; $g = $var_1 ; $b = $v    ;
+ }
      elsif ( $var_i == 5 ) { $r = $v     ; $g = $var_1 ; $b = $var_2;
+ }
      else  { die 'internal failure'; }
  }

  return ($r,$g,$b) if wantarray;

  return {R=>$r, G=>$g, B=>$b};
}

sub rgb_to_cmy {
  return unless defined wantarray;

  my ($c,$m,$y);
  my ($r,$g,$b)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($r,$g,$b)=($_[0]->{R},$_[0]->{G},$_[0]->{B});
  }else{
    ($r,$g,$b)=@_;
  }

  if($r<0 || $r>1
  || $g<0 || $g>1
  || $b<0 || $b>1){
    die "bad input for rgb_to_cmy $r $g $b";
  }
  
  ($c,$m,$y)=(1-$r,1-$g,1-$b);

  return ($c,$m,$y) if wantarray;

  return {C=>$r, M=>$g, Y=>$b};
}

sub cmy_to_rgb {
  return unless defined wantarray;

  my ($c,$m,$y);
  my ($r,$g,$b)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($c,$m,$y)=($_[0]->{C},$_[0]->{M},$_[0]->{Y});
  }else{
    ($c,$m,$y)=@_;
  }

  if($c<0 || $c>1
  || $m<0 || $m>1
  || $y<0 || $y>1){
    die "bad input for cmy_to_rgb $c $m $y";
  }

  ($r,$g,$b)=(1-$c,1-$m,1-$y);

  return ($r,$g,$b) if wantarray;

  return {R=>$r, G=>$g, B=>$b};
}

sub rgb_to_xyz {
  return unless defined wantarray;

  my ($x,$y,$z);
  my ($r,$g,$b)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($r,$g,$b)=($_[0]->{R},$_[0]->{G},$_[0]->{B});
  }else{
    ($r,$g,$b)=@_;
  }

  if($r<0 || $r>1
  || $g<0 || $g>1
  || $b<0 || $b>1){
    die "bad input for rgb_to_xyz $r $g $b";
  }

  if ( $r > 0.04045 ) {$r = ( ( $r + 0.055 ) / 1.055 ) ** 2.4 }
  else                 {  $r = $r / 12.92 }
  if ( $g > 0.04045 ) {$g = ( ( $g + 0.055 ) / 1.055 ) ** 2.4 }
  else                 {  $g = $g/ 12.92 }
  if ( $b > 0.04045 ) {$b = ( ( $b + 0.055 ) / 1.055 ) ** 2.4 }
  else                {   $b = $b / 12.92 }

  $x = $r * 0.4124 + $g * 0.3576 + $b * 0.1805;
  $y = $r * 0.2126 + $g * 0.7152 + $b * 0.0722;
  $z = $r * 0.0193 + $g * 0.1192 + $b * 0.9505;

  return ($x,$y,$z) if wantarray;

  return {X=>$x, Y=>$y, Z=>$z};
}

sub xyz_to_rgb {
  return unless defined wantarray;

  my ($r,$g,$b);
  my ($x,$y,$z)=(0,0,0);

  if(ref $_[0] eq 'HASH'){
    ($x,$y,$z)=($_[0]->{X},$_[0]->{Y},$_[0]->{Z});
  }else{
    ($x,$y,$z)=@_;
  }

  $r = $x *  3.2406 + $y * -1.5372 + $z * -0.4986;
  $g = $x * -0.9689 + $y *  1.8758 + $z *  0.0415;
  $b = $x *  0.0557 + $y * -0.2040 + $z *  1.0570;

  if ( $r > 0.0031308 ) {$r = 1.055 * ( $r ** ( 1 / 2.4 ) ) - 0.055}
  else                  {$r = 12.92 * $r}

  if ( $g > 0.0031308 )  { $g = 1.055 * ( $g ** ( 1 / 2.4 ) ) - 0.055}
  else                    { $g = 12.92 * $g }

  if ( $b > 0.0031308 ) { $b = 1.055 * ( $b ** ( 1 / 2.4 ) ) - 0.055}
  else                  {   $b = 12.92 * $b }

  return ($r,$g,$b) if wantarray;

  return {R=>$r, G=>$g, B=>$b};
}

1;

__END__

=head1 NAME

col_space - Color space conversions

=head1 SYNOPSIS

  # array i/o
  my ($r,$g,$b)=hsv_to_rgb(0.5,1.0,0.3);

  # scalar i/o
  my $c=hsv_to_rgb({H => 0.5,S => 1.0,V => 0.3})
  print $c->{H}.' '.$c->{S}.' '.$c->{V};

  # array i/o can be mixed w/scalar i/o

  rgb_to_hsl, hsl_to_rgb,
  rgb_to_hsv, hsv_to_rgb,
  rgb_to_cmy, cmy_to_rgb,
  rgb_to_xyz, xyz_to_rgb

=head1 DEFINITIONS

=over 8

=item RGB

red - green - blue color space

=item HSL

hue - saturation - lightness color space

=item HSV

hue - saturation - value color space

=item CMY

cyan - magenta - yellow color space

=back

=head1 DESCRIPTION

Converts between HSL and RGB, HSV and RGB, CMY and RGB.

Three elements array or ref to hash input and output.

Input and output values are B<normalized to [0.0,1.0] range>. Input is
+ asserted.

=head1 AUTHOR

Author: Jacek S. (js29a@ceti.pl).

=cut

[download]

In reply to Color Space Converter by js29a

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.