#!/usr/bin/perl --
#   kuller.pl - web-safe color selector;
#       put your own address in 'eaddr', drop kuller.pl into your cgi-bin,
#       and give the url to your user;
#       advise her to enter her own email address in 'From:',
#       put in a description of the page or section the colors are to be used for,
#       and pick out the color settings she wants; click 'Send';
#       N.B.:  there are 3 colors in a full set:  frame, background, and foreground;
#       fore-/background colors will always be sent, but it's not necessary to pick
#       a frame color if the page doesn't call for one;
#       the default font is Times-24pt; there is no such thing as a web-safe font list,
#       although some fonts are safer than others; the list below is just a bunch of
#       popular fonts, with the ones most common at the top (weight of '2');
#
#   to do:  kuller.html/kuller.js, so that the selector can be easily dropped into
#       a page other than the one hard-coded here.
#
#

# this is the address where you want the selection sent; the user can put her own address
#  in the From: field in the form.
#
#$eaddr = "slick@hotwheels.com";  (e.g.)
$eaddr = "";

# if you want to write your own html page to replace kuller's, take a look at the khtml
#  array below to see how kuller builds its text;
#  then put your url here (you can name it whatever you like);
#  be sure to include the tags:
#           <!-- __kullerselect__ >
#       and
#           <!-- __kullerscript__ >
#  or the working parts of kuller won't be included in the page;
#  the __kullerselect__ tag should be part of a form;
#  the fields 'foreg', 'backg', 'frame', 'kfont', and 'kfsiz'
#  will be sent to the script targeted by the form;
#
#$khtml = "../kuller.html";  (e.g.)
$khtml = "";

##########################################################################################################################


# the values that are recognized by all browsers and servers;
#  if you want to rearrange the palette, you can fiddle with the order of these lists,
#  by reversing or 'mirroring' the intensity values:
@redlist = ( "00", "33", "66", "99", "cc", "ff", );
@grnlist = ( "00", "33", "66", "99", "cc", "ff", ); # "ff", "cc", "99", "66", "33", "00", );
@blulist = ( "00", "33", "66", "99", "cc", "ff", );

@fntcolr = ( "#cc0000","#cccc00","#00cc00", );
@fntwarn = ( "!!","??","ok", );
%fntlist = (
    "Courier",      2,
    "Arial Black",  2,
    "Verdana",      2,
    "Comic Sans MS",    2,
    "Arial",        2,
    "Courier New",  2,
    "Impact",       2,
    "Tahoma",       2,
    "Trebuchet MS", 2,
    "Helvetica",    2,
    "Times",        2,
    "Arial Narrow", 2,
    "Georgia",      2,
    "Century",      2,
    "Century Gothic",   2,
    "Times New Roman",  2,
    "Lucida Console",   1,
    "Lucida Sans Unicode",  1,
    "Bookman Oldstyle", 1,
    "Book Antiqua",     1,
    "Geneva",           1,
    "Monaco",           1,
    "Skia",             1,
    "Garamond",         1,
    "Palatino",         1,
    "Bitstream Vera Sans",  0,
    "Bitstream Vera Sans Mono", 0,
    "Bitstream Vera Serif", 0,
    "Utopia",               0,
    "New Century Schoolbook",   0,
    "Fixed",                0,
    "Fixedsys",             0,
    "Everson mono terminal",    0,
    "Nimbus Mono",          0,
    "Century Schoolbook L", 0,
    "URW Grotesk T",        0,
    "WingDings",    0,
    "Symbol",       0,
    "Klingon",      0,
    "Zapf Dingbats",    0,
    "Ventilate",    0,
    );

@tmp = ();
@spec = ();

# starting points only:

$selct = "Selecting:";
$picfg = "Picture";

$frame = "silver";
$backg = "white";
$foreg = "black";

$kfont = "Times";
$kfsiz = 24;
$khelp = 0;

