#!/usr/local/bin/perl
# readbl.pl - Generate readable colors and relative luminance charts
# Copyright 2015 David Meyer <papa@sdf.org> +JMJ
# (License and documentation at bottom of file.)
# Source: Ben Caldwell et al. ed. Web Content Accessibility
# Guidelines (WCAG) 2.0. World Wide Web Consortium (W3C).
# December 11, 2008.
# <http://www.w3.org/TR/2008/REC-WCAG20-20081211/>
# accessed January 7, 2015.
use strict;
use warnings;
our @cval = (0, 51, 102, 153, 204, 255); # "Web-safe" palette
#our @cval = (0, 255);
our %bytesc = (
0 => 0,
51 => 3,
102 => 6,
153 => 9,
204 => 12,
255 => 15
);
our(@color, %cr, %cg, %cb, %rlumin);
sub bright {
my($r, $g, $b) = @_;
return ($r * 299 + $g * 587 + $b * 114) / 1000;
}
# chex2rgb - Argument is hexadecimal string in format "#RRGGBB" or "#RGB", returns array of integers (r, g, b)
sub chex2rgb {
my($chex) = @_;
my($r, $g, $b);
if (length($chex) == 4) {
$r = hex substr($chex, 1, 1);
$g = hex substr($chex, 2, 1);
$b = hex substr($chex, 3, 1);
return ($r*16+$r, $g*16+$g, $b*16+$b);
}
elsif (length($chex) == 7) {
$r = hex substr($chex, 1, 2);
$g = hex substr($chex, 3, 2);
$b = hex substr($chex, 5, 2);
return ($r, $g, $b);
}
else {
die "Invalid format in chex2rgb(): $chex";
}
}
sub colorsc {
my($r, $g, $b) = @_;
return sprintf("#%x%x%x", $bytesc{$r}, $bytesc{$g}, $bytesc{$b});
}
sub lumc {
my($c) = @_;
my $cn = $c/255;
if ($cn <= .03928) {return $cn/12.92;}
else {return (($cn+.055)/1.055)**2.4;}
}
sub max {
my($a, $b) = @_;
if ($a < $b) {return $b;}
else {return $a;}
}
sub rlumin {
my($r, $g, $b) = @_;
return .2126 * lumc($r) + .7152 * lumc($g) + .0722 * lumc($b);
}
our($r, $g, $b);
for $r (@cval) {
for $g (@cval) {
for $b (@cval) {
my $colorsc = colorsc($r, $g, $b);
push @color, $colorsc;
$cr{$colorsc} = $r;
$cg{$colorsc} = $g;
$cb{$colorsc} = $b;
$rlumin{$colorsc} = rlumin($r, $g, $b);
}
}
}
our @lcolor = sort {$rlumin{$a} <=> $rlumin{$b}} @color;
print "<body style='background-color:#555;color:#fff;'>\n";
print "<h2>Readable Color Combinations (by hue/brightness difference)</h2>\n<table>\n<tr><th>BG<br/>color</th><td colspan=3>Text color<br/>Hue difference<br/>Brightness diff.</td></tr>";
# $bgr, $bgg, $bgb: Background red, green, blue
# $fgr, $fgg, $fgb: Foreground red, green, blue
my %combos = (
cr3a => 0,
cr2a => 0,
hdbd => 0
);
my %output = (
cr3a => "<table>\n",
cr2a => "<table>\n",
hdbd => "<table>\n"
);
my %bgprev = (
cr3a => "",
cr2a => "",
hdbd => ""
);
my $bgcd_prev = "";
for my $bg (@lcolor) {
my $bgr = $cr{$bg}; my $bgg = $cg{$bg}; my $bgb = $cb{$bg};
my $bgcd = colorsc($bgr, $bgg, $bgb);
for my $fg (@lcolor) {
my $fgr = $cr{$fg}; my $fgg = $cg{$fg}; my $fgb = $cb{$fg};
my $fgcd = colorsc($fgr, $fgg, $fgb);
# Contrast ratio ...
my $rlbg = $rlumin{$bgcd};
my $rlfg = $rlumin{$fgcd};
my $cr = $rlfg > $rlbg ?
($rlfg+.05)/($rlbg+.05) :
($rlbg+.05)/($rlfg+.05);
# Hue difference ...
my $hd = max($fgr-$bgr, $bgr-$fgr) +
max($fgg-$bgg, $bgg-$fgg) +
max($fgb-$bgb, $bgb-$fgb);
# Brightness difference ...
my $bd = abs(bright($fgr, $fgg, $fgb) -
bright($bgr, $bgg, $bgb));
# Readability ...
my $readable;
if ($hd >= 500 && $bd >= 125) {$readable = 1;}
else {$readable = 0;}
if ($readable) {
if ($bgcd ne $bgcd_prev) {
print "</tr>\n<tr><th>$bgcd</th>\n";
$bgcd_prev = $bgcd;
}
printf("<td style='background-color:%s;color:%s'>%s<br/>%d %d</td>\n", $bgcd, $fgcd, $fgcd, $hd, $bd);
++ $combos;
}
}
}
print <<EOF;
</tr>
</table>
<p>$combos combinations</p>
EOF
print "<h2>Relative Luminance Scale</h2>\n<ol>\n";
for my $c (@lcolor) {
my $fg = $rlumin{$c} < .35 ? '#fff' : '#000';
print "<li style='background-color:$c;margin:2px;padding:10px;'><span style='color:$fg;'>$c $rlumin{$c}</span></li>\n";
}
print "</ol>\n</body>\n";
exit 0
__END__
# Documentation #####################################################
=head1 NAME
template.pl - Perl script template (command line)
=head1 SYNOPSIS/USAGE
=head1 DESCRIPTION
Mark up code elements with C<>, file names with F<> (or C<> for
readability), command names with B<>. Also I<> for italics, U<> for
underline. Entities: E<lt> ('<'), E<gt> ('>').
=head1 OPTIONS
=item B<-o> I<value>, B<--option>=I<value>
=head1 RETURN VALUE
=head1 ERRORS
=head1 DIAGNOSTICS
=head1 EXAMPLES
=head1 ENVIRONMENT
=over 6
=item VARIABLE
Description of usage of environment variable C<VARIABLE>.
=back
=head1 FILES
=head1 BUGS, LIMITATIONS, AND CAVEATS
=head1 NOTES
=head1 AUTHOR
David Meyer <papa@sdf.org>
=head1 HISTORY
=head1 COPYRIGHT AND LICENSE
Copyright 201x David Meyer
=head1 SEE ALSO
# Emacs control #####################################################
#Local variables:
#mode: perl
#End: