source colorwheel.tcl ;# from http://wiki.tcl.tk/12201
 package require Tk
 if {![catch {
    package require midi
    midi::openout 0
    }]} {
    proc beepLetter letter {
        binary scan $letter c* ascii
        foreach l $ascii {
            midi::sendshort 144 $l 70
            }
        }
    set lastColor 0
    proc beepColor color {
        variable lastColor
        if {$color != $lastColor} {
            scan $color "#%2x%2x%2x" r g b
            midi::sendshort 144 [expr $r/2] 70
            midi::sendshort 144 [expr $g/2] 70
            midi::sendshort 144 [expr $b/2] 70
            set lastColor $color
            }
        }
 } else {
    # Not nearly as interesting without the sound
    proc beepLetter letter {}
    proc beepColor args {}
 }

 package require Tk
 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]
    }
 proc createGui {toplevel} {
    set parent $toplevel
    if {$toplevel == "."} {set parent ""}
    wm geometry $toplevel [join [wm maxsize .] x]+0+0
    pack [canvas $parent.c] -expand 1
    $parent.c configure  -width [lindex [wm maxsize $toplevel] 0] -height [lindex [wm maxsize $toplevel] 1]
    set c $parent.c
    bind $c <Configure> {centerCanvas %W %h %w}
    return $c
    }
 proc randomColor {} {
    set r [expr int(rand()*255)]
    set g [expr int(rand()*255)]
    set b [expr int(rand()*255)]
    return [format {#%02x%02x%02x} $r $g $b]
    }
 proc getLetter {a k} {
    if {[string length $a] == 0} {
        return $k
    } else {
        return $a
        }
    }
 # Moves the letter to the given location and changes the color of the letter to the
 # complement of the nearest color wheel pie wedge.
 proc moveLetter {c x y} {
    $c lower letter
    set x [$c canvasx $x]; set y [$c canvasy $y]
    set closest [$c find closest $x $y]
    if {[string length $closest] > 0} {
        set wedgeNum [lsearch -inline [$c gettags $closest] wedgenum*]
        set wedgeNum [lindex [split $wedgeNum -] 1]
        set complementNum [expr ($wedgeNum + 6) % 12]
        $c itemconfigure letter -fill [$c itemcget wedgenum-$complementNum -fill]
        }
    $c raise letter
    $c coords letter $x $y
    }

 # Create the canvas, color wheel, and letter
 set canvas [createGui .]
 displayRandomColorWheel $canvas
 $canvas create text 100 100 -text a -font {{Times New Roman} 250} -tag letter

 # As the mouse moves, the letter will follow
 bind $canvas <Motion> [namespace code {moveLetter %W %x %y}]

 # Play a set of musical notes when the letter is moved over a new color
 bind $canvas <Motion> {+beepColor [%W itemcget [%W find closest %x %y] -fill]]}

 # Display a letter or key symbol name upon any keypress
 bind $canvas <Key> {%W itemconfigure letter -text [getLetter %A %K]}

 # Map the letter to a musical note and play it
 bind $canvas <Key> +[namespace code {beepLetter [getLetter %A %K]}]

 # Mouse button changes the color
 bind $canvas <Button> {%W itemconfigure letter -fill [randomColor]}
 bind $canvas <Button> +[namespace code {
    %W delete colorwheel
    displayRandomColorWheel %W
    %W lower colorwheel
    }]
 focus -force $canvas

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References