## Harmonic color wheel

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