#!/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 .= "<span style='color:#$color;'>$color</span><br>\n";
	}
}

foreach $row (@$colors){
	$table .= "<tr>\n";
 	foreach $color (@$row) {
		$table .= "<td align=center>$color</td>\n";
	}
	$table .= "</tr><tr>\n";
 	foreach $color (@$row) {
		$table .= "<td align=center bgcolor=#$color>$test_table</td>\n";
	}
	$table .= "</tr>\n";
}

my $schemeLinks = "";
foreach my $scheme (sort keys %$schemes){
	$schemeLinks .= "<a href='colors.pl?scheme=$scheme'>$scheme</a> "
}

print <<EOF;
content-type: text/html

<head>
<title>$scheme colours</title>
<style>

td {
 color: black;
 font-family: Syntax Bold, LinotypeSyntax Bold;
 font-size: 120%;
 font-weight: bold;
}
h1 {
 color: white;
 font-family: Syntax UltraBlack, LinotypeSyntax Black;
 font-size: 120%;
 font-weight: bold;
}
body {
 font-size: 100%;
}
</style>
</head>
<body bgcolor=#808080>

<h1 align=center>$scheme colours</h1>

<table width=100% height=90% align=center valign=middle border=0 cellpadding=0 cellspacing=10>

$table

</table>

Andere Farbschemen:
$schemeLinks

</body>
EOF
