#!C:\usr\bin\perl5.10.1.exe

@cie = (
  [ 390,  1.83970E-3, -4.53930E-4,  1.21520E-2 ],
  [ 395,  4.61530E-3, -1.04640E-3,  3.11100E-2 ],
  [ 400,  9.62640E-3, -2.16890E-3,  6.23710E-2 ],
  [ 405,  1.89790E-2, -4.43040E-3,  1.31610E-1 ],
  [ 410,  3.08030E-2, -7.20480E-3,  2.27500E-1 ],
  [ 415,  4.24590E-2, -1.25790E-2,  3.58970E-1 ],
  [ 420,  5.16620E-2, -1.66510E-2,  5.23960E-1 ],
  [ 425,  5.28370E-2, -2.12400E-2,  6.85860E-1 ],
  [ 430,  4.42870E-2, -1.99360E-2,  7.96040E-1 ],
  [ 435,  3.22200E-2, -1.60970E-2,  8.94590E-1 ],
  [ 440,  1.47630E-2, -7.34570E-3,  9.63950E-1 ],
  [ 445, -2.33920E-3,  1.36900E-3,  9.98140E-1 ],
  [ 450, -2.91300E-2,  1.96100E-2,  9.18750E-1 ],
  [ 455, -6.06770E-2,  4.34640E-2,  8.24870E-1 ],
  [ 460, -9.62240E-2,  7.09540E-2,  7.85540E-1 ],
  [ 465, -1.37590E-1,  1.10220E-1,  6.67230E-1 ],
  [ 470, -1.74860E-1,  1.50880E-1,  6.10980E-1 ],
  [ 475, -2.12600E-1,  1.97940E-1,  4.88290E-1 ],
  [ 480, -2.37800E-1,  2.40420E-1,  3.61950E-1 ],
  [ 485, -2.56740E-1,  2.79930E-1,  2.66340E-1 ],
  [ 490, -2.77270E-1,  3.33530E-1,  1.95930E-1 ],
  [ 495, -2.91250E-1,  4.05210E-1,  1.47300E-1 ],
  [ 500, -2.95000E-1,  4.90600E-1,  1.07490E-1 ],
  [ 505, -2.97060E-1,  5.96730E-1,  7.67140E-2 ],
  [ 510, -2.67590E-1,  7.01840E-1,  5.02480E-2 ],
  [ 515, -2.17250E-1,  8.08520E-1,  2.87810E-2 ],
  [ 520, -1.47680E-1,  9.10760E-1,  1.33090E-2 ],
  [ 525, -3.51840E-2,  9.84820E-1,  2.11700E-3 ],
  [ 530,  1.06140E-1,  1.03390, -4.15740E-3 ],
  [ 535,  2.59810E-1,  1.05380, -8.30320E-3 ],
  [ 540,  4.19760E-1,  1.05120, -1.21910E-2 ],
  [ 545,  5.92590E-1,  1.04980, -1.40390E-2 ],
  [ 550,  7.90040E-1,  1.03680, -1.46810E-2 ],
  [ 555,  1.00780,  9.98260E-1, -1.49470E-2 ],
  [ 560,  1.22830,  9.37830E-1, -1.46130E-2 ],
  [ 565,  1.47270,  8.80390E-1, -1.37820E-2 ],
  [ 570,  1.74760,  8.28350E-1, -1.26500E-2 ],
  [ 575,  2.02140,  7.46860E-1, -1.13560E-2 ],
  [ 580,  2.27240,  6.49300E-1, -9.93170E-3 ],
  [ 585,  2.48960,  5.63170E-1, -8.41480E-3 ],
  [ 590,  2.67250,  4.76750E-1, -7.02100E-3 ],
  [ 595,  2.80930,  3.84840E-1, -5.74370E-3 ],
  [ 600,  2.87170,  3.00690E-1, -4.27430E-3 ],
  [ 605,  2.85250,  2.28530E-1, -2.91320E-3 ],
  [ 610,  2.76010,  1.65750E-1, -2.26930E-3 ],
  [ 615,  2.59890,  1.13730E-1, -1.99660E-3 ],
  [ 620,  2.37430,  7.46820E-2, -1.50690E-3 ],
  [ 625,  2.10540,  4.65040E-2, -9.38220E-4 ],
  [ 630,  1.81450,  2.63330E-2, -5.53160E-4 ],
  [ 635,  1.52470,  1.27240E-2, -3.16680E-4 ],
  [ 640,  1.25430,  4.50330E-3, -1.43190E-4 ],
  [ 645,  1.00760,  9.66110E-5, -4.08310E-6 ],
  [ 650,  7.86420E-1, -1.96450E-3,  1.10810E-4 ],
  [ 655,  5.96590E-1, -2.63270E-3,  1.91750E-4 ],
  [ 660,  4.43200E-1, -2.62620E-3,  2.26560E-4 ],
  [ 665,  3.24100E-1, -2.30270E-3,  2.15200E-4 ],
  [ 670,  2.34550E-1, -1.87000E-3,  1.63610E-4 ],
  [ 675,  1.68840E-1, -1.44240E-3,  9.71640E-5 ],
  [ 680,  1.20860E-1, -1.07550E-3,  5.10330E-5 ],
  [ 685,  8.58110E-2, -7.90040E-4,  3.52710E-5 ],
  [ 690,  6.02600E-2, -5.67650E-4,  3.12110E-5 ],
  [ 695,  4.14800E-2, -3.92740E-4,  2.45080E-5 ],
  [ 700,  2.81140E-2, -2.62310E-4,  1.65210E-5 ],
  [ 705,  1.91170E-2, -1.75120E-4,  1.11240E-5 ],
  [ 710,  1.33050E-2, -1.21400E-4,  8.69650E-6 ],
  [ 715,  9.40920E-3, -8.57600E-5,  7.43510E-6 ],
  [ 720,  6.51770E-3, -5.76770E-5,  6.10570E-6 ],
  [ 725,  4.53770E-3, -3.90030E-5,  5.02770E-6 ],
  [ 730,  3.17420E-3, -2.65110E-5,  4.12510E-6 ],
);

