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