#!/usr/bin/env perl
#############################################################################
# gd_colormix_graphic.psgi
##
# Web page that presents the gd_colormix colors
#############################################################################
use strict;

#############################################################################
# Started using color names from WikiPedia ... had to switch reads to UTF-8
use open IO => ':utf8';
use feature "unicode_strings";
#############################################################################

#############################################################################
# Color ... local libraries to support this project
use lib q{.};
## Color::Convert -- which uses Graphics::ColorObject extensivesly
## Functions: 
###    magentaIsolate yellowIsolate cyanIsolate primaryOpposite
###    rgbTOhsv rgbTOhhsv rgbTOcmyk rgbTOlab
###    colorOpposite wheelComplement percentTint percentShade
use Color::Convert;
## Color::Geometry -- cMixGeom, hold the internal Geometry of the color box
## Functions: 
###    cMixGeom
use Color::Geometry qw{cMixGeom};
#############################################################################

my $SVNr = '$Rev$';
$SVNr =~ s/^\$Rev: //;
$SVNr =~ s/ \$$//;
my $VERSION = "0.2.$SVNr";

#############################################################################
# Plack -- Web Server Interface
use Encode;
use Plack::Request;
use Plack::Response;
#############################################################################

#############################################################################
# Unicode::CaseFold.pm -- Case Insensitive Sort needs Unicode's CaseFold
use Unicode::CaseFold;
# For Docker - (based on perl image), we need
#       RUN apt-get update
#       RUN apt-get install -y libunicode-casefold-perl
#############################################################################

# Instead of doing fancy stuff to get a minimum value from a list...
use List::Util qw/min max/;


#
# C O L O R S
#
# The files, and information for those files are found in
# FileInfo
#

#############################################################################
## opt
## ########
## $opt->{'env'} -- env as passed by PSGI)
## $opt->{'req'} -- Plack::Request->new()
## $opt->{'type'} -- Body Type
## $opt->{'errstr'} -- Errors
## $opt->{'warnstr'} -- Warnings will only be printed if type remains html
## $opt->{'body'} -- String to output
## $opt->{'wanted'} -- from path_info
## $opt->{'red'}        -- red value
## $opt->{'green'}      -- green value
## $opt->{'blue'}       -- blue value
## $opt->{'mode'}       -- link request mode
##                                    $opt->{'height'}     -- image height
##                                    $opt->{'width'}      -- image width
## $opt->{'byname'}     -- color name requested
## $opt->{'colorlist'}  -- color list requested
## $opt->{'filter'}     -- color filter requested
## $opt->{'tintshades'} -- number of shades/tints to display (html-output)
#############################################################################

my $app = sub {
    my $opt = {};
    $opt->{'env'} = shift;
    $opt->{'type'} = 'text/html';
    my $req = Plack::Request->new($opt->{'env'});
    my $res = Plack::Response->new(200);
    $opt->{'req'} = $req;

    # This ALSO initializes other things, it's important to run near the top.
    fillOpt($opt);

    process($opt);

    if ( q{text/html} eq $opt->{'type'} ) {
        $opt->{'body'} = encode_utf8($opt->{'body'});
    }

    if ( ( exists ( $opt->{'errstr'} ) )
        && ( length ( $opt->{'errstr'} ) ) ) {
            $res->content_type( 'text/html' );
            $res->body( $opt->{'errstr'} );
    }
    else {
            $res->content_type( $opt->{'type'} );
            $res->body( $opt->{'body'} );
    }

    return $res->finalize();
};

#############################################################################
# THIS runs at startup.  Things that only need to be done once.
#############################################################################
INIT: {
    # Initialize _fileInfo();
    initFileInfo();

    return $app;
}

