Version 2 of A letter toy

Updated 2004-08-15 05:15:13

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 tclmidi) 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
 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

Category Toys