Suppose you have a color, perhaps the result of a
tk_chooseColor operation, or some sort of "$widget configure -fg" introspection and transformation. Is there a way to say that color in English?
Sure. Just use the code below:
proc get_color_name {color_value permitted_list} {
set convenient_large_number 10000
set least_distance $convenient_large_number
set set_name unknown
if [regexp #(.*) $color_value -> rgb] {
scan $rgb %2x%2x%2x r0 g0 b0
} else {
# Assume it's a known color name. In production, one
# ought to handle exceptions.
foreach {r0 g0 b0} [get_rgb $color_value] {}
}
foreach name $permitted_list {
foreach {r g b} [get_rgb $name] {}
# One can make a case for several other metrics. This
# has the advantages of being mathematically robust
# and maintainable from a software standpoint.
set d [expr abs($r - $r0) + abs($g - $g0) + abs($b - $b0)]
if {!$d} {
return $name
}
if {$d < $least_distance} {
# puts "$name, at ($r, $g, $b), is within $d of ($r0, $g, $b0)."
set least_distance $d
set best_name $name
}
}
return "$best_name +/ $least_distance"
}
# Where are these formats documented?
proc get_rgb color_name {
# If it's sufficiently important, one might replace the [winfo ...]
# with a table lookup. At that point, this script becomes "pure Tcl".
foreach part [winfo rgb . $color_name] {
scan [format %4x $part] %2x%2x first second
lappend list $first
}
return $list
}In practical use, the two arguments each come in a couple of varieties. permitted_list lists recognized color names. It might be a restricted palette, like
set short_list {red orange yellow green blue violet}(notice 'indigo' can't appear; Tk doesn't know it). The other most likely useful assignment appears in "
Named Colors", where
set COLORS { snow {ghost white} {white smoke} gainsboro ... gray99}includes
all the colors Tk knows.
The first argument is either a color name, as might appear in $permitted_list, or an RGB value, like "#c71382" or "#9400d3". A slightly more complex procedure might parse other color formats.
As it stands, then, get_color_name computes such values as
get_color_name yellow $short_list -> yellow
get_color_name sienna $short_list -> red +/- 222
get_color_name {light coral} $COLORS -> light coral
get_color_name #39a051 $COLORS -> sea green +/ 38
