[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 [http://mini.net/files/piano.jpg] 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 "play $c $id 0" ;# sound off $c bind $id \ [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]