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 midilib) 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 <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 $canvasHello - what specific Tcl midi extension do you make use of here? Did you consider Snack as a possible extension alternative?
Brian Theado - 17Aug04 - The library I used is referred to as midilib on the midi page. Snack could be used to either play a wav file for each note, or to play generated tones as done in tclmusic. Midi was easier to use and it sounds orders of magnitudes better (with my sound card's midi synthesizer and I would guess most sound cards?) than snack generated beeps. Writing code for the snack-generated beeps wouldn't be too hard--just use the inverse of the freqToNote function I added the other day to the tclmusic page and generate a beep at that frequency for a short period of time.