print $_;

%arvo = split /[=&]/, join '=none&', split /=&/, <STDIN>;

foreach $avain (keys %arvo) {
    $_ = join ' ', split /\+/, $arvo{$avain};
    s/%\w{2}/chr(hex(substr($&,1,2)))/ge;
    $arvo{$avain} = join "'", split /"/, $_;
}

$kw = $arvo{'kw'};
@rv = ( 0, 0, 0 );
print $kw;

$ct = $arvo{'cntype'};
print $ct;

if ($ct eq "wl") {
	if ($kw == 730) { @rv = ($cie[68][1], $cie[68][2], $cie[68][3]); }
	if (($kw >= 390) && ($kw < 730)) {
		$ps = 0;
		while ($kw >= $cie[$ps+1][0]) { $ps++; }
		for ($c = 1; $c < 4; $c++) { $rv[$c-1] = $cie[$ps][$c] + ($cie[$ps+1][$c]-$cie[$ps][$c])*($kw-$cie[$ps][0])/5; }
	}
	$rv[0] = $rv[0]/2.5;
	$rv[1] = $rv[1]*1;
	$rv[2] = $rv[2]*2;
} else {
	$kb = $arvo{'kb'};
	if ($kb < 500) { $kb = 7000; }
	@rr = ( 0, 0, 0 );
	for ($p = 0; $p < 69; $p++) {
		$l = $cie[$p][0]*1e-6;
		$i = 1/(($l*1e3)**3 * (exp(14.3877/($kb*$l))-1));
		for ($c = 1; $c < 4; $c++) { $rr[$c-1] = $rr[$c-1] + $i*$cie[$p][$c];
		}
	}
	if ($kw > 0 ) {
		for ($p = 0; $p < 69; $p++) {
			$l = $cie[$p][0]*1e-6;
			$i = 1/(($l*1e3)**3 * (exp(14.3877/($kw*$l))-1));
			for ($c = 1; $c < 4; $c++) { $rv[$c-1] = $rv[$c-1] + $i*$cie[$p][$c];
			}
		}
	}
	for ($c = 0; $c < 3; $c++) {
		$rv[$c] = $rv[$c]/$rr[$c];
	}
}

