Version 2 of A toy piano

Updated 2002-08-28 17:25:24

http://mini.net/files/piano.jpg


Richard Suchenwirth 2002-08-27 - After FW added beeping sounds to a little Morse trainer, I took a working Snack extension home and finally started on one of these little dream projects - (very simple) computer music, drawing a (toy piano) keyboard on a canvas and letting the keys produce sounds when clicked on with the mouse. (Many years ago, I played similar games in Basic on an 8-bit computer with the physical keyboard - but things have become so easy since then, not the least thanks to Tcl/Tk, that this time it took me only part of an evening). The sound is still weak, but even as an old man page reader, I couldn't figure out how to make it more piano-like - any help welcome! My first idea was to add one octave below - when you double-click on a key, after a short while the low tone will disappear, so you hear the pure frequency as advertised. Interesting mini-challenges in this were

  • the computation of note frequencies (well-tempered)
  • the simple, and scalable design of a piano keyboard

To make this toy at least mildly educational, the note name and frequency are displayed in the title bar when the mouse moves over a key. Maybe Notes on a canvas can be plugged in here too...

 package require Tk    ;# to make Starkit'ting this easier
 package require sound ;# we don't yet use the Tk goodies of snack
 set snd  [snack::sound -rate 22050]
 set snd2 [snack::sound -rate 22050] ;# second sound to add volume
 set filter  [snack::filter generator 1000 30000 0.7 sine]
 set filter2 [snack::filter generator 1000 30000 0.0 sine]

 # compute sound frequencies, given a' = 440 Hz
 set a 440
 # Logarithm to base 2 allows us to proceed linearly in 1/12 steps
 set lda [expr {log($a)/log(2)}]

 # But this list starts from c'', so we have to add 3/12
 set names {c c# d d# e f f# g g# a bb b}
 set freqs {}
 for {set i 0} {$i<12} {incr i} {
    lappend freqs [expr {pow(2, $lda + (3+$i)/12.)}]
 }
 proc play {c id freq} {
    if $freq {
        $c move $id 1 1
        $::filter configure $freq
        $::snd play -filter $::filter
        $::filter2 configure [expr {$freq/2.}] ;# one octave lower
        $::snd2 play -filter $::filter2
    } else {
        $c move $id -1 -1
        after 20 $::snd stop
        after 120 $::snd2 stop
    }
 }
 proc nameof {name factor} {
    if {$factor==0.25} {set name [string toupper $name]}
    while {$factor>=1} {
        append name '
        set factor [expr {$factor/2.}]
    }
    set name
 }
 set x0 5; set y0 5      ;# top left corner to start
 set y1 100              ;# length of white keys
 set y05 [expr $y1*.67]  ;# length of black keys
 set dx 18               ;# width of white keys
 set dx2 [expr {$dx/2}]  ;# offset of black keys
 set c [canvas .c -bg brown -height [expr $y1+5] -width [expr $dx*31]]
 $c config -cursor hand2 ;# so we see the single finger that plays
 pack $c
 wm resizable . 0 0      ;# keep the window fixed-size
 foreach factor {0.25 0.5 1 2 4} {
    foreach name $names freq $freqs {
        set f [expr {$freq * $factor}]
        if {[string length $name] == 1} {
            set id [$c create rect $x0 $y0 [expr {$x0+$dx}] $y1 -fill white]
            incr x0 $dx; incr x0 1
        } else {
            set x [expr {$x0 - $dx*.35}]
            set id [$c create rect $x $y0 [expr {$x + $dx*0.65}] $y05 \
                -fill black -tag black]
        }
        $c bind $id <1>               "play $c $id $f" ;# sound on
        $c bind $id <ButtonRelease-1> "play $c $id 0"  ;# sound off
        $c bind $id <Enter> \
          [list wm title . "piano: [nameof $name $factor] [format %.1f $f]"]
        if {$factor == 4 && $name == "c"} break ;# extra c key at right
    }
 }
 $c raise black ;# otherwise half-hidden by next white key

Arts and crafts of Tcl-Tk programming