use Color::Calc;

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

print "contrasted RGB = @rgb\n";

__output__

contrasted RGB = ff 00 ff
[download]

_________
broquaint

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";
}
[download]

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.

#! 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";
}
[download]

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
    );
}
[download]