# ColorFunc.pm
#
# various color processing functions
# all colors are in standard:
#   00FF00 format
#
# Steve Pomeroy <steve@staticfree.info>
#######################################

use strict;

package ColorFunc;

BEGIN {
       
        use Exporter   ();
        use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

        # set the version for version checking
        $VERSION     = 1.00;

        @ISA         = qw(Exporter);
        @EXPORT      = qw( &calcFade &processColor );
        %EXPORT_TAGS = ( );     # eg: TAG => [ qw!name1 name2! ],

        # your exported package globals go here,
        # as well as any optionally exported functions
        @EXPORT_OK   = qw( );

}
use vars      @EXPORT_OK;

1;

# By Steve Pomeroy

sub calcFade { #startcolor, endcolor, percent
  (my $startcolor,my $endcolor,my $percent)=@_;
  my @maxcolor=processColor($endcolor);
  my @mincolor=processColor($startcolor); 
  my $rval=$percent * ($maxcolor[0]-$mincolor[0]) + $mincolor[0];
  my $gval=$percent * ($maxcolor[1]-$mincolor[1]) + $mincolor[1];
  my $bval=$percent * ($maxcolor[2]-$mincolor[2]) + $mincolor[2];
  my $color=sprintf("%.2x%.2x%.2x",$rval,$gval,$bval);
  return $color;
}

sub processColor{ #inputstring like "00ff00" or 0f0 or 0000ff550001
    my ( $color ) = @_;

    $color =~ s/\#//g;

    my $bits = int ( length($color) / 3 );
    #print STDERR "bits: ".$bits."\n";
    
    my ($red, $green, $blue ) = 0;
    
    if( length($color) / 3 == $bits ){
      $red    = substr($color, 0,         $bits);
      $green  = substr($color, $bits,     $bits);
      $blue   = substr($color, $bits * 2, $bits);
  }
  return ( hex($red), hex($green), hex($blue) );
}