sub process {

    my $opt = shift;
    my $wanted = $opt->{'wanted'};
    $wanted =~ s{^/*}{};

    if ( $wanted eq q{} ) {
        # Nobody wants anything, they are either testing (maybe),
        #   or they are don't know what they are doing, let
        #   them play...
        goColor($opt);
    }
    elsif ( q{colordump} eq $opt->{'mode'} ) {
        goColor($opt);
    }
    elsif ( q{colorlist} eq $opt->{'mode'} ) {
        goColor($opt);
    }
    elsif ( q{info} eq $opt->{'mode'} ) {
        dumpPage($opt);
    }
    elsif ( q{coords} eq $opt->{'mode'} ) {
        goCoordinates($opt);
    }
    elsif ( q{colorinfo} eq $opt->{'mode'} ) {
        goColorInfo($opt);
    }
    else {
        goColor($opt);
    }
}


sub fillOpt
{
    my $opt = shift;
    my $req = $opt->{'req'};

    my $wanted = $req->path_info();
    $opt->{'wanted'} = $wanted;

    my @colors = ();
    my ( $mode, $height, $width, $byname, $list, $filter, $tintshades ) = ();

OPT:
    foreach my $arg ( split( m{[/,]}, $wanted ) ) {
        if ( $arg =~ m/^$/ ) {
            next OPT;
        }
        elsif ( $arg =~ m/^m:(\S+)$/i ) {
            $mode = $1;
        }
        elsif ( $arg =~ m/^h:(\d+)$/i ) {
            $height = $1;
        }
        elsif ( $arg =~ m/^w:(\d+)$/i ) {
            $width = $1;
        }
        elsif ( $arg =~ m/^r:(\S+)$/i ) {
            $colors[0] = numericInput($1);
        }
        elsif ( $arg =~ m/^g:(\S+)$/i ) {
            $colors[1] = numericInput($1);
        }
        elsif ( $arg =~ m/^b:(\S+)$/i ) {
            $colors[2] = numericInput($1);
        }
        elsif ( $arg =~ m/^c:([A-Fa-f0-9]+)$/i ) {
            my $rgb = $1;
            @colors = rgbHtmlStyle($rgb);
        }
        elsif ( $arg =~ m/^n:(.*)/i ) {
            my $name = $1;
            utf8::decode($name);
            $byname = unescape($name);
        }
        elsif ( $arg =~ m/^l:(.*)/i ) {
            my $name = $1;
            utf8::decode($name);
            $list = unescape($name);
        }
        elsif ( $arg =~ m/^f:(.*)/i ) {
            my $name = $1;
            utf8::decode($name);
            $filter = unescape($name);
            if ( $filter =~ m{[\[\]/\\\(\)]} ) {
                $filter = undef;
            }
        }
        elsif ( $arg =~ m/^[ts]:(\S+)$/i ) {
            $tintshades = numericInput($1);
        }
        elsif ( $arg !~ m/^[a-z]:.+$/i ) {
            push @colors, ( numericInput($arg) );
        }
        elsif ( $arg =~ m/^[^\:]*$/i ) {
            my $name = $1;
            utf8::decode($name);
            $byname = unescape($name);
        }
    }

    # Fix Height and Width Here...
    if ( $width && $height ) {
        if ( 100 > $height ) {
            $height = 100;
        }
        if ( 120 > $width ) {
            $width = 120;
        }
        if ( $width && $height ) {
            # Keep Larger offered value
            if ( ( 1.2 * $height ) > $width ) {
                $width = 0;
            }
            if ( ( 1.2 * $height ) < $width ) {
                $height = 0;
            }
        }
    }
    if ( !$width && !$height ) {
        $height = 600;
        $width = 1.2 * $height;
    }
    if ( !$width ) {
        if ( 100 <= $height ) {
            $width = 1.2 * $height;
        }
        else {
            # MINIMUM SIZE
            $height = 100;
            $width = 120;
        }
    }
    if ( !$height ) {
        if ( 120 <= $width ) {
            $height = $width / 1.2;
            if ( $height != int( $height ) ) {
                $height = 1 + int( $height );
            }
        }
        else {
            # MINIMUM SIZE
            $height = 100;
            $width = 120;
        }
    }

    foreach ( $colors[0,1,2] ) {
        if ( ! defined $_ ) {
            $_ = 255;
        }
    }

    my ($red, $green, $blue) = @colors;

    $opt->{'red'}        = $red;
    $opt->{'green'}      = $green;
    $opt->{'blue'}       = $blue;
    $opt->{'mode'}       = $mode;
    $opt->{'height'}     = $height;
    $opt->{'width'}      = $width;
    $opt->{'byname'}     = $byname;
    $opt->{'colorlist'}  = $list;
    $opt->{'filter'}     = $filter;
    $opt->{'tintshades'} = $tintshades || 10;
}


# mode 'colordump'
sub goColor
{
    my $opt = shift;
    my $me = mebase($opt);
    #my $me = $opt->{'req'}->base();
    #$me =~ s{/$}{}; # remove trailing slash (if there is one).
    my $list = $opt->{'colorlist'};
    my $l = q{};
    if ( $list && length($list) ) {
        $l = qq{/l:$list};
    }
    my $f = $opt->{'filter'};
    if ( $f && length($f) ) {
        $me .= qq{/f:$f};
    }
    my $debug_info = q{};

    my $namergb = populateRGBNames($opt);

    my @list = colorNames($opt);
    my $colorcount = scalar(@list);

    #$debug_info .= sprintf("Color list has %d colors.\n", scalar(@list) );

# The x row layout is for creating a colormap like on WikiPedia
# and requires that a system-specific color list is chosen.
# not sure how I want to implement this yet ( counting the colors is a hack.
#    if ( 510 == $colorcount ) {
#        # 8 Row Layout
#    }

    my $clrlist = htmfColorList($opt);
    my $credit  = listCredit($list);

    $opt->{'type'} = 'text/html';
    $opt->{'body'} = <<PAGE ;
<!DOCTYPE html>
<head>
    <title>GD ColorMix : Source List</title>
    <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
<script>
 // <![CDATA[
    function clrlist() {
        var el = document.getElementById('rgblist').c;
        var selIx = el.selectedIndex; 
            window.location = '$me/m:colordump/l:' + el.value;
    }
 // ]]>
</script>
<style media="screen">
<!--

.shade:hover,.tint:hover {
    background-color: #808080;
}


-->
</style>
</head>
<body>
    <h2>GD_ColorMix.cgi : Source List</h2>

<!--
  $VERSION
  $debug_info
 -->

    <p>
        This is a colordump page listing $colorcount colors:
        <a href="$me/m:colordump$l">$me/m:colordump$l</a><br />
        Selecting a color from a list will send you to a colormix
        view for that color.
    </p>
    $credit
    <p>
        This page started out as a demonstration of Perl's GD library
        but has become larger and much more useful than that over time.
        The source (but not the colors themselves) can be found on the
        <a href="http://www.home.vollink.com/gary/perl/colormix.html">original
        demonstration page</a>.
    </p>

    <form id="rgblist" action="">
    <p>
        <select name="c" onchange="clrlist()">
$clrlist
        </select>
        Select a color list (changes the list below).
    </p>
    </form>
PAGE


    foreach my $color ( sort keys %{$namergb} ) {
        if ( exists( $namergb->{$color} ) ) {
            my $c = $namergb->{$color}->{'c'};
            $opt->{'body'} .= htmfColorText($me, $c, $c);
        }
        # utf8::encode($color);
        $opt->{'body'} .= $color . qq{<br />\n\n};
    }

    $opt->{'body'} .= qq{</body></html>\n};
}

sub dumpPage
{
    my $opt = shift;
    # Present an HTML that will allow user to select the color.
    my $me = mebase($opt);

    my $gds = $me;
    $gds =~ s{gd_colormix}{gd_colormix_graphic};
    if ( $me =~ m{vollink.com} ) {
        $gds = q{https://home.vollink.com/cgi-bin/gd_colormix_graphic};
    }
    elsif ( $me =~ m{vollink.nyc} ) {
        $gds = q{https://www.vollink.nyc/cgi-bin/gd_colormix_graphic};
    }

    populateRGBNames($opt);

    my $r = $opt->{'red'};
    my $g = $opt->{'green'};
    my $b = $opt->{'blue'};
    my $t = $opt->{'tintshades'};
    my $l = $opt->{'colorlist'};
    my $w = $opt->{'width'} || q{};
    my $h = $opt->{'height'} || q{};

    foreach ( $r, $g, $b ) {
        if ( ! defined $_ ) {
            $_ = 127;
        }
    }

    my $usrclr = sprintf("%02x%02x%02x", $r, $g, $b);

    # Filter is ALWAYS part of $me
    my $filter = $opt->{'filter'};
    if ( $filter && length($filter) ) {
        $me .= qq{/f:$filter};
    }

    my @hlight_rgb = primaryOpposite($r,$g,$b);
    my $hlight = sprintf("%02x%02x%02x",
         percentTint(20, @hlight_rgb));

    # These can be overridden in JavaScript
    if ( $l && length($l) ) {
        $l = qq{/l:$l};
    }
    my $wh = q{};
    if ( $w && length($w ) ) {
        $wh = qq{/w:$w};
    }
    elsif ( $h && length($h ) ) {
        $w = ( 1.2 * $h );
        $wh = qq{/w:$w};
    }
    my $th = qq{/t:$t};

    my $self_ref_uri = qq{$me$l$wh$th};
    $opt->{'self_ref_uri'} = $self_ref_uri;

    my $more_info = color_more_info($opt);


    my $htmf_coords = coordinate_map($opt, $r, $g, $b);


    my $options = htmfRGBOptions($opt, $r, $g, $b);
    my $clrlist = htmfColorList($opt);

    $opt->{'type'} = q{text/html};
    $opt->{'body'} = <<PAGE ;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
    <title>GD_ColorMix.cgi</title>
    <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />

<script>
 // <![CDATA[
	var r = $r;
	var g = $g;
	var b = $b;
    var newclr = "$usrclr";
    var width = "$wh";
    var tcx = "$th";
	imNow = new Image(); imNow.src = '$gds$wh/c:' + newclr;
    function newimage() {
        newclr = document.getElementById('colors').chex.value;
		imNow.src = '$gds' + width + '/c:' + newclr;
		document.images.graph.src=imNow.src;
        loadCoords();
    }
    function newcolor() {
        newimage();
        loadMoreInfo();
    }
	function chkrgb() {
		r = document.getElementById('colors').red.value;
		g = document.getElementById('colors').green.value;
		b = document.getElementById('colors').blue.value;
        if ( 0 == r.length ) {
            r = 0;
        }
        if ( 0 == g.length ) {
            g = 0;
        }
        if ( 0 == b.length ) {
            b = 0;
        }
		if ( 0 > r ) {
			r = 0;
		}
		if ( 0 > g ) {
			g = 0;
		}
		if ( 0 > b ) {
			b = 0;
		}
		if ( 255 < r ) {
			r = 255;
		}
		if ( 255 < g ) {
			g = 255;
		}
		if ( 255 < b ) {
			b = 255;
		}
        xr = parseInt(r).toString(16);
        xg = parseInt(g).toString(16);
        xb = parseInt(b).toString(16);
        if ( 1 == xr.length ) {
            xr = "0" + xr;
        }
        if ( 1 == xg.length ) {
            xg = "0" + xg;
        }
        if ( 1 == xb.length ) {
            xb = "0" + xb;
        }
        newclr = xr + xg + xb;
		document.getElementById('colors').red.value = r;
		document.getElementById('colors').green.value = g;
		document.getElementById('colors').blue.value = b;
        document.getElementById('colors').chex.value = newclr;
	}
    function goww() {
		width = '/w:' + document.getElementById('colors').ww.value;
        newimage();
		document.getElementById('colors').ts.focus();
    }
	function gorgb() {
		chkrgb();
        newcolor();
		document.getElementById('colors').chex.focus();
	}
    function gochex() {
        newclr = document.getElementById('colors').chex.value;
        r = newclr.substr(0,2);
        g = newclr.substr(2,2);
        b = newclr.substr(4,2);
        r = parseInt(r, 16);
        g = parseInt(g, 16);
        b = parseInt(b, 16);
		document.getElementById('colors').red.value = r;
		document.getElementById('colors').green.value = g;
		document.getElementById('colors').blue.value = b;
        newcolor();
		document.getElementById('colors').ww.focus();
    }
	function clrlist() {
		var el = document.getElementById('rgblist').c;
		var selIx = el.selectedIndex; 
		window.location = '$me$wh$th/l:' + el.value + '/m:info/c:$usrclr';
	}
    function chktcx() {
		newtcx = '/t:' + document.getElementById('colors').ts.value;
        if ( tcx != newtcx ) {
            loadMoreInfo();
        }
		document.getElementById('colors').rgblist.focus();
    }
    function gotcx() {
        chktcx();
    }
	function choice() {
		var el = document.getElementById('clrxname').c;
		var selIx = el.selectedIndex; 
		var ocname = el.options[selIx].innerHTML;
		var cname = ocname.replace('&nbsp;(aka) ','');
		tcx = '/t:' + document.getElementById('colors').ts.value;
		width = '/w:' + document.getElementById('colors').ww.value;
		window.location = '$me$l' + width + tcx + '/m:info/c:' + el.value + '/n:' + cname;
	}
	function redo_rgb() {
        chkrgb();
        redo_html();
	}
	function redo_html() {
		chex = document.getElementById('colors').chex.value;
		tcx = '/t:' + document.getElementById('colors').ts.value;
		width = '/w:' + document.getElementById('colors').ww.value;
		window.location = '$me$l' + width + tcx + '/m:info/c:' + chex;
	}
    function loadCoords() {
		chex = document.getElementById('colors').chex.value;
        cmurl = '$me$l/m:coords' + width + '/c:' + chex;
        var xhttp = new XMLHttpRequest();
        xhttp.onreadystatechange = function() {
            if (this.readyState == 4 && this.status == 200) {
                document.getElementById('coords').innerHTML = this.responseText;
            }
        };
        xhttp.open("GET", cmurl );
        xhttp.send();
    }
    function loadMoreInfo() {
		chex = document.getElementById('colors').chex.value;
		tcx = '/t:' + document.getElementById('colors').ts.value;
        cmurl = '$me$l/m:colorinfo' + width + tcx + '/c:' + chex;
        var xhttp = new XMLHttpRequest();
        xhttp.onreadystatechange = function() {
            if (this.readyState == 4 && this.status == 200) {
                document.getElementById('more_info').innerHTML = this.responseText;
            }
        };
        xhttp.open("GET", cmurl );
        xhttp.send();
    }
 // ]]>
</script>

<style media="screen">
<!--

.shade:hover,.tint:hover {
    background-color: #$hlight;
}


-->
</style>

</head>
<body>
    <h2>GD_ColorMix.cgi Color Page:</h2>
<a name="top"></a>
    <form id="colors" action="">
    <table>
        <tr>
            <th>Red</th><th>Green</th><th>Blue</th><th>&nbsp;</th>
            <th>&nbsp;</th>
            <th>Hex</th><th>&nbsp;</th>
            <th>&nbsp;</th>
            <th>Mix Width</th><th>&nbsp;</th>
            <th>&nbsp;</th>
            <th>Html Shades</th><th>&nbsp;</th>
        </tr>
        <tr><td>
            <input id="red" name="red" type="text" size="4" value="$r" onfocus="chkrgb()" />
        </td><td>
            <input id="green" name="green" type="text" size="4" value="$g" onfocus="chkrgb()" />
        </td><td>
            <input id="blue" name="blue" type="text" size="4" value="$b" onfocus="chkrgb()" />
        </td><td>
            <input id="n" name="n" type="text" size="2" value="Go"
                onfocus="gorgb()"
                onclick="redo_rgb()"
                />
        </td><td>
        &nbsp;&nbsp;&nbsp;
        </td><td>
        <input id="chex" name="chex" type="text" size="8" value="$usrclr" />
        </td><td>
        <input id="o" name="o" type="text" size="2" value="Go"
                 onfocus="gochex()"
                 onclick="redo_html()"
                 />
        </td><td>
        &nbsp;&nbsp;&nbsp;
        </td><td>
        <input id="ww" name="ww" type="text" size="3" value="$w" />
        </td><td>
        <input id="q" name="q" type="text" size="2" value="Go"
                 onfocus="goww()"
                 onclick="redo_html()"
                 />
        &nbsp;&nbsp;&nbsp;
        </td><td>
            &nbsp;
        </td><td>
        <input id="ts" name="ts" type="text" size="3" value="$t" />
        </td><td>
        <input id="p" name="p" type="text" size="2" value="Go"
                 onfocus="gotcx()"
                 onclick="gotcx()"
                 />
        </td></tr>
    </table>
    </p>
    </form>
    <form id="rgblist" action="">
    <p>
        <select name="c" onchange="clrlist()">
$clrlist
        </select>
        Select a color list (changes the list below).
    </p>
    </form>
    <form id="clrxname" action="">
    <p>
        <select name="c" onchange="choice()">
        $options
        </select>
        Select a color by name.
    </p>
    </form>
    <p>
    <div id="coords">
$htmf_coords
    </div>
<a name="graph"></a>
        <img id="graph" alt="graph" src="$gds$wh/c:$usrclr" usemap="#colorMix" />
    </p>
    <div id="history">
    </div>
    <p>
    <a name="xtra" />
    </p>
    <div id="more_info">
$more_info
    </div>

</body>
</html>
PAGE
}


sub goColorInfo
{
    my $opt = shift;
    my $out = q{};

    $out = color_more_info($opt);

    $opt->{'type'} = 'text/html';
    $opt->{'body'} = $out;
}


sub goCoordinates
{
    my $opt = shift;
    if ( (! exists($opt->{'self_ref_uri'}) )
        || ( 0 == length($opt->{'self_ref_uri'}) )
        ) {
        my $me = mebase($opt);
        my $w = $opt->{'width'} || q{};
        my $h = $opt->{'height'} || q{};
        my $wh = q{};
        if ( $w && length($w ) ) {
            $wh = qq{/w:$w};
        }
        elsif ( $h && length($h ) ) {
            $w = ( 1.2 * $h );
            $wh = qq{/w:$w};
        }
        my $self_ref_uri = qq{$me$wh};
        $opt->{'self_ref_uri'} = $self_ref_uri;
    }
    my $r = $opt->{'red'};
    my $g = $opt->{'green'};
    my $b = $opt->{'blue'};

    $opt->{'type'} = 'text/html';
    my $out = qq{<!-- VERSION: $VERSION -->\n};
    $out .= coordinate_map($opt, $r, $g, $b);
    $opt->{'body'} = $out;
}

sub htmfColorList
{
    my $opt = shift;
    my $list = $opt->{'colorlist'};

    my $f_sel = 0;
    my $ret = q{};

    my @active = allLists();

    foreach my $llist ( @active ) {
        my $label = listLabel($llist) || $llist;
        my $sel = q{};

        if ( ( defined $list ) && ( length($list) ) ) {
            if ( $list eq $llist ) {
                $sel = qq{ selected};
                $f_sel = 1;
            }
        }
        $ret .= qq{<option value="$llist"$sel>$label</option>};
    }
    my $dosel = q{};
    if ( 0 == $f_sel ) {
        $dosel = qq{ selected};
    }
    $ret .= qq{<option value=""$dosel>All Colors</option>};
    return $ret;
}

sub htmfColorTextBr
{
    my $opt = shift;
    my $clrname = isNamed($opt, $_[2] ) || q{};

    return htmfColorText(@_)
        . $clrname
        . qq{<br />\n};
}

sub htmfColorText
{
    my $uri = shift;
    my $origclr = shift;
    my $new_clr = shift;

    my $ret = q{};
    $ret .= qq{<a href="$uri/m:info/c:$new_clr"};
    $ret .= qq{ style="font-family: monospace;">#$new_clr</a>\n};
    $ret .= qq{<span style="font-family: monospace;};
    $ret .= qq{ background-color: #$new_clr;">};
    $ret .= qq{&nbsp;&nbsp;&nbsp;&nbsp;};
    $ret .= qq{&nbsp;&nbsp;&nbsp;&nbsp;|</span>};
    $ret .= qq{<span style="font-family: monospace;};
    $ret .= qq{ background-color: #$origclr;">};
    $ret .= qq{&nbsp;&nbsp;&nbsp;&nbsp;</span>\n};
    $ret .= qq{<span style="font-family: monospace;">\n};
    $ret .= qq{&nbsp;\n};
    $ret .= sprintf("C:%0.5f M:%0.5f Y:%0.5f K:%0.5f",
                    rgbTOcmyk(rgbHtmlStyle($new_clr))
                  );
    $ret .= qq{&nbsp;|\n};
    $ret .= sprintf("H:%0.1f&deg; (%0.1f&#37;) S:%0.3f V:%0.3f",
                    rgbTOhhsv(rgbHtmlStyle($new_clr))
                  );
    $ret .= qq{&nbsp;|\n};
    $ret .= sprintf("L:%0.5f A:%0.5f B:%0.5f (approx.)",
                    rgbTOlab(rgbHtmlStyle($new_clr))
                  );
    $ret .= qq{\n</span>\n};
    return ($ret);
}


sub color_more_info
{
    my $opt = shift;

    populateRGBNames($opt);
    my $me = mebase($opt);

    my $r = $opt->{'red'};
    my $g = $opt->{'green'};
    my $b = $opt->{'blue'};
    my $t = $opt->{'tintshades'};
    my $l = $opt->{'colorlist'};
    my $w = $opt->{'width'} || q{};
    my $h = $opt->{'height'} || q{};

    # These can be overridden in JavaScript
    if ( $l && length($l) ) {
        $l = qq{/l:$l};
    }
    my $wh = q{};
    if ( $w && length($w ) ) {
        $wh = qq{/w:$w};
    }
    elsif ( $h && length($h ) ) {
        $w = ( 1.2 * $h );
        $wh = qq{/w:$w};
    }
    my $th = qq{/t:$t};
    my $self_ref_uri = qq{$me$l$wh$th};

    my $more_info = qq{<!-- $VERSION -->\n};

    if ( $opt->{'debug'} ) {
        while ( my ( $k, $v ) = each ( %{$opt} ) ) {
            $more_info .= qq{<!-- $k = $v -->\n};
        }
    }

    my $tmpclr = q{};

    $more_info .= qq{<a name="info" />\n};
    $more_info .= qq{<h2>HTML Color:</h2>\n};
    $more_info .= qq{<p>\n};
    my $usrclr = sprintf("%02x%02x%02x", $r, $g, $b);
    my $threes = sprintf("||%3d&nbsp;&nbsp;&nbsp;%3d&nbsp;&nbsp;&nbsp;%3d&nbsp;&nbsp;&nbsp;&nbsp;||", $r, $g, $b);
    $threes =~ s/ /&nbsp;/g;
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $usrclr);

    if ( ! isNamed($opt, $r, $g, $b) ) {
        $more_info .= qq{&nbsp;&nbsp;&nbsp;&nbsp;};
        $more_info .= qq{&nbsp;&nbsp;&nbsp;&nbsp;};
        $more_info .= $threes;
        $more_info .= qq{<br />\n};
    }

    $more_info .= qq{</p>\n};
    $more_info .= qq{<h2>Wheel Complement:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    wheelComplement($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);

    my @hlight_rgb = primaryOpposite($r,$g,$b);
    my $hlight = sprintf("%02x%02x%02x",
         percentTint(20, @hlight_rgb));

    my $tsCx = $opt->{'tintshades'};
    my $tsDx = ( 100 / $tsCx );

    $more_info .= qq{</p>\n};
    $more_info .= qq{<a name="shade"></a>\n};
    $more_info .= qq{<!-- Increment/Decrement: $tsDx -->\n};
    $more_info .= qq{<h2 title="$tsCx colors fading to black">Shade Color:</h2>\n};
    $more_info .= qq{<p>\n};
    for ( my $p = (100 - $tsDx); $p >= 0; $p -= $tsDx ) {
        $more_info .= qq{<span class="shade">\n};
        $tmpclr = sprintf("%02x%02x%02x",
                        percentShade($p, $r, $g, $b));
        #$more_info .= qq{<!-- Percentage: $p -->\n};
        $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);
        $more_info .= qq{</span>\n};
    }

    $more_info .= qq{</p>\n};
    $more_info .= qq{<a name="tint"></a>\n};
    $more_info .= qq{<h2 title="$tsDx colors tint to white">Tint Color:</h2>\n};
    $more_info .= qq{<p>\n};
    for ( my $p = (100 - $tsDx); $p >= 0; $p -= $tsDx ) {
        $more_info .= qq{<span class="tint">\n};
        $tmpclr = sprintf("%02x%02x%02x",
                        percentTint($p, $r, $g, $b));
        $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);
        $more_info .= qq{</span>\n};
    }

    $more_info .= qq{</p>\n};
    $more_info .= qq{<a name="isolate" />\n};
    $more_info .= qq{<h2 title="Red and Green">Yellow Isolated:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    yellowIsolate($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);

    $more_info .= qq{</p>\n};
    $more_info .= qq{<h2 title="Green and Blue">Cyan Isolated:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    cyanIsolate($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);

    $more_info .= qq{</p>\n};
    $more_info .= qq{<h2 title="Red and Blue">Magenta Isolated:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    magentaIsolate($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);

    $more_info .= qq{</p>\n};
    $more_info .= qq{<a name="opposite" />\n};
    $more_info .= qq{<h2 title="Color and Hue swapped">Color Opposite:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    colorOpposite($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);

    $more_info .= qq{</p>\n};
    $more_info .= qq{<h2 title="Black, White, Red, Green, Blue, Yellow, Magenta or Cyan">Primary Colored Opposite:</h2>\n};
    $more_info .= qq{<p>\n};
    $tmpclr = sprintf("%02x%02x%02x",
                    primaryOpposite($r, $g, $b));
    $more_info .= htmfColorTextBr($opt, $self_ref_uri, $usrclr, $tmpclr);
    $more_info .= qq{</p>\n};

    return $more_info;
}

sub coordinate_map
{
    my $opt = shift;
    my ( $r, $g, $b ) = @_;

    my $self_ref_uri = $opt->{'self_ref_uri'};
    my $htmf_coords = qq{<map name="colorMix">\n};
    foreach my $index ( 0 .. 19 ) {
        my $name_i = qq(shade${index});
        my $coordTxt = sprintf( "%d,%d,%d,%d", cMixGeom($opt, 'shadebox', $index) );
        my $tmpclr = sprintf("%02x%02x%02x",
                        percentShade(100 - (5 * (1 + $index)), $r, $g, $b) );
        my $tmpuri = $self_ref_uri . qq{/m:info/c:$tmpclr/};
        $htmf_coords .= qq{    <area shape="rect"};
        $htmf_coords .=          qq{ coords="$coordTxt"};
        $htmf_coords .=            qq{ href="$tmpuri"};
        $htmf_coords .=             qq{ alt="$name_i"};
        $htmf_coords .= qq{ />\n};
    }
    $htmf_coords .= qq{</map>\n};

    return $htmf_coords;
}


sub rgbHtmlStyle
{
    my $str = shift;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    $str =~ s/^0x//;

    my @c  = ();
    my $ax = 0;

    if ( 3 == length($str) ) {
        $ax = 1;
    }
    elsif ( 6 == length($str) ) {
        $ax = 2;
    }
    else {
        return @c;
    }

    for ( my $cx = 0; $cx < ( 3*$ax ); $cx += $ax ) {
        my $num = substr($str,$cx,$ax);
        if ( 1 == length($num) ) {
            $num = "${num}${num}";
        }
        push @c, ( numericInput(q{0x}.${num}) );
    }

    return @c;
}


sub numericInput
{
    my $input = shift;
    if ( $input =~ m/^0x([0-9a-fA-F]+)$/ ) {
        $input = hex($1);
    }
    elsif ( $input =~ m/^#([0-9a-fA-F]+)$/ ) {
        $input = hex($1);
    }
    elsif ( $input =~ m/^(\d+)%$/ ) {
        $input = int( 2.55 * $input );
    }
    elsif ( int($input) != $input ) {
        if (( 0 < $input) && (1 > $input)) {
            $input = int( 255 * $input );
        }
        else {
            $input = 255;
        }
    }

    if ( $input < 0 ) {
        $input = 0;
    }
    elsif ( $input > 255 ) {
        $input = 255;
    }
    elsif ( $input !~ m/^\d+$/ ) {
        $input = 0;
    }

    return $input;
}


# sort case-insensitively (See CaseFold comment above)
sub foldedCmp {
    #my ( $a, $b ) = @_;
    my $AA = fc($a);
    my $BB = fc($b);
    my $test = ( $AA cmp $BB );
    #print {*STDERR} qq{$test = ( "$a" cmp "$b" );\n};
    return ($test);
}

# This is a very simple utility that determines if there is something
# already in $start, and if so, it adds a space before appending $add.
#
# The magic is in the prototype (which I don't use anywhere else).
# The prototype specifies that I want a reference to the first variable
# (not a copy of its contents).  Then I want a copy of the contents of the
# second variable.  (Because it's a prototype, calling without two arguments
# will cause a syntax error).  perldoc.perl.org/perlsub.html#Prototypes
#
# In this way, the first variable passed will be modified without the caller
# having to explicitly assign it.
sub concat_w_sp (\$$)
{
    my $start = shift;
    my $add = shift;

    return undef if ( ! $start );
    return undef if ( q{SCALAR} ne ref($start) );
    return ${$start} if ( ! $add );
    return ${$start} if ( ! length($add) );

    if ( 0 == length( ${$start} ) ) {
        ${$start} = $add;
    }
    else {
        ${$start} .= q{ } . $add;
    }
}


sub mebase
{
    my $opt = shift;
    my $out = $opt->{'req'}->base();
    $out =~ s{^http://www.vollink.nyc}{https://www.vollink.nyc}; # Force https
    $out =~ s{^http://www.vollink.com}{https://www.vollink.com};
    $out =~ s{^http://www.home.vollink.com}{https://www.home.vollink.com};
    $out =~ s{^http://home.vollink.com}{https://home.vollink.com};
    $out =~ s{/+$}{};  # Remove trailing slashes.
    return $out;
}


{
    # RGB color lists are managed per file/index and are saved
    # persistently.
    # This is safe, as long as everything that needs a per
    # file/index list uses the right version.

    my %rgb = ();
    my @rgbnames = ();
    my %listrgb = ();
    my %c2name = ();
    my %_fileInfo = ();
    my @all_lists = ();

    sub initFileInfo {
        %_fileInfo = (
                'rgb' => {
                    'ft'        => [ qw{ 
                            /usr/share/X11/rgb.txt
                            /Applications/MacVim.app/Contents/Resources/vim/runtime/rgb.txt
                            /opt/X11/share/X11/rgb.txt
                            /usr/share/emacs/22.1/etc/rgb.txt
                        } ],
                    'label'     => q{X11/Web Default},
                    'credit'    => q{<p>X11 colors, X Consortium.</p>},
                },
            );
        #@all_lists = keys %_fileInfo;
        @all_lists = qw(
            rgb
            );

        read_conf();
    } # End initFileInfo (inits %_fileInfo hash)

    ########################################
    # read_conf
    #
    # Very simple parser for the configuration of additional colors files.
    # The built-in 'rgb' entry (as initialized above) would look as follows:
    # rgb:
    #    filelist=
    #            /usr/share/X11/rgb.txt
    #            /Applications/MacVim.app/Contents/Resources/vim/runtime/rgb.txt
    #            /opt/X11/share/X11/rgb.txt
    #            /usr/share/emacs/22.1/etc/rgb.txt
    #    label= X11/Web Default
    #    credit=<p>X11 colors, X Consortium.</p>
    ########################################
    sub read_conf {
        my $fn = shift;
        my $fh = undef;

        my $state = q{none};
        my $var = q{none};

        if ( !defined( $fn ) ) {
            if ( -f q{../rgb/rgb.conf} ) {
                $fn = q{../rgb/rgb.conf};
            }
            else {
                $fn = q{./rgb/rgb.conf};
            }
        }

        if ( open( $fh, '<:encoding(utf8)', $fn ) ) {
CNF:        foreach my $line ( <$fh> ) {
                # Kill comments.
                $line =~ s/\s#\s.*$//;
                $line =~ s/^#\s.*$//;
                # Kill pre-whitespace and post whitespace
                $line =~ s/^\s*//;
                $line =~ s/\s*$//;

                if ( q{} eq $line ) {
                    next CNF;
                }
                elsif ( $line =~ m/^lists:$/i ) {
                    $state = q{lists};
                    $var = q{none};
                    next CNF;
                }
                elsif ( $line =~ m/^(.*?):$/ ) {
                    $state = lc($1);
                    $_fileInfo{$state} = {};
                    $var = q{none};
                    next CNF;
                }
                elsif ( q{lists} eq $state ) {
                    push @all_lists, ( lc($line) );
                    next CNF;
                }
                elsif ( q{none} eq $state ) {
                    next CNF;
                }
                elsif ( $line =~ m/^filelist=/ ) {
                    $var = 'ft';
                    if ( ! exists( $_fileInfo{$state}->{'ft'} ) ) {
                        $_fileInfo{$state}->{'ft'} = [];
                    }
                    $line =~ s/^filelist=//;
                }
                elsif ( $line =~ m/^label=/ ) {
                    $var = 'label';
                    if ( ! exists( $_fileInfo{$state}->{'label'} ) ) {
                        $_fileInfo{$state}->{'label'} = q{};
                    }
                    $line =~ s/^label=//;
                }
                elsif ( $line =~ m/^credit=/ ) {
                    $var = 'credit';
                    if ( ! exists( $_fileInfo{$state}->{'credit'} ) ) {
                        $_fileInfo{$state}->{'credit'} = q{};
                    }
                    $line =~ s/^credit=//;
                }

                # Kill pre-whitespace and post whitespace
                $line =~ s/^\s*//;
                $line =~ s/\s*$//;

                if ( q{} eq $line ) {
                    next CNF;
                }
                if ( q{none} eq $var ) {
                    next CNF;
                }
                elsif ( ( q{none} ne $state ) && ( q{ft} eq $var ) ) {
                    push @{$_fileInfo{$state}->{'ft'}}, ($line);
                    next CNF;
                }
                elsif ( ( q{none} ne $state ) && ( q{label} eq $var ) ) {
                    concat_w_sp( $_fileInfo{$state}->{'label'}, $line );
                    next CNF;
                }
                elsif ( ( q{none} ne $state ) && ( q{credit} eq $var ) ) {
                    concat_w_sp( $_fileInfo{$state}->{'credit'}, $line );
                    next CNF;
                }
            }
        }
