#!/usr/bin/env perl =pod =head1 NAME colorinterpolate - generate color definitions of interpolated colors suitable for color.conf =head1 SYNOPSIS # list which spaces are available colorinterpolate -listspaces # use one of the above spaces to define colors in a SPACE with # components x,y,z (e.g. RGB with r,g,b) and CALCSPACE to define # which color space we will be interpolating (default is Lab) colorinterpolate -space SPACE -calcspace CALCSPACE -start x1,y1,z1 -end x2,y2,z2 -steps STEPS =head1 DESCRIPTION The output is suitable for Circos color definitions. For example, a 20 step (21 colors) ramp from dark grey rgb(50,50,50) to pure red rgb(255,0,0) as interpolated in Lab space (default) gives the following > colorinterpolate -space rgb -start 50,50,50 -end 255,0,0 color000 = 50,50,50 # 0 deltaE 0 lab(20.8,0,-0) color001 = 72,53,47 # 1 deltaE 10.95 lab(24,8,6.8) color002 = 93,54,45 # 2 deltaE 10.95 lab(27.2,16,13.4) color003 = 113,55,42 # 3 deltaE 10.95 lab(30.6,24,20.2) color004 = 133,55,38 # 4 deltaE 10.95 lab(33.8,32,26.8) color005 = 153,54,35 # 5 deltaE 10.95 lab(37,40,33.6) color006 = 173,52,30 # 6 deltaE 10.95 lab(40.2,48,40.4) color007 = 193,48,26 # 7 deltaE 10.95 lab(43.6,56,47) color008 = 213,41,19 # 8 deltaE 10.95 lab(46.8,64,53.8) color009 = 234,29,11 # 9 deltaE 10.95 lab(50,72,60.4) color010 = 255,0,0 # 10 deltaE 10.95 lab(53.2,80,67.2) The deltaE value is the perceptual difference between the color and the previous one. This is the Euclidian distance between colors in Lab space. You can use the deltaE to verify the extent to which the color steps are perceptually uniform. If you interpolate in Lab, the steps are equal, which is what you want. If you interpolate in RGB, they are not and this is why you should not do that. > colorinterpolate -space rgb -start 50,50,50 -end 255,0,0 -steps 10 -calc rgb color000 = 50,50,50 # 0 deltaE 0 lab(20.8,0,-0) color001 = 70,45,45 # 1 deltaE 12.73 lab(21.6,11.8,4.8) color002 = 91,40,40 # 2 deltaE 13.37 lab(23.4,23.4,11.2) color003 = 112,35,35 # 3 deltaE 13.08 lab(26,33.8,18.6) color004 = 132,30,30 # 4 deltaE 12.49 lab(29.2,42.8,26.8) color005 = 152,25,25 # 5 deltaE 11.81 lab(32.8,50.6,34.8) color006 = 173,20,20 # 6 deltaE 11.05 lab(36.8,57.4,42.6) color007 = 194,15,15 # 7 deltaE 10.26 lab(40.8,63.6,49.6) color008 = 214,10,10 # 8 deltaE 9.49 lab(45,69.4,56) color009 = 234,5,5 # 9 deltaE 8.97 lab(49.2,74.8,61.8) color010 = 255,0,0 # 10 deltaE 8.64 lab(53.2,80,67.2) The last field is the color's coordinate in Lab space. =head2 SPACES RGB values should range 0-255. LAB values should be 0-100 LCH values should be 0-100 for L and C and -180-180 for H HSV values should be H=0-360, S=0-1, V=0-255. For all other spaces, see C. =head1 HISTORY =over =item * 20 October 2010 Added Lab and LCH. =item * 8 February 2010 Started. =back =head1 BUGS =head1 AUTHOR Martin Krzywinski =head1 CONTACT Martin Krzywinski Genome Sciences Centre Vancouver BC Canada www.bcgsc.ca martink@bcgsc.ca =cut ################################################################ # # Copyright 2002-2018 Martin Krzywinski # # This file is part of the Genome Sciences Centre Perl code base. # # This script is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This script is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this script; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # ################################################################ use strict; use Config::General; use Data::Dumper; use File::Basename; use FindBin; use Getopt::Long; use IO::File; use Math::Round qw(nearest); use Graphics::ColorObject; use Pod::Usage; use lib "$FindBin::RealBin"; use lib "$FindBin::RealBin/../lib"; use lib "$FindBin::RealBin/lib"; use vars qw(%OPT %CONF); ################################################################ # # *** YOUR MODULE IMPORTS HERE # ################################################################ GetOptions(\%OPT, "rootname=s", "listspaces", "space=s", "calcspace=s", "start=s", "end=s", "steps=i", "configfile=s","help","man","debug+"); pod2usage() if $OPT{help}; pod2usage(-verbose=>2) if $OPT{man}; loadconfiguration($OPT{configfile}); populateconfiguration(); # copy command line options to config hash validateconfiguration(); if($CONF{debug} && $CONF{debug} > 1) { $Data::Dumper::Pad = "debug parameters"; $Data::Dumper::Indent = 1; $Data::Dumper::Quotekeys = 0; $Data::Dumper::Terse = 1; print Dumper(\%CONF); } sub validateconfiguration { $CONF{space} ||= "rgb"; $CONF{steps} ||= 20; $CONF{start} ||= "255,0,0"; $CONF{end} ||= "0,0,255"; } if($CONF{listspaces} || ! $CONF{fn}{ $CONF{space} } || ! $CONF{fn}{ $CONF{calcspace} }) { printinfo("The -space you chose [$CONF{space}] is not defined.") if ! $CONF{fn}{ $CONF{space} }; printinfo("The -calcspace you chose [$CONF{calcspace}] is not defined.") if ! $CONF{fn}{ $CONF{calcspace} }; printinfo("The following color spaces are available:"); printinfo(sort keys %{$CONF{fn}}); exit; } #_START my $c1 = color2space([split(",",$CONF{start})],$CONF{space},$CONF{calcspace}); my $c2 = color2space([split(",",$CONF{end})],$CONF{space},$CONF{calcspace}); my $interpolated; my $cintlabprev; for my $i (0..$CONF{steps}) { my $cint = [interpvalue($c1->[0],$c2->[0],$i,$CONF{steps}), interpvalue($c1->[1],$c2->[1],$i,$CONF{steps}), interpvalue($c1->[2],$c2->[2],$i,$CONF{steps})]; my $cout = color2space($cint,$CONF{calcspace},$CONF{space}); my $cintlab = color2space($cint,$CONF{calcspace},"lab"); my $de = $cintlabprev ? sqrt( ($cintlab->[0]-$cintlabprev->[0])**2 + ($cintlab->[1]-$cintlabprev->[1])**2 + ($cintlab->[2]-$cintlabprev->[2])**2) : 0; push @$interpolated, {components=> ref $cout eq "ARRAY" ? [ map { nearest($CONF{nearest},$_) } @$cout ] : $cout, i=>$i, de=>$de, lab=> $cintlab, name=>sprintf("%s%03d",$CONF{rootname},$i)}; $cintlabprev = $cintlab; } for my $c (@$interpolated) { printinfo(sprintf("%s = %9s # rgb %9s rgbhex %s idx %3d deltaE %6.2f lab(%s,%s,%s)", $c->{name}, ref $c->{components} eq "ARRAY" ? sprintf("%d,%d,%d",@{$c->{components}}) : $c->{components}, sprintf("%d,%d,%d",lab2rgb(@{$c->{lab}})), rgb2hex(lab2rgb(@{$c->{lab}})), $c->{i}, nearest(0.01,$c->{de}), (map { nearest(0.2,$_) } @{$c->{lab}}))); } sub color2space { my ($components,$from,$to) = @_; my $fnfrom = sprintf("new_%s",$CONF{fn}{$from}); my $fnto = sprintf("as_%s",$CONF{fn}{$to}); my $c = $from =~ /hex/ ? Graphics::ColorObject->$fnfrom($components->[0]) : Graphics::ColorObject->$fnfrom($components); my $cout = $c->$fnto(); printdebug("converting",@$components,"from",$from,"to",$to,item2list($cout)); return $cout; } sub interpvalue { my ($start,$end,$step,$steps) = @_; return $start + $step*($end-$start)/$steps; } sub item2list { my $x = shift; return ref $x eq "ARRAY" ? @$x : $x; } sub rgb2hsv { my @c = @_; my $c = Graphics::ColorObject->new_RGB([@c]); my @nc = @{$c->as_HSV()}; printinfo(@c,@nc); return @nc; } sub hsv2rgb { my @c = @_; my $c = Graphics::ColorObject->new_HSV([@c]); return @{$c->as_RGB()}; } sub rgb2hex { my @c = @_; my $c = Graphics::ColorObject->new_RGB255([@c]); return $c->as_RGBhex(); } sub lab2rgb { my @c = @_; my $c = Graphics::ColorObject->new_Lab([@c]); return @{$c->as_RGB255()}; } #_END ################################################################ # # *** DO NOT EDIT BELOW THIS LINE *** # ################################################################ sub populateconfiguration { foreach my $key (keys %OPT) { $CONF{$key} = $OPT{$key}; } # any configuration fields of the form __XXX__ are parsed and replaced with eval(XXX). The configuration # can therefore depend on itself. # # flag = 10 # note = __2*$CONF{flag}__ # would become 2*10 = 20 for my $key (keys %CONF) { my $value = $CONF{$key}; while($value =~ /__([^_].+?)__/g) { my $source = "__" . $1 . "__"; my $target = eval $1; $value =~ s/\Q$source\E/$target/g; #printinfo($source,$target,$value); } $CONF{$key} = $value; } } sub loadconfiguration { my $file = shift; my ($scriptname) = fileparse($0); if(-e $file && -r _) { # great the file exists } elsif (-e "/home/$ENV{LOGNAME}/.$scriptname.conf" && -r _) { $file = "/home/$ENV{LOGNAME}/.$scriptname.conf"; } elsif (-e "$FindBin::RealBin/$scriptname.conf" && -r _) { $file = "$FindBin::RealBin/$scriptname.conf"; } elsif (-e "$FindBin::RealBin/etc/$scriptname.conf" && -r _) { $file = "$FindBin::RealBin/etc/$scriptname.conf"; } elsif (-e "$FindBin::RealBin/../etc/$scriptname.conf" && -r _) { $file = "$FindBin::RealBin/../etc/$scriptname.conf"; } else { return undef; } $OPT{configfile} = $file; my $conf = new Config::General(-ConfigFile=>$file, -AllowMultiOptions=>"yes", -LowerCaseNames=>1, -AutoTrue=>1); %CONF = $conf->getall; } sub printdebug { printinfo("debug",@_) if $CONF{debug}; } sub printinfo { printf("%s\n",join(" ",@_)); } sub printdumper { printf(Dumper(@_)); }