$ktext = "Now sleeps the crimson petal, now the white;<p>#0 oO &nbsp; #1 iI lL";

@khtml = ();

main: {
    print "Content-Type: text/html\n\n";

    # only vars listed in postable will be read from the form's post
    %postable = (
        "backg", 1, # background
        "foreg", 1, # foreground
        "frame", 1, # page(frame) color
        "selct", 1, # select/frozen toggle
        "picfg", 1, # text/background/frame selector
        "kfont", 1, # selected text font
        "kfsiz", 1, #  size of same
        "eaddr", 1, # email address for recipient
        "descr", 1, # description of what this color should be used for
        "euser", 1, # email address of sender (picking the color)
        "sendb", 1, # 'Send' from the command button
        "khelp", 1, # is help text turned on?
        "ktext", 1, # alternative to tennyson
        );
    &postit();

    # this double loop is way more complex than it needs to be;
    #  by fiddling with the values i/j/k, you can create a key that
    #  'weights' the colors by intensity;
    #  my intention was to do a nice spectral fade, but the math is
    #  way complex, or maybe my algorithm was flawed;
    #  the structure is here to revisit;
    $n = 0;
    $k = 0;
    foreach $g (@grnlist) {
      $i = 0;
      foreach $r (@redlist) {
        $j = 0;
        foreach $b (@blulist) {
            $n = $k*100000 + $i*1000 + $j*10;
            $s = sprintf("%06d %s%s%s",$n,$r,$g,$b);
            push(@tmp,$s);
            $j+=1;
        }
        $i+=1;
      }
      $k+=1;
    }
    foreach $r (sort(@tmp)) {
        @s = split(/ /,$r);
        push(@spec,$s[1]);
    }

    if ($picfg eq "Frame") {
        if ($frame eq "silver") {
            ($colrr,$colrg,$colrb) = ("cc","cc","cc");
        } else {
            ($x,$colrr,$colrg,$colrb) = unpack("A1A2A2A2",$frame);
        }
        $slctf = "checked=checked";
    } else { $slctf = ""; }
    if ($picfg eq "Picture") {
        if ($backg eq "white") {
            ($colrr,$colrg,$colrb) = ("ff","ff","ff");
        } else {
            ($x,$colrr,$colrg,$colrb) = unpack("A1A2A2A2",$backg);
        }
        $slctp = "checked=checked";
    } else { $slctp = ""; }
    if ($picfg eq "Text") {
        if ($foreg eq "black") {
            ($colrr,$colrg,$colrb) = ("00","00","00");
        } else {
            ($x,$colrr,$colrg,$colrb) = unpack("A1A2A2A2",$foreg);
        }
        $slctt = "checked=checked";
    } else { $slctt = ""; }

    if ($khtml gt "") {
        if (open(FIL,"<$khtml")) {
            $i = 0;
            while(<FIL>) {
                $khtml[$i++] = $_;
            }
            close(FIL);
        } else {
            $khtml = "";
        }
    }
    if ($khtml eq "") {
        @khtml = (
            "<html><head><title>kuller</title>\n",
            "</head><body>\n",
            "<table width=100%><tr><td align=center>\n",
            "<form name=colrtst>\n",
            "<table>\n",
            "<tr><td align=center colspan=2>",
            "<b><font size=5>Kuller</font>",
            "</td></tr>",
            "<tr><td id=khelp align=justify colspan=2><sub>",
            "Move the cursor over the palette to select the color of frame, background or text. ",
            "Click the palette to toggle selection on or off; this 'freezes' the current color, ",
            "(and frees your mouse) until you click again on the color array. ",
            "The palette is 'web-safe', meaning that the range is a subset of colors that all ",
            "standard browsers render alike.  To try intermediate colors, change the hex values in the ",
            "display by typing them, or by using the arrows or your up/down keys to increment them (keys are faster). ",
            "The font list includes some that are typically available ('ok'), some that are available only on some ",
            "platforms (??), and some that are not widely available (!!).  Consider these 'serving suggestions'.  ",
            "If a font is not available on the user's machine, it will be rendered as the default (usually 'Times'). ",
            "When you click 'Send', the color selections and description will be sent ",
            "to the email address you have chosen.",
            "</sub></td></tr>",
            "<tr><td><pre>",
            "    Email to:  <input type=text size=60 name=eaddr id=eaddr value=$eaddr> (email address)\n",
            "        From:  <input type=text size=60 name=euser id=euser value=$euser> (email address)\n",
            " Description:  <input type=text size=60 name=descr id=descr value=\"$descr\"> (how you want to use this selection)\n",
            "        Text:  <input type=text size=60 name=ktext id=ktext value=\"$ktext\"> (anything you like)",
            "</pre></td>",
            "<td align=left>",
            "<input type=submit name=sendb id=sendb value=\"Send Selection\">",
            "</td>",
            "</tr></table>",
            "<!-- __kullerselect__ >",
            "</form></td></tr></table>",
            "<!-- __kullerscript__ >",
            "</body></html>\n",
            "",
        );
    }

    $ihtml = 0;
    while ($ihtml < $#khtml) {
    if ($khtml[$ihtml] =~ /__kullerselect__/) {

####  this section (table) is the color-selector;
####  some of its values (foreg/backg/frame/kfont/kfsiz)
####    need to be included in the form in order to be useful;
####
    print "<table border=1px width=100% cellpadding=0 cellspacing=0><tr>";
    print "<td align=center valign=middle style=\"background-color:silver\">";
    print "<table cellpadding=0 cellspacing=0>";
    print "<tr><td align=center valign=middle>";
    print "<input type=button name=selctb id=selctb value=$selct onclick=\"frzclr();\" ";
    print " style=\"background-color:silver;font-family:times;font-weight:bold;\"><br>";
    print "<input type=hidden name=selct  id=selcth value=$selct>";
    print "<input type=radio name=picfg id=picfg value=Frame   $slctf onclick=\"frmpic('F');\">Frame";
    print "<input type=radio name=picfg id=picfg value=Picture $slctp onclick=\"frmpic('P');\">Picture";
    print "<input type=radio name=picfg id=picfg value=Text    $slctt onclick=\"frmpic('T');\">Text";
    print "<input type=hidden name=foreg  id=foreg  value=$foreg>";
    print "<input type=hidden name=backg  id=backg  value=$backg>";
    print "<input type=hidden name=frame  id=frame  value=$frame>";
    print "</td></tr>";
    print "<tr><td style=\"text-align:center;vertical-align:middle;\"><sub>Click to lock or release:</sub><br>";
    $i = 0;
    foreach $s (@spec) {
        ($r,$g,$b) = unpack("A2A2A2",$s);
        print "<a style=\"background-color:#$r$g$b;color:#$r$g$b;font-family:courier;font-size:6pt;line-height:160%;";
        print "text-decoration:none;\" onclick=\"frzclr();\" onmouseover=\"showclr('$r','$g','$b');\">A</a>";
        if (++$i == 36) {
            print "<br>";
            $i = 0;
        }
    }
    print "<div style=\"line-height:200%;\">";
    print "R:<input type=text size=2 maxlength=2 name=bcolrr id=bcolrr value=$colrr ";
    print " onblur=\"incclr('r','s');\" onkeydown=\"return inckey('r',event);\">";
    print "<a onclick=\"incclr('r','u');\">&nbsp;&uarr;</a>";
    print "<a onclick=\"incclr('r','d');\">&darr;&nbsp;</a>&nbsp;&nbsp;&nbsp;";
    print "G:<input type=text size=2 maxlength=2 name=bcolrg id=bcolrg value=$colrg ";
    print " onblur=\"incclr('g','s');\" onkeydown=\"return inckey('g',event);\">";
    print "<a onclick=\"incclr('g','u');\">&nbsp;&uarr;</a>";
    print "<a onclick=\"incclr('g','d');\">&darr;&nbsp;</a>&nbsp;&nbsp;&nbsp;";
    print "B:<input type=text size=2 maxlength=2 name=bcolrb id=bcolrb value=$colrb ";
    print " onblur=\"incclr('b','s');\" onkeydown=\"return inckey('b',event);\">";
    print "<a onclick=\"incclr('b','u');\">&nbsp;&uarr;</a>";
    print "<a onclick=\"incclr('b','d');\">&darr;&nbsp;</a>&nbsp;&nbsp;&nbsp;";
    print "</div></td></tr>";
    print "<tr><td align=center>";
    print "Font (!!-unsafe, ??-maybe) / Size<br>";
    print "<select name=kfont id=kfont onkeyup=\"showtst();\" onclick=\"showtst();\">";
    foreach $f (sort(keys(%fntlist))) {
        $c = $fntcolr[$fntlist{$f}];
        $s = ($f eq $kfont ? "selected=selected" : "");
        print "<option $s style=\"background-color:$c;\" value=\"$f\">$f ($fntwarn[$fntlist{$f}])\n";
    }
    print "</select>\n";
    print "<input type=text size=2 maxlength=2 name=kfsiz id=kfsiz value=$kfsiz ";
    print " onblur=\"sizfnt('s');\" onkeydown=\"return incfnt(event);\">";
    print "<a onclick=\"sizfnt('u');\">&nbsp;&uarr;</a>";
    print "<a onclick=\"sizfnt('d');\">&darr;&nbsp;</a>";
    print "</td></tr>";
    print "</table></td>";
    print "<td align=center valign=middle id=colrbrdr style=\"background-color:$frame;\">";
    print "<table width=100% cellpadding=40pt border=0>";
    print "<tr><td align=center valign=middle>";
    print "<table border=1px cellpadding=20pt>";
    print "<tr><td id=colrshow style=\"text-align:center;vertical-align:middle;";
    print "color:$foreg;background-color:$backg;font-family:$kfont;font-size:$kfsiz","pt;\">";
    print $ktext;
    print "</td></tr></table>";
    print "</td></tr></table>";
    print "</td></tr></table>";
####
####

    } elsif ($khtml[$ihtml] =~ /__kullerscript__/) {

    print "<script language=JavaScript>\n";

    if ($selct eq "Selecting:") {
        print "var clrLock = 0;\n";
    } else {
        print "var clrLock = 1;\n";
    }

    if ($picfg eq "Picture") { print "var picFrame = 'P';\n"; }
    if ($picfg eq "Frame")   { print "var picFrame = 'F';\n"; }
    if ($picfg eq "Text")    { print "var picFrame = 'T';\n"; }

    print "function incfnt (evt) {\n";
    print "    switch (evt.keyCode) {\n";
    print "        case 38: sizfnt('u'); return(false); break;\n";
    print "        case 40: sizfnt('d'); return(false); break;\n";
    print "        default: break;\n";
    print "    }\n";
    print "    return(true);\n";
    print "};\n";

    print "function sizfnt (updn) {\n";
    print "    var f = document.getElementById('kfsiz');\n";
    print "    var s = f.value;\n";
    print "    var n = parseInt(s,10);\n";
    print "    if (updn == 'u') { n++; if (n > 99) { n = 99; } }\n";
    print "    if (updn == 'd') { n--; if (n < 0)   { n = 0; } }\n";
    print "    if (n < 10) {\n";
    print "        f.value = '0' + n.toString(10);\n";
    print "    } else {\n";
    print "        f.value = n.toString(10);\n";
    print "    }\n";
    print "    showtst();\n";
    print "}\n";

    print "function inckey (clr,evt) {\n";
    print "    switch (evt.keyCode) {\n";
    print "        case 38: incclr(clr,'u'); return(false); break;\n";
    print "        case 40: incclr(clr,'d'); return(false); break;\n";
    print "        default: break;\n";
    print "    }\n";
    print "    return(true);\n";
    print "};\n";

    print "function incclr (clr,updn) {\n";
    print "    var fld = 'bcolr' + clr;\n";
    print "    var f;\n";
    print "    f = document.getElementById(fld);\n";
    print "    var c = f.value;\n";
    print "    var n = parseInt(c,16);\n";
    print "    if (updn == 'u') { n++; if (n > 255) { n = 255; } }\n";
    print "    if (updn == 'd') { n--; if (n < 0)   { n = 0;   } }\n";
    print "    if (n < 16) {\n";
    print "        f.value = '0' + n.toString(16);\n";
    print "    } else {\n";
    print "        f.value = n.toString(16);\n";
    print "    }\n";
    print "    setclr();\n";
    print "}\n";

    print "function setclr () {\n";
    print "    var f = document.getElementById('bcolrr');\n";
    print "    var r = f.value;\n";
    print "    f = document.getElementById('bcolrg');\n";
    print "    var g = f.value;\n";
    print "    f = document.getElementById('bcolrb');\n";
    print "    var b = f.value;\n";
    print "    if (picFrame == 'F') { h = 'frame'; }\n";
    print "    if (picFrame == 'P') { h = 'backg'; }\n";
    print "    if (picFrame == 'T') { h = 'foreg'; }\n";
    print "    f = document.getElementById(h);\n";
    print "    f.value = '#' + r + g + b;\n";
    print "    showtst();\n";
    print "}\n";

    print "function showclr (rclr,gclr,bclr) {\n";
    print "    if (clrLock) { return; }\n";
    print "    var f = document.getElementById('bcolrr');\n";
    print "    f.value = rclr;\n";
    print "    f = document.getElementById('bcolrg');\n";
    print "    f.value = gclr;\n";
    print "    f = document.getElementById('bcolrb');\n";
    print "    f.value = bclr;\n";
    print "    var h;\n";
    print "    if (picFrame == 'F') { h = 'frame'; }\n";
    print "    if (picFrame == 'P') { h = 'backg'; }\n";
    print "    if (picFrame == 'T') { h = 'foreg'; }\n";
    print "    f = document.getElementById(h);\n";
    print "    f.value = '#' + rclr + gclr + bclr;\n";
    print "    showtst();\n";
    print "}\n";

    print "function frzclr () {\n";
    print "    var f = document.getElementById('sendb');\n";
    print "    f.focus();\n";
    print "    clrLock = !clrLock;\n";
    print "    f = document.getElementById('selctb');\n";
    print "    var h = document.getElementById('selcth');\n";
    print "    if (clrLock) {\n";
    print "        f.value = 'LOCKED.';\n";
    print "        h.value = 'LOCKED.';\n";
    print "    } else {\n";
    print "        f.value = 'Selecting:';\n";
    print "        h.value = 'Selecting:';\n";
    print "    }\n";
    print "    showtst();\n";
    print "}\n";

    print "function frmpic (pft) {\n";
    print "    picFrame = pft;\n";
    print "    if (picFrame == 'F') {\n";
    print "        f = document.getElementById('frame');\n";
    print "    }\n";
    print "    if (picFrame == 'P') {\n";
    print "        f = document.getElementById('backg');\n";
    print "    }\n";
    print "    if (picFrame == 'T') {\n";
    print "        f = document.getElementById('foreg');\n";
    print "    }\n";
    print "    var c = f.value;\n";
    print "    var n = c.substring(0,1);\n";
    print "    if (n == '#') {;\n";
    print "        var r = c.substring(1,3);\n";
    print "        var g = c.substring(3,5);\n";
    print "        var b = c.substring(5);\n";
    print "        c = clrLock;\n";
    print "        clrLock = 0;\n";
    print "        showclr(r,g,b);\n";
    print "        clrLock = c;\n";
    print "    }\n";
    print "}\n";

    print "function showtst () {\n";
    print "    var frame = document.getElementById('frame');\n";
    print "    var backg = document.getElementById('backg');\n";
    print "    var foreg = document.getElementById('foreg');\n";
    print "    var frameclr = frame.value;\n";
    print "    var foregclr = foreg.value;\n";
    print "    var backgclr = backg.value;\n";
    print "    var f = document.getElementById('colrbrdr');\n";
    print "    f.style.backgroundColor = frameclr;\n";
    print "    f = document.getElementById('kfont');\n";
    print "    var fnt = f.value;\n";
    print "    f = document.getElementById('kfsiz');\n";
    print "    var fsz = f.value;\n";
    print "    f = document.getElementById('colrshow');\n";
    print "    f.style.backgroundColor = backgclr;\n";
    print "    f.style.color = foregclr;\n";
    print "    f.style.fontFamily = fnt;\n";
    print "    f.style.fontSize = fsz + 'pt';\n";
    print "}\n";

    print "</script>\n";

    if ($sendb eq "Send Selection") {
        &mailto();
    }

    } else {
        print "$khtml[$ihtml]";
    }
    $ihtml++;
    }

    exit(1);
}

