A toy piano
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
AMG: This piano isn't well-tempered, it's even-tempered. Even temperament is nice because it allows you to play in any key without retuning, but it also means that nearly every note and interval sound slightly wrong to the trained ear. For instance, a perfect fifth is supposed to have a 3:2 frequency ratio (1.5). Even temperament approximates this as 2**(7/12.) == 1.4983, which is 0.113% (0.02 semitones) low. But even temperament at its worst is still better than playing a well-tempered instrument in the wrong key. Moreover, no one can actually hear the difference anyway. :^)
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... (see TclMusic for what came out of that!)
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