in reply to Re: Hex color degrader
in thread Hex color degrader

Agreed. That makes perfect sense. However, why not take it one step further and make the function darken or lighten as required. 

#! perl -sw
use strict;
local $\=$/;

sub Dlighken {
  return sprintf '%02x'x3,
      map{ ($_ *= 1+$_[1]) > 0xff ? 0xff : $_  }
      map hex, unpack 'A2'x3, $_[0];
}

my @colors = qw/800000 808000 008000 008080 000080 808080 c0c0c0/;

print '<table>';
print '<tr><td>&nbsp;</td>', map{ 
    '<th>'.$_.'</th>' 
} @colors, '</tr>'; 

for my $scale ( -5 .. +5 ) {
    print '<tr><td>'.($scale/10).'</td>';
    print '<td bgcolor="#', $_, '">', $_, '</td>' 
        for map{ Dlighken($_, $scale/10) } @colors;
    print '</tr>';
}
print '</table>';
__END__

[download]

renders as
 800000808000008000008080000080808080c0c0c0
-0.5 400000 404000 004000 004040 000040 404040 606060
-0.4 4c0000 4c4c00 004c00 004c4c 00004c 4c4c4c 737373
-0.3 590000 595900 005900 005959 000059 595959 868686
-0.2 660000 666600 006600 006666 000066 666666 999999
-0.1 730000 737300 007300 007373 000073 737373 acacac
0 800000 808000 008000 008080 000080 808080 c0c0c0
0.1 8c0000 8c8c00 008c00 008c8c 00008c 8c8c8c d3d3d3
0.2 990000 999900 009900 009999 000099 999999 e6e6e6
0.3 a60000 a6a600 00a600 00a6a6 0000a6 a6a6a6 f9f9f9
0.4 b30000 b3b300 00b300 00b3b3 0000b3 b3b3b3 ffffff
0.5 c00000 c0c000 00c000 00c0c0 0000c0 c0c0c0 ffffff

Cor! Like yer ring! ... HALO dammit! ... 'Ave it yer way! Hal-lo, Mister la-de-da. ... Like yer ring!

Replies are listed 'Best First'.
Re^3: Hex color degrader
by Aristotle (Chancellor) on Oct 13, 2002 at 16:48 UTC
    Not a bad point, but I'd stick to having a brightness value passed, not a scaling factor. It's a bit easier to have a rough idea of the outcome that way IMO. 
    sub add_to_hexrgb {
    my @rgb = map hex, unpack "A2"x3, $_[0];
    my $max = (sort {$a <=> $b} @rgb)[-1];
    my $smax = $max + $_[1];

    return
        $smax < 0 ? "000000" :
        $smax > 255 ? "FFFFFF" :
        do {
            my $fact = ($max + $sumd) / $max;
            sprintf "%02X"x3, map { int($_ * $fact) } @rgb
        };
}

    [download]

    Makeshifts last the longest.

[reply]
[d/l]

In Section Cool Uses for Perl