Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Color Space Converter

by js29a (Chaplain)
on Jun 13, 2005 at 15:11 UTC ( [id://466191]=sourcecode: print w/replies, xml ) Need Help??
Category: utility scripts
Author/Contact Info jacek s., js29a@ceti.pl
Description: Converts between HSL and RGB, between RGB and HSL, CMY and RGB, XYZ and RGB. Three elements array or ref to hash input and output. Input and output values are normalized to 0.0 - 1.0 range. Input variables are asserted. 

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
Replies are listed 'Best First'.
Re: Color Space Converter
by jeffa (Bishop) on Jun 13, 2005 at 19:30 UTC

    Nice, but did you know about Color::Spectrum? extremely wrote the code, i just gave it a home. :)

    If you look in the source, you will see there are methods for RGB-HSL(I) converstions that do the job with far fewer lines of code. I should update the POD to document those as well ... anyways, check it out. Might give some ideas for refactoring.

    jeffa

    L-LL-L--L-LL-L--L-LL-L--
-R--R-RR-R--R-RR-R--R-RR
B--B--B--B--B--B--B--B--
H---H---H---H---H---H---
(the triplet paradiddle with high-hat)
[reply]
    466438
    by js29a (Chaplain) on Jun 14, 2005 at 09:09 UTC
    		[reply]

    Back to Code Catacombs

    Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?

    www.com | www.net | www.org
    Node Status?
    node history
    Node Type: sourcecode [id://466191]
    help
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? • Last hour • Other CB clients
    Other Users?
    Others contemplating the Monastery: (5)
    As of 2024-04-19 13:23 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found