#        else {
#            print {*STDERR} "File, $fn, not found: $!\n";
#        }
    } # End read_conf ( reads and parses color file configuration file )

    sub allLists {
        return @all_lists;
    }

    sub activeLists {
        my @lists = ();
LBa:    foreach my $list ( @all_lists ) {
            if ( exists ( $_fileInfo{$list}->{'index'} ) ) {
                push @lists, ( $list );
            }
        }
        return @lists;
    }

    sub rgbValidList {
        my $opt = shift;
        my $index = shift || 0;
        my $found = -1;
LB:     foreach my $list ( @all_lists ) {
#print {*STDERR} "rgbValidList: $list...    \n";
            if ( ! exists ( $_fileInfo{$list}->{'ft'} ) ) {
                print {*STDERR} "rgbValidList: List, $list: no 'ft' (files).\n";
                next LB;
            }
            next LB if ( ! exists ( $_fileInfo{$list}->{'ft'} ) );
            if ( exists ( $_fileInfo{$list}->{'filename'} ) ) {
                $found++;
                if ( $found == $index ) {
                    return $list;
                }
                next LB;
            }
            foreach my $f ( @{$_fileInfo{$list}->{'ft'}} ) {
#print {*STDERR} "rgbValidList: $list, File $f.\n";
                if ( ( -e $f ) && ( -r $f ) ) {
#print {*STDERR} "rgbValidList: Found $f.\n";
                    $found++;
                    if ( $found == $index ) {
#print {*STDERR} "rgbValidList: Found $f for $index.\n";
                        $_fileInfo{$list}->{'index'} = $index;
                        $_fileInfo{$list}->{'filename'} = $f;
                        return $list;
                    }
                }
            }
        }
        return undef;
    }

    sub populateRGBNames {
        my $opt = shift;
        my $list = $opt->{'colorlist'};
        my $llist = q{};

        if ( %rgb && scalar( %rgb ) ) {
            if ( ( defined $list ) && ( length($list) ) ) {
                if ( exists ( $listrgb{$list} ) ) {
                    return \%{$listrgb{$list}};
                }
            }
            else {
                return \%rgb;
            }
        }

        my $fn   = undef;
        my $f_cx = 0;

        while ( $llist = rgbValidList($opt, $f_cx) ) {
            populateRGBNames_onelist($opt, $llist);
            $f_cx++;
        }

        foreach my $clrname ( keys %rgb ) {
            my $looplist = $rgb{$clrname}->{'source'};
            if ( ! exists( $listrgb{$looplist} ) ) {
                $listrgb{$looplist} = {};
            }
            if ( ! exists( $listrgb{$looplist}->{$clrname} ) ) {
                $listrgb{$looplist}->{$clrname} = {};
            }
            $listrgb{$looplist}->{$clrname}->{'red'} = $rgb{$clrname}->{'red'};
            $listrgb{$looplist}->{$clrname}->{'green'} = $rgb{$clrname}->{'green'};
            $listrgb{$looplist}->{$clrname}->{'blue'} = $rgb{$clrname}->{'blue'};
            $listrgb{$looplist}->{$clrname}->{'c'} = $rgb{$clrname}->{'c'};
            $listrgb{$looplist}->{$clrname}->{'notes'} = $rgb{$clrname}->{'notes'};
            $listrgb{$looplist}->{$clrname}->{'source'} = $rgb{$clrname}->{'source'};
        }

        if ( ( defined $list ) && ( length($list) ) ) {
            if ( exists ( $listrgb{$list} ) ) {
                return \%{$listrgb{$list}};
            }
        }

        return \%rgb;
    }


    sub populateRGBNames_onelist {
        my $opt = shift;
        my $list = shift;
        my $fh = undef;
        my $fn = listFilename($list);
        my $sectmark = "§";
        utf8::decode($sectmark);

        if ( exists $listrgb{$list} ) {
            print {*STDERR} "List $list already read, yet reading file $fn.\n";
        }

        open( $fh, '<:encoding(utf8)', $fn )
            or print {*STDERR} "Unable to open list ($list) filename $fn: $!\n";
READ:   foreach my $line ( <$fh> ) {
            $line =~ s/^\s+//;
            $line =~ s/\s+$//;
            if ( $line =~ m/^$/ ) {
                next READ;
            }
            if ( $line =~ m/^#/ ) {
                next READ;
            }
            if ( $line =~ m/^!/ ) {
                next READ;
            }
            my ( $r, $g, $b, $xtra ) = split( m/\s+/, $line, 4 );
            my ( $name, $notes ) = split( m/\s+$sectmark\s+/, $xtra, 2 );
            utf8::decode($name);
            utf8::decode($notes);
            $name =~ s[/][-]g;
            uniqueNameRGB( $list, $name, $r, $g, $b, $notes );
        }
        close ( $fh );
    }

    sub uniqueNameRGB {
        my ( $list, $name, $r, $g, $b, $notes ) = @_;
        my $hex   = sprintf("%02x%02x%02x", $r, $g, $b);
        my $count = 1;

        if ( exists( $c2name{$hex} ) ) {
            foreach my $chknm ( @{$c2name{$hex}} ) {
                if ( $name eq $chknm ) {
                    return $name;
                }
            }
        }

        if ( exists( $rgb{$name} ) ) {
            if (   ( $rgb{$name}->{'red'} == $r ) 
                && ( $rgb{$name}->{'green'} == $g ) 
                && ( $rgb{$name}->{'blue'} == $b ) ) {
                # This didn't exist above for some reason.
                push @{$c2name{$hex}}, ( $name );
                return $name;
            }
            my $try = "${name} (${list})";
            while ( exists( $rgb{${try}} ) ) {
                $count++;
                $try = "${name}__${count}";
            }
            $name = "${try}";
        }

        push @rgbnames, ( $name );
        $rgb{$name}->{'red'}   = 0+$r;
        $rgb{$name}->{'green'} = 0+$g;
        $rgb{$name}->{'blue'}  = 0+$b;
        $rgb{$name}->{'c'}     = $hex;
        $rgb{$name}->{'notes'} = $notes;
        $rgb{$name}->{'source'} = $list;
        if ( ! exists( $c2name{$hex} ) ) {
            $c2name{$hex}        = [ $name ];
        }
        else {
            push @{$c2name{$hex}}, ( $name );
        }

        return $name;
    }

    sub isColor {
        my $name = shift;
        # utf8::decode($name);
        $name =~ s[/][-]g;
        my ( $r, $g, $b ) = @_;

        if ( exists( $rgb{$name} ) ) {
            $r = $rgb{$name}->{'red'};
            $g = $rgb{$name}->{'green'};
            $b = $rgb{$name}->{'blue'};
            return ( $r, $b, $g );
        }

        return undef;
    }

    sub nameNotes {
        my $name = shift;
        # utf8::decode($name);
        $name =~ s[/][-]g;

        if ( exists( $rgb{$name} ) ) {
            my $s = $rgb{$name}->{'notes'};
            return ( $s );
        }

        return undef;
    }

    sub nameSource {
        my $name = shift;
        # utf8::decode($name);
        $name =~ s[/][-]g;

        if ( exists( $rgb{$name} ) ) {
            my $s = $rgb{$name}->{'source'};
            return ( $s );
        }

        return undef;
    }

    sub listLabel {
        my $list = shift;
        my $ret = undef;
        if ( $list && length($list) ) {
            if ( exists( $_fileInfo{$list}->{'label'} ) ) {
                $ret = $_fileInfo{$list}->{'label'};
            }
        }
        return $ret;
    }

    sub listFilename {
        my $list = shift;
        my $ret = undef;
        if ( $list && length($list) ) {
            $ret = undef;
            if ( exists( $_fileInfo{$list}->{'filename'} ) ) {
                $ret = $_fileInfo{$list}->{'filename'};
            }
        }
        return $ret;
    }

    sub listCredit {
        my $lbl = shift;
        my $ret = qq{<!-- No lbl -->};
        if ( $lbl && length($lbl) ) {
            $ret = qq{<!-- Not found: [$lbl] -->};
            if ( exists( $_fileInfo{$lbl}->{'credit'} ) ) {
                $ret = $_fileInfo{$lbl}->{'credit'};
            }
        }
        else {
            foreach my $nlbl ( @all_lists ) {
                if ( exists( $_fileInfo{$nlbl}->{'credit'} ) ) {
                    $ret .= $_fileInfo{$nlbl}->{'credit'};
                }
            }
        }
        return $ret;
    }

    sub indexList {
        my $index = shift;
        my $ret = q{};
        foreach my $list ( @all_lists ) {
            if ( $index == $_fileInfo{$list}->{'index'} ) {
                $ret = $list;
            }
        }
        return $ret;
    }

    sub nameCredit {
        my $name = shift;
        # utf8::decode($name);
        $name =~ s[/][-]g;

        if ( exists( $rgb{$name} ) ) {
            my $s = $rgb{$name}->{'credit'};
            return ( $s );
        }

        return undef;
    }

    sub isNamed {
        my $opt = shift;
        my $list = $opt->{'colorlist'};
        my ( $r, $g, $b ) = @_;
        my $hex = q{};
        if ( defined( $g ) ) {
            $hex = sprintf("%02x%02x%02x", $r, $g, $b);
        }
        else {
            $hex = $r;
            $hex =~ s/0x//i;
        }

        my @names = ();
        if ( exists( $c2name{$hex} ) ) {
            @names = @{$c2name{$hex}};
        }
        else {
            return undef;
        }

        #my $me = $opt->{'req'}->base();
        my $me = mebase($opt);

        #$me =~ s{/+$}{}; # remove trailing slashes (if there are any).
        $me .= q{/m:colordump};

        my @ret = ();
        foreach my $name ( @names ) {
            my $str = $name;
            if ( my $source = $rgb{$name}->{'source'} ) {
                if ( exists $_fileInfo{$source}->{'index'} ) {
                    my $index = $_fileInfo{$source}->{'index'};
                    my $link = ${me} . qq(/l:${source});
                    $str = qq{$name <sup><a href="$link">$index</a></sup>};
                }
            }
            push @ret, ($str);
        }

        if ( scalar ( @ret ) ) {
            return join( q{, }, @ret );
        }

        return undef;
    }

    sub htmfSingleRGB {
        my $opt = shift;
        my ( $nm, $name, $c, $alt ) = @_;
        my $n = $opt->{'byname'} || q{};
        my $display = $name;
        if ( $alt ) {
            $display = "&nbsp;(aka) $name";
            return qq{<option value="$c">$display</option>\n};
        }
        elsif ( $n ) {
            if ( $n eq $name ) {
                return qq{<option value="$c" selected>$display</option>\n};
            }
            else {
#                if ( $c =~ m{^4b3621}i ) {
#                    return "<!-- COMPARE: $n to $name -->\n";
#                }
                return qq{<option value="$c">$display</option>\n};
            }
        }
        elsif ( $nm eq $name ) {
            return qq{<option value="$c" selected>$display</option>\n};
        }
        else {
            return qq{<option value="$c">$display</option>\n};
        }
    }

    sub colorNames {
        my $opt = shift;
        my $list = $opt->{'colorlist'};
        my $cnrgb = populateRGBNames($opt);

        if ( ( defined $list ) && ( length($list) ) ) {
            return sort foldedCmp keys %{$cnrgb};
        }
        else {
            return sort foldedCmp @rgbnames;
        }
    }

    sub htmfRGBOptions {
        my $opt = shift;
        my $list = $opt->{'colorlist'};
        my $prefname = $opt->{'byname'} || q{};
        my ( $r, $g, $b ) = @_;
        my $nm = q{};
        my $cl = q{};
        my $filter = $opt->{'filter'};
        if ( defined($r) && ( ! defined( $g ) ) ) {
            ( $r, $g, $b ) = rgbHtmlStyle($r);
        }
        populateRGBNames($opt);
        my %lrgb = ();  # localize 'used' to just this run.
        my $ret = q{};
        if ( defined( $r ) ) {
            if (
                   (length($prefname))
                && (exists($rgb{$prefname}))
                && ($rgb{$prefname}->{'red'} eq $r)
                && ($rgb{$prefname}->{'green'} eq $g)
                && ($rgb{$prefname}->{'blue'} eq $b)
               ) {
               $nm = $prefname;
            }
            else {
                $nm = isNamed($opt, $r, $g, $b) || q{Customized};
            }
            $nm =~ s/ <sup>.*>$//;
            $cl = sprintf("%02x%02x%02x", $r, $g, $b);
            if ( $nm eq q{Customized} ) {
                $lrgb{$nm}->{'used'} = 1;
                $ret .= qq{<option value="$cl" selected>$nm</option>\n};
            }
        }

NML:
        foreach my $name ( colorNames($opt) ) {
            if ( $filter && length($filter) ) {
                if ( $name !~ m{$filter} ) {
                    next NML;
                }
            }
            my $c = $rgb{$name}->{'c'};
            if ( ! exists( $lrgb{$name}->{'used'} ) ) {
                $lrgb{$name}->{'used'} = 1;
                if ( 1 < scalar( @{$c2name{$c}} ) ) {
                    $ret .= htmfSingleRGB($opt, $nm, $name, $c, 0);
                    foreach my $othername ( @{$c2name{$c}} ) {
                        if ( $name ne $othername ) {
                            $ret .= htmfSingleRGB($opt, $nm, $othername, $c, 1);
                        }
                    }
                }
                else {
                    $ret .= htmfSingleRGB($opt, $nm, $name, $c, 0);
                }
            }
        }
        # Last chance - if the found name isn't in a current list, it wasn't
        #    put in the options yet.  This will find that issue and correct it.
        if ( ! exists( $lrgb{$nm}->{'used'} ) ) {
            my $list = nameSource($nm) || q{};
            if ( length( $list )  ) {
                $list = q{ (name from } . $list . q{)};
            }
            $ret = qq{<option value="$cl" selected>$nm$list</option>\n}. $ret;
        }
        return $ret;
    }
}

# From CGI::Util, but copied here, slightly modified...
sub utf8_chr {
    my $c = shift(@_);
    my $u = chr($c);
    utf8::encode($u); # drop utf8 flag
    return $u;
}

# unescape URL-encoded data
sub unescape {
#  shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
  my $todecode = shift;
  return undef unless defined($todecode);
  $todecode =~ tr/+/ /;       # pluses become spaces
#    if ($_EBCDIC) {
#      $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
#    } else {
    # handle surrogate pairs first -- dankogai. Ref: http://unicode.org/faq/utf_bom.html#utf16-2
    $todecode =~ s{
            %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
                %u([Dd][c-fC-F][0-9a-fA-F]{2})   # lo
              }{
              utf8_chr(
                   0x10000 
                   + (hex($1) - 0xD800) * 0x400 
                   + (hex($2) - 0xDC00)
                  )
              }gex;
      $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
    defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
#    }
  return $todecode;
}
# End copy from CGI::Util

# vim: sw=4 ts=4
# End gd_colormix.psgi.pl
