Brian Theado - 14Aug04 - Here is some code to display a harmonic color wheel. See http://www.colorschemer.com/tutorial1.html
for what such a color wheel can be useful for.The picture above displays two color wheels. Each color in the outer wheel is the complement of the corresponding color in the inner wheel.
if {[llength [info commands lassign]] == 0} {
proc lassign {l args} {uplevel [list foreach $args $l break]}
}
# rgb to hsv (swiped from the tk demos)
# The procedure below converts an RGB value to HSB. It takes red, green,
# and blue components (0-65535) as arguments, and returns a list containing
# HSB components (floating-point, 0-1) as result. The code here is a copy
# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
# by Foley and Van Dam.
proc rgbToHsv {red green blue} {
if {$red > $green} {
set max [expr {double($red)}]
set min [expr {double($green)}]
} else {
set max [expr {double($green)}]
set min [expr {double($red)}]
}
if {$blue > $max} {
set max [expr {double($blue)}]
} elseif {$blue < $min} {
set min [expr {double($blue)}]
}
set range [expr {$max-$min}]
if {$max == 0} {
set sat 0
} else {
set sat [expr {($max-$min)/$max}]
}
if {$sat == 0} {
set hue 0
} else {
set rc [expr {($max - $red)/$range}]
set gc [expr {($max - $green)/$range}]
set bc [expr {($max - $blue)/$range}]
if {$red == $max} {
set hue [expr {($bc - $gc)/6.0}]
} elseif {$green == $max} {
set hue [expr {(2 + $rc - $bc)/6.0}]
} else {
set hue [expr {(4 + $gc - $rc)/6.0}]
}
if {$hue < 0.0} {
set hue [expr {$hue + 1.0}]
}
}
return [list $hue $sat [expr {$max/65535}]]
}
# hsv to rgb (swiped from the tk demos)
# The procedure below converts an HSB value to RGB. It takes hue, saturation,
# and value components (floating-point, 0-1.0) as arguments, and returns a
# list containing RGB components (integers, 0-65535) as result. The code
# here is a copy of the code on page 616 of "Fundamentals of Interactive
# Computer Graphics" by Foley and Van Dam.
proc hsvToRgb {hue sat value} {
set v [format %.0f [expr {65535.0*$value}]]
if {$sat == 0} {
return "$v $v $v"
} else {
set hue [expr {$hue*6.0}]
if {$hue >= 6.0} {
set hue 0.0
}
scan $hue. %d i
set f [expr {$hue-$i}]
set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
switch $i {
0 {return "$v $t $p"}
1 {return "$q $v $p"}
2 {return "$p $v $t"}
3 {return "$p $q $v"}
4 {return "$t $p $v"}
5 {return "$v $p $q"}
default {error "i value $i is out of range"}
}
}
}
package require Tk
# Displays harmonic color wheel starting at the given rgb
proc displayColorWheel {c r g b {scale 1.0}} {
# Fill most of the canvas, assuming a zero based coordinate system
set x [expr round([$c cget -width]/2.1*$scale)]
set y [expr round([$c cget -height]/2.1*$scale)]
set numWedges 12.0
set wedgeWidth [expr 360/$numWedges]
lassign [rgbToHsv $r $g $b] h s v
for {set wedge 0} {$wedge < $numWedges} {incr wedge} {
# Draw the current wedge
set start [expr $wedge * $wedgeWidth]
$c create arc -$x -$y $x $y -extent $wedgeWidth -start $start -fill #[format %02x%02x%02x $r $g $b] -tags [list colorwheel wedgenum-$wedge]
# The next color in a harmonic color wheel is derived by linearly incrementing the hue
set h1 [expr $h + (($wedge + 1) / $numWedges)]
if {$h1 > 1} {set h1 [expr $h1 - 1.0]}
lassign [hsvToRgb $h1 $s $v] r g b
}
}
proc displayComplementColorWheel {c r g b} {
lassign [rgbToHsv $r $g $b] h s v
set h1 [expr $h + 0.5]
if {$h1 > 1} {set h1 [expr $h1 - 1.0]}
lassign [hsvToRgb $h1 $s $v] r g b
displayColorWheel $c $r $g $b 0.30
}
proc displayRandomColorWheel c {
set r [expr round(rand()*255)]
set g [expr round(rand()*255)]
set b [expr round(rand()*255)]
displayColorWheel $c $r $g $b
displayComplementColorWheel $c $r $g $b
}# Demonstration code proc centerCanvas {W h w} {
set h [expr {$h / 2.0}]
set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
}
package require Tk
toplevel .t
wm title .t "harmonic color wheel"
canvas .t.c
pack .t.c -expand 1
displayRandomColorWheel .t.c
bind .t.c <Configure> [namespace code {centerCanvas %W %h %w}]
bind .t.c <1> [namespace code {
%W delete colorwheel
displayRandomColorWheel %W
}]George Peter Staplin: Your colorwheel is interesting. I think I will use it to choose colors for my new website. Thanks for sharing. :)
Category Graphics
