#!/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');
# we need a mechanism to tell the user he's picking a 1 or 0;
#
# 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 = "";
##########################################################################################################################
# the values that are recognized by all browsers and servers;
# if you want to rearrange the pallette, 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", );
%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 = "select";
$pfram = "Picture";
$frame = "silver";
$backg = "white";
$foreg = "black";
$gcolrr = "cc";
$gcolrg = "cc";
$gcolrb = "cc";
$bcolrr = "ff";
$bcolrg = "ff";
$bcolrb = "ff";
$fcolrr = "00";
$fcolrg = "00";
$fcolrb = "00";
$kfont = "Times";
$kfsiz = 24;
$txt = "Now sleeps the crimson petal, now the white;#0 oO #1 iI lL";
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
"pfram", 1, # picture/frame toggle
"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
);
&postit();
print "
Kuller\n";
print "\n";
# 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 ($frame ne "silver") { ($x,$gcolrr,$gcolrg,$gcolrb) = unpack("A1A2A2A2",$frame); }
if ($backg ne "white") { ($x,$bcolrr,$bcolrg,$bcolrb) = unpack("A1A2A2A2",$backg); }
if ($foreg ne "black") { ($x,$fcolrr,$fcolrg,$fcolrb) = unpack("A1A2A2A2",$foreg); }
if ($pfram eq "Picture") { $colrr = $bcolrr; $colrg = $bcolrg; $colrb = $bcolrb; }
if ($pfram eq "Frame") { $colrr = $gcolrr; $colrg = $gcolrg; $colrb = $gcolrb; }
if (($eaddr eq "") && ($descr gt "")) { $txt = $descr; };
print "";
print "\n";
if ($sendb eq "Send Selection") {
&mailto();
}
print "\n";
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 "\n$txt
";
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,";
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
" if ($ht_debug);
if ($postable{$k}) {
eval "\$$k = \"$v\"";
}
}
}
}
1;