##+##########################################################################
#
# pastel.tcl
# by Keith Vetter
#
# Revisions:
# KPV Nov 06, 2003 - initial revision
# RT Oct 18, 2004 - a button to view 12 pastels side-by-side
#
##+##########################################################################
#############################################################################
package require Tk
proc DoDisplay {} {
frame .f2 -bd 2 -relief ridge
label .f -text "W" -font {Times 48}
label .rgb -textvariable rgb
button .pastel -text "Pastel" -command RandomPastel
button .light -text "Light" -command RandomLight
button .see12 -text "P 12" -command See12Pastel
grid .f2 .pastel
grid ^ .light
grid ^ .see12
grid .f -in .f2
grid .rgb -in .f2
grid columnconfigure . 1 -pad 10
RandomPastel
}
##+##########################################################################
#
# LightColor -- returns a "light" color. A light color is one in
# which the V value in the HSV color model is greater than .7. Since
# the V value is simply the maximum of R,G,B we simply need at least
# one of R,G,B must be greater than .7.
#
proc LightColor {} {
set light [expr {255 * .7}] ;# Value threshold
while {1} {
set r [expr {int (255 * rand())}]
set g [expr {int (255 * rand())}]
set b [expr {int (255 * rand())}]
if {$r > $light || $g > $light || $b > $light} break
}
return [format "\#%02x%02x%02x" $r $g $b]
}
##+##########################################################################
#
# Pastel -- returns a "pastel" color. Code is from X Windows tool xcolorize
# Pick "random" color in a subspace of the HSV color model and convert to RGB.
#
proc Pastel {} {
set rand [expr {rand() * 262144}]
set h [fmod $rand 360]
set rand [expr {$rand / 359.3}]
set s [expr {([fmod $rand 9] + 12) / 100.0}]
set v 1
# Convert to rgb space
if {$h == 360} { set h 0 }
set h [expr {$h/60}]
set i [expr {int(floor($h))}]
set f [expr {$h - $i}]
set p1 [expr {$v*(1-$s)}]
set p2 [expr {$v*(1-($s*$f))}]
set p3 [expr {$v*(1-($s*(1-$f)))}]
switch -- $i {
0 { set r $v ; set g $p3 ; set b $p1 }
1 { set r $p2 ; set g $v ; set b $p1 }
2 { set r $p1 ; set g $v ; set b $p3 }
3 { set r $p1 ; set g $p2 ; set b $v }
4 { set r $p3 ; set g $p1 ; set b $v }
5 { set r $v ; set g $p1 ; set b $p2 }
}
foreach a {r g b} { set $a [expr {int ([set $a] * 255)}] }
return [format "\#%02x%02x%02x" $r $g $b]
}
proc fmod {num mod} { ;# Floating point modulus
foreach {int frac} [split $num "."] break
set frac "0.$frac"
return [expr {($int % $mod) + $frac}]
}
proc RandomLight {} {
set ::rgb [LightColor]
.f config -bg $::rgb
}
proc RandomPastel {} {
set ::rgb [Pastel]
.f config -bg $::rgb
}
##+##########################################################################
#
# See12Pastel - generate a list of pastels and pass to display proc
# ShowColorLIst - show side by side list of colors with RGB labels
#
proc See12Pastel {} {
for {set i 0} {$i < 12} {incr i} {
lappend clist [Pastel]
}
ShowColorList $clist
}
proc ShowColorList {list} {
set tl .colorlist
if {[winfo exists $tl]} {
eval destroy [winfo children $tl]
} else {
toplevel $tl
}
set column 0
foreach c $list {
grid [label $tl.lc$column -bg $c] -column $column -row 0 -sticky news
grid [label $tl.lt$column -text $c] -column $column -row 1
incr column
}
}
DoDisplayuniquename 2013aug18For the reader who does not have the time/facilities/whatever to setup the code and execute it, here are a couple of images of the windows created by the code above.

