[Brian Theado] - 14Aug04 - This little toy displays a single letter and a [harmonic color wheel]. My goal was to give my daughter a game to play around with that held her interest and give some sort of response no matter what is done with the keyboard or with the mouse. When a key is hit, the corresponding letter is shown (or the keysym name if no printable character). As the mouse is moved the letter follows. Upon mouse click, the colors change randomly. Each letter is mapped to a musical note and that note is played using a midi synthesizer (see tcl[midi]) upon each keystroke. The colors are mapped to a set of notes and when the letter is moved above a different letter, those notes are played. Good for kids 3 and under. It held my daughter's attention for a few minutes on more than a handful of occasions. She was most interested in the symbols like commas and periods as the letters of the alphabet she was already somewhat familar with. Requires the code from [harmonic color wheel]. 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 {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 [namespace code {moveLetter %W %x %y}] # Play a set of musical notes when the letter is moved over a new color bind $canvas {+beepColor [%W itemcget [%W find closest %x %y] -fill]]} # Display a letter or key symbol name upon any keypress bind $canvas {%W itemconfigure letter -text [getLetter %A %K]} # Map the letter to a musical note and play it bind $canvas +[namespace code {beepLetter [getLetter %A %K]}] # Mouse button changes the color bind $canvas