$mx = 0;
for ($c = 0; $c < 3; $c++) {
	if ($rv[$c] < 0) { $rv[$c] = 0; }
	if ($rv[$c] > $mx) { $mx = $rv[$c]; }
}

@rs = @rv;
if ($mx > 0) {
	for ($c = 0; $c < 3; $c++) {
		$rv[$c] = int($rv[$c]*65535/$mx+0.5);
		$rs[$c] = int($rv[$c]/256-0.5);
	}
}

print "Content-type: text/html\n\n<HTML><HEAD><TITLE>Kelvin or wavelength to RGB converter";
print '</TITLE></HEAD><BODY BGCOLOR="#FFFFFF" LINK="#6699FF" VLINK="#0000CC">';
print '<BR><CENTER><H1>Kelvin or wavelength to RGB converter</H1><BR>';
print '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0><TR><TD WIDTH=680 ALIGN=left>';
print '<BR><B>Temperature to RGB</B><BR><BR>';
print '<FORM METHOD=POST ACTION="../kwrgb.cgi">';
print '<INPUT TYPE="hidden" NAME="cntype" VALUE="bbs">';
print 'Reference temperature in Kelvins (K): <INPUT TYPE=text NAME="kb" VALUE="';
if ($kb > 500) { print $kb; } else { print '7000'; }
print '" MAXLENGTH=6 SIZE=6> (appears as pure white)<BR>';
print 'Temperature in Kelvins (K): <INPUT TYPE=text NAME="kw" MAXLENGTH=6 SIZE=6>';
print ' <INPUT TYPE=submit VALUE="Submit"></FORM><BR>';
print '<B>Wavelength to RGB</B><BR><BR>';
print '<FORM METHOD=POST ACTION="../kwrgb.cgi">';
print '<INPUT TYPE="hidden" NAME="cntype" VALUE="wl">';
print 'Wavelength in nanometers (nm): <INPUT TYPE=text NAME="kw" MAXLENGTH=6 SIZE=6>';
print ' <INPUT TYPE=submit VALUE="Submit"></FORM></TD></TR></TABLE><BR><H3>';
print $kw;
if ($ct eq "wl") { print ' nm'; } else { print ' K (white ',$kb,' K)'; }
print '</H3><TABLE BORDER=2><TR><TD WIDTH=60 BGCOLOR="#';
printf "%2.2X%2.2X%2.2X", $rs[0],$rs[1],$rs[2];
print '"> <BR><BR><BR><BR></TD></TR></TABLE><P><TABLE BORDER=0>';
print '<TR><TD WIDTH=32><B>R</B></TD><TD WIDTH=64 ALIGN=right><B>',$rs[0],'</B></TD><TD WIDTH=64 ALIGN=right><B>',$rv[0],'</B></TD></TR>';
print '<TR><TD WIDTH=32><B>G</B></TD><TD WIDTH=64 ALIGN=right><B>',$rs[1],'</B></TD><TD WIDTH=64 ALIGN=right><B>',$rv[1],'</B></TD></TR>';
print '<TR><TD WIDTH=32><B>B</B></TD><TD WIDTH=64 ALIGN=right><B>',$rs[2],'</B></TD><TD WIDTH=64 ALIGN=right><B>',$rv[2],'</B></TD></TR>';
print '</TABLE></P><P><A HREF=""></P>';
print '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0><TR><TD WIDTH=680 ALIGN=left>';
print '<HR><FONT SIZE=-1><A HREF=""></A>';
print '<I></I><BR>';
print '</FONT></TD></TR></TABLE></CENTER></BODY></HTML>';