#!/usr/local/bin/perl -w
use CGI;
my $cgi = new CGI();
my $scheme = $cgi->param("scheme") || 'bad';
sub myint {
my ($x) = @_;
return sprintf("%d", $x + 0.5);
}
sub percent_white {
my ($r, $g, $b, $white) = @_;
my $non_white = 1 - $white;
return sprintf("%02x%02x%02x",
myint($r * $non_white + 255 * $white),
myint($g * $non_white + 255 * $white),
myint($b * $non_white + 255 * $white));
}
sub percent_black {
my ($r, $g, $b, $white) = @_;
my $non_white = 1 - $white;
return sprintf("%02x%02x%02x",
myint($r * $non_white),
myint($g * $non_white),
myint($b * $non_white));
}
sub graukeil20 {
my $r = shift @_;
my $g = shift @_;
my $b = shift @_;
my @acc = ();
my @acc2= ();
foreach $percent (0, 0.2, 0.4, 0.6, 0.8){
push @acc, percent_white($r,$g,$b, $percent);
}
foreach $percent (0.2, 0.4, 0.6, 0.8){
push @acc2, percent_black($r,$g,$b, $percent);
}
return [(reverse @acc2), @acc];
}
sub graukeil25 {
my $r = shift @_;
my $g = shift @_;
my $b = shift @_;
my @acc = ();
my @acc2= ();
foreach $percent (0, 0.25, 0.5, 0.75){
push @acc, percent_white($r,$g,$b, $percent);
}
foreach $percent (0.25, 0.5, 0.75){
push @acc2, percent_black($r,$g,$b, $percent);
}
return [(reverse @acc2), @acc];
}
my $schemes = {
bad => [['000000', 'FFFFFF', '285169', 'AFD21D', 'E93313'],
['C2CCCF', 'CED6D9', 'DAE0E2', 'E7EBEC', 'F3F5F5']],
all20 => [
graukeil20(194, 204, 207),
graukeil20(40, 81, 105),
graukeil20(175, 210, 29),
graukeil20(233, 51, 19),
],
all25 => [
graukeil25(194, 204, 207),
graukeil25(40, 81, 105),
graukeil25(175, 210, 29),
graukeil25(233, 51, 19),
],
BAD => [['000000', '005673', 'B3E600'],
['FFFFFF', 'CFDEE6', 'FFA800']],
BADxx => [['000000', '005673', '015A6F', 'B3E600'],
['FFFFFF', 'CFDEE6', 'CAD8D6', 'FFA800']],
gray => [['000000', '333333', '666666', '999999'],
['CCCCCC', 'FFFFFF']],
gray2 => [['000000', '111111', '222222', '333333'],
['444444', '555555', '666666', '777777'],
['888888', '999999', 'AAAAAA', 'BBBBBB'],
['CCCCCC', 'DDDDDD', 'EEEEEE', 'FFFFFF']],
orange=> [
graukeil25(248, 164, 0),
graukeil25(255,255,255),
],
red => [
graukeil25(255,0 ,0 ),
graukeil25(255,255,255),
]
};
my $colors = $schemes->{$scheme} || $schemes->{'BAD'};
my $table = "";
my $test_table = "";
foreach $row (@$colors){
foreach $color (@$row) {
$test_table .= "$color
\n";
}
}
foreach $row (@$colors){
$table .= "\n";
foreach $color (@$row) {
$table .= "| $color | \n";
}
$table .= "
\n";
foreach $color (@$row) {
$table .= "| $test_table | \n";
}
$table .= "
\n";
}
my $schemeLinks = "";
foreach my $scheme (sort keys %$schemes){
$schemeLinks .= "$scheme "
}
print <
$scheme colours
$scheme colours
Andere Farbschemen:
$schemeLinks
EOF