#!/usr/bin/perl

$PI=3.1415926535897;

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;

      if ($ntsc == 1)
      {
         $hue = 180.0 - (int($colu / 16) - 1.0) * $phasescale + $phaseshift;
         if (int($colu/16) ==0)
         {
            $sat = 0.0;
            $yp = $ypmult2 * ($colu & 0x0F);
         }
         else
         {
            $sat = $defaultsat;
            $yp = $ypmult * ($colu & 0x0F);
         }
      }
      else
      {
         $c4 = int($colu /16);
         if (($c4 < 0x02) || ($c4 > 0x0D))
         {
             $sat = 0.0;
             $yp = $ypmult2 * ($colu & 0x0F);
         }
         else
         {
             $sat = $defaultsat;
             $yp = $ypmult * ($colu & 0x0F);
         }
         if (($c4 & 0x01) == 0x00)
         {
             $hue = 180.0 - ($c4 - 2.0) * $phasescale + $phaseshift;
         }
         else
         {
             $hue = 180.0 + ($c4 - 1.0) * $phasescale + $phaseshift;
         }
      }

      $hue = $hue * $PI / 180.0;

      $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);
      $g = clip($gp);
      $b = clip($bp);

      $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=videopal.cgi>\n";
   print "<table>\n";
   print "<TR><TD>ntsc=1,pal=0</td><td><input type=text name=ntsc value=\"$ntsc\"></td></tr>\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 "</table>\n";
   print "<input type=submit>\n";
   print "</form>\n";
   print "<a href=videopal.cgi>default ntsc</a>\n";
   print "<a href=videopal.cgi?pal=1>default pal</a>\n";
}

$ntsc = 1;
$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=360.0/15;

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

if ($pal == 1)
{
$ntsc = 0;
$text="white";
$bgcolor="gray";
$ypmult = 0.045;
$ypmult2 = 0.045;
$defaultsat = .2143;
$redfactor = 1.14;
$green1factor=.3947;
$green2factor=.5808;
$bluefactor = 2.033;
$phaseshift=0;
$phasescale=15.0;
}

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 videopal.cgi";
foreach $foo (@foo)
{
   $foo =~ s/\&/\&amp;/g;
   $foo =~ s/>/\&gt;/g;
   $foo =~ s/</\&lt;/g;
   print $foo;
}
printf("</BODY></HTML>\n");