text
bgcolor
ypmult
ypmult2
defaultsat
redfactor
green1factor
green2factor
bluefactor
phaseshift
phasescale
gamma
defaults
lu=0lu=1lu=2lu=3lu=4lu=5lu=6lu=7
col=0                
col=1                
col=2                
col=3                
col=4                
col=5                
col=6                
col=7                
col=8                
col=9                
col=A                
col=B                
col=C                
col=D                
col=E                
col=F                

#!/usr/bin/perl

$PI=3.1415926535897;
$gamma = 1.0;

sub clip
{
   my $arg = $_[0];

	if ($arg < 0.0) { return 0.0; }
	if ($arg > 1.0) { return 1.0; }
	return $arg;
}

sub fillmap
{
	for ($i = 0; $i < 128; $i++)
	{
		$colu = $i << 1;
		$hue = 180.0 - (int($colu / 16) - 1.0) * $phasescale + $phaseshift;
		$hue = $hue * $PI / 180.0;
		if (int($colu/16) ==0)
		{
			$sat = 0.0;
		   $yp = $ypmult2 * ($colu & 0x0F);
		}
		else
		{
			$sat = $defaultsat;
		   $yp = $ypmult * ($colu & 0x0F);
		}
		$up = $sat * cos($hue);
		$vp = $sat * sin($hue);

		$rp = $redfactor*$vp+$yp;
		$gp = $yp-$green1factor*$up-$green2factor*$vp;
		$bp = $bluefactor*$up+$yp;

		$r = clip($rp)**(1.0/$gamma);
		$g = clip($gp)**(1.0/$gamma);
		$b = clip($bp)**(1.0/$gamma);

		$map[$i] = int($r * 255.0);
		$map[$i] <<= 8;
		$map[$i] |= int($g * 255.0);
		$map[$i] <<= 8;
		$map[$i] |= int($b * 255.0);
	}
}

sub printmap
{
	printf("<TABLE>\n");

	printf("<TR><TD></TD>");
	for ($j = 0; $j < 8; $j++)
	{
		printf("<TD>lu=%X</TD>", $j);
	}
	printf("</TR>");

	for ($i = 0; $i < 16; $i++)
	{
		printf("<TR>\n");
		printf("<TD>col=%X</TD>", $i);
		for ($j = 0; $j < 8; $j++)
		{
			printf("<TD bgcolor=#%06X align=center title=\"#%06X\">", $map[$i<<3|$j], $map[$i<<3|$j]);
			printf("&nbsp;&nbsp;");
			printf("</TD>");
		}
		printf("</TR>\n");
	}
	printf("</TABLE>\n");
}

sub printform
{
   print "<form method=get action=video.cgi>\n";
   print "<table>\n";
   print "<TR><TD>text</td><td><input type=text name=text value=\"$text\"></td></tr>\n";
   print "<TR><TD>bgcolor</td><td><input type=text name=bgcolor value=\"$bgcolor\"></td></tr>\n";
   print "<TR><TD>ypmult</td><td><input type=text name=ypmult value=\"$ypmult\"></td></tr>\n";
   print "<TR><TD>ypmult2</td><td><input type=text name=ypmult2 value=\"$ypmult2\"></td></tr>\n";
   print "<TR><TD>defaultsat</td><td><input type=text name=defaultsat value=\"$defaultsat\"></td></tr>\n";
   print "<TR><TD>redfactor</td><td><input type=text name=redfactor value=\"$redfactor\"></td></tr>\n";
   print "<TR><TD>green1factor</td><td><input type=text name=green1factor value=\"$green1factor\"></td></tr>\n";
   print "<TR><TD>green2factor</td><td><input type=text name=green2factor value=\"$green2factor\"></td></tr>\n";
   print "<TR><TD>bluefactor</td><td><input type=text name=bluefactor value=\"$bluefactor\"></td></tr>\n";
   print "<TR><TD>phaseshift</td><td><input type=text name=phaseshift value=\"$phaseshift\"></td></tr>\n";
   print "<TR><TD>phasescale</td><td><input type=text name=phasescale value=\"$phasescale\"></td></tr>\n";
   print "<TR><TD>gamma</td><td><input type=text name=gamma value=\"$gamma\"></td></tr>\n";
   print "</table>\n";
   print "<input type=submit>\n";
   print "</form>\n";
   print "<a href=video.cgi>defaults</a>\n";
}

$text="white";
$bgcolor="gray";
$ypmult = 0.045;
$ypmult2 = 0.045;
$defaultsat = 20.0/92.5;
$redfactor = 1.14;
$green1factor=.3947;
$green2factor=.5808;
$bluefactor = 2.033;
$phaseshift=0;
$phasescale=24.0;

@foo = split /\&/, $ENV{"QUERY_STRING"};
foreach $foo (@foo)
{
   ($a, $b) = split /=/, $foo;
   ${$a}=$b;
}

fillmap();

printf("Content-type: text/html\n\n<HTML><BODY text=\"$text\" bgcolor=\"$bgcolor\">\n");
print "<table><TR><TD>\n";
printform();
print "</td><td>\n";
printmap();
print "</td></tr></table>\n";
print "<br><pre>\n";
@foo = readpipe "cat video.cgi";
foreach $foo (@foo)
{
   $foo =~ s/\&/\&amp;/g;
   $foo =~ s/>/\&gt;/g;
   $foo =~ s/</\&lt;/g;
   print $foo;
}
printf("</BODY></HTML>\n");