Pathologically Eclectic Rubbish Lister PerlMonks

### Contrasting Colours

by msemtd (Scribe)
 on May 29, 2003 at 14:55 UTC Need Help??

msemtd has asked for the wisdom of the Perl Monks concerning the following question:

Hi people,
I'm seeking a function that given a colour as an rgb tuple, will return one or more suitably contrasting colours. I did some work on this some years ago and gave up, lost in the maths for rgb, hsv, and hsl colourspace conversion. I'm assuming that by now there is a nice module to do this for me but I just can't find anything out there that works.
Thanks for your time!

Replies are listed 'Best First'.
Re: Contrasting Colours
by broquaint (Abbot) on May 29, 2003 at 15:26 UTC
Sounds like color_contrast_hex from Color::Calc would be suited
```use Color::Calc;

my \$colour = 'green';
my @rgb    = color_contrast_hex(\$colour) =~ /(..)/g;

print "contrasted RGB = @rgb\n";

__output__

contrasted RGB = ff 00 ff

HTH

_________
broquaint

Re: Contrasting Colours
by tall_man (Parson) on May 29, 2003 at 15:21 UTC
Inverting the RGB value (i.e. subtracting each color value from the maximum value) would give a quick-and-dirty contrasting color.

There is also a module Color::Calc that supplies contrast, mix and blend functions.

Subtracting from the max starts breaking down the closer your color is to "the middle" -- 80 80 80.
Hi, thanks, I took a look at Color::Calc and some old code by Ho-Sheng Hsiao dated 1998-07-07 and came up with the following which seems to work pretty well...
```# given a colour in the form "#ff00ff" i.e. hex rrggbb, return a contr
+asting colour
sub contrast_colour {
my \$col = shift;
# Need rgb values for colour...
if ( not \$col =~ /^#(..)(..)(..)\$/ ) {
warn "failed to convert colour '\$col' to rgb components\n";
return;
}
my ( \$r, \$g, \$b ) = ( hex(\$1), hex(\$2), hex(\$3) );
#~ print "RGB= \$r, \$g, \$b\n";
# here's an idea! simple contrast solution...
my %oppcolors = (
"00" => "FF",
"33" => "FF",
"66" => "FF",
"99" => "FF",
"CC" => "00",
"FF" => "00",
);
\$r = int( \$r / 51 ) * 51;
\$g = int( \$g / 51 ) * 51;
\$b = int( \$b / 51 ) * 51;
#~ print "RGB rounded = \$r, \$g, \$b\n";
\$r = \$oppcolors{ sprintf( "%02X", \$r ) };
\$g = \$oppcolors{ sprintf( "%02X", \$g ) };
\$b = \$oppcolors{ sprintf( "%02X", \$b ) };
#~ print "RGB inverted = \$r, \$g, \$b\n";
return "#\$r\$g\$b";
}
Re: Contrasting Colours
by TomDLux (Vicar) on May 29, 2003 at 16:04 UTC

Option 1 - maximum contrast for black and white, fading to no contrast for middle gray: For each component, R, G, & B, subtract the current value from 255. reassamble into a colour - there's your complementary colour. If you haven't defined the format for a tuple, yet, I suggest using anonymous arrays. In any case, you'll need routines to do format conversions.

Option 2 - less, but reasonable contrast for all values. Add half the range, 128, to each of R, G, B, rolling over values that go out of range. Black and white both go to middle grey, middle grey goes to white

Option 3 - Modify each of R, G, B by a varying amount, between 1/3 and 2/3 full range. As a consequence, looking for ten contrasting colours for black would generate ten different colours between dark grey and light grey, providing some degree of actual colour as well as monochrome. This provides fair contrast, but no repeatability.

Re: Contrasting Colours
by Anonymous Monk on May 29, 2003 at 20:53 UTC
OK, I've tidied up my first draft and added a little Tk testing toy. The contrasting colours returned tend toward the lighter but the hash is easily tweaked.
```#! perl
use strict;
use warnings;
use Tk;
my \$title = "colour contrast";
my \$mw    = new MainWindow( -title => \$title );
my \$fr    = \$mw->Frame()->pack;
for ( 1 .. 5 ) {
my \$b = \$fr->Button( -text => "Colour \$_", )->pack;
\$b->configure( -command => [ \&pick_n_mix, \$b ] );
}
MainLoop();

sub pick_n_mix {
my (\$btn) = @_;
my \$old = \$btn->cget( -bg );
my \$col = \$mw->chooseColor(
-title        => "Choose a nice colour...",
-initialcolor => \$old
);
return unless \$col;
\$btn->configure( -bg => \$col, -activebackground => \$col );
# Choose some contrasting colours...
my \$fg = contrast_colour(\$col);
\$btn->configure(
-bg               => \$col,
-activebackground => \$col,
-fg               => \$fg,
-activeforeground => \$fg
);
}
# given a colour in the form "#ff00ff" i.e. hex rrggbb, return a
# contrasting colour
sub contrast_colour {
my \$col = shift;
# Need rgb values for colour...
if ( not \$col =~ /^#(\w\w)(\w\w)(\w\w)\$/ ) {
warn "failed to convert colour '\$col' to rgb components\n";
return;
}
my ( \$r, \$g, \$b ) = map hex, ( \$1, \$2, \$3 );
# Use a hash of contrasting values for the "websafe pallette"
# with emphasis on lighter colours...
my %opp = qw(00 FF 33 FF 66 FF 99 FF CC 00 FF 00 );
# Round each value down to a multiple of hex 33 (i.e. 51)...
map { \$_ = int( \$_ / 51 ) * 51 } ( \$r, \$g, \$b );
# Replace each value with a contrasting value from the hash...
map { \$_ = \$opp{ sprintf "%02X", \$_ } } ( \$r, \$g, \$b );
return "#\$r\$g\$b";
}
BTW: that was me posting without logging in - oops!

I seem to have added an extra configure in there - the pick_n_mix callback now reads...

```sub pick_n_mix {
my (\$btn) = @_;
my \$old = \$btn->cget( -bg );
my \$col = \$mw->chooseColor(
-title        => "Choose a nice colour...",
-initialcolor => \$old
);
return unless \$col;
# Choose a contrasting colour for text...
my \$fg = contrast_colour(\$col);
\$btn->configure(
-bg               => \$col,
-activebackground => \$col,
-fg               => \$fg,
-activeforeground => \$fg
);
}

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://261561]
Approved by sschneid
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (4)
As of 2023-06-08 18:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
How often do you go to conferences?

Results (35 votes). Check out past polls.

Notices?