sub mailto {
    local $txt = "From:  $euser\nTo:  $eaddr\nSubject:  Kuller selection\n";
    $txt .= "I have selected these colors for this usage:\n\n";
    $txt .= " Description:  $descr \n";
    if ($frame ne "silver") { $txt .= "  Page color:  $frame \n"; }
    if ($backg ne "white")  { $txt .= "  Background:  $backg \n"; }
    if ($foreg ne "black")  { $txt .= "  Foreground:  $foreg \n"; }
    $txt .= "\n   Test font:  $kfont, $kfsiz pt.\n";
    $txt .= "\nThank you for your attention.\n";
    $txt .= ".\n";
    print "<pre>\n$txt</pre>";
    if ($eaddr eq "") { return; }
    if (open(SND,"|/usr/sbin/sendmail $eaddr")) {
        print SND "$txt";
        close(SND);
    } else {
        print "$txt\n !! sendmail failed ($!)";
    }
}

# my own POST processor, just so i know exactly how strings will be handled;
#  also, i get advanced warning if the server is vms-based;
sub postit {
    local $cgipost = "";
    local $rg = "";
    local $ht = "";
    local $k = "";
    local $v = "";
    local $n = 0;
    local @ht = ();
    local @kv = ();

    if (defined $ENV{'QUERY_STRING'}) {
        $rg .= $ENV{'QUERY_STRING'};
    }
    if (open(CGIPOST,"<APACHE\$INPUT")) {
        $rg .= <CGIPOST>;
        close(CGIPOST);
        $vms = 1;
    } else { $vms = 0; }
    if (defined $ENV{'CONTENT_LENGTH'}) {
        $n = $ENV{'CONTENT_LENGTH'};
        if ($n < 32000) { read(STDIN, $cgipost, $n); }
        $rg .= $cgipost;
    }
    chomp($rg);
    if (length($rg) > 0) {
        #   1 - replace '+' with blanks
        #   2 - split the buffer into lines, on '&'
        #   3 - get rid of cr/lf pairs
        #   4 - replace %40-(hex) with @-(ascii), e.g.
        #   5 - assign value of key=value pairs to $key variables
        $rg =~ s/\+/ /g;
        $rg =~ s/\@/\%40/g;
        @ht = split(/&/,$rg);
        foreach $ht (@ht) {
            $ht =~ s/\%0D\%0A/\|/g;
            $ht =~ s/\%\w{2,2}/sprintf("\\%c",hex(substr($&,1,2)))/eg;
            @kv = split(/=/,$ht);
            $k  = shift(@kv);
            $v  = join('=',@kv);
            print "$k $v<br>" if ($ht_debug);
            if ($postable{$k}) {
                eval "\$$k = \"$v\"";
            }
        }
    }
}

1;