Richard Suchenwirth 2002-08-31 - As a toy piano produces slightly boring sounds, I wanted to use the possibilities of the Snack extension better. We're dealing with two kinds of Snack objects, sounds (that can be told to play or stop) and filters which control a sound's behavior: frequency, amplitude (=volume) etc.The sound of a piano should fade into silence. For this, a simple solution is to "fire" a round of afters which reconfigure the amplitude of a sound to decrease, and finally destroy sound and filter when the amplitude is below audibility. First attempts to decrease amplitude linearly didn't sound so realistic, so it was time for the old physics book. For me at least, Tcl is strongly educational in that it instigates me to refresh long-gone (or never-had) knowledge in various areas, in the course of fun projects that are so simple with Tcl and its powerful extensions.I soon found the "dampened harmonic oscillator" to be useable, where the envelope amplitude (inside which the sound curve is oscillating) goes down according to
x = exp(-d t)where t is time and d the damping constant: 0 would be undamped, playing on forever; 0.2 proved to be a value suitable for piano; but it can go above 1 for faster-dying sounds.In order to experiment with various parameters, I wrote the following little "playstation" where you can set
- frequency in Hz (=cps) at top left (50..20000)
- dt: step-width of changes in milliseconds (best <1000)
- damp: damping factor (forced to be >0)
- shape: a snack parameter between 0 and <1 - higher sounds better
package require Tk package require sound ;# snack without canvas accessories proc soundOn {freq amp shape {type sine}} { set soundname [snack::sound -rate 22050] upvar #0 $soundname sound set filter [snack::filter generator $freq $amp $shape $type] $soundname play -filter $filter set sound [list $filter $freq $amp] set soundname } proc soundOff {varName {dt 0} {damp 1.0}} { upvar #0 $varName sound foreach {filter freq amplitude} $sound break set a $amplitude set t 0 ;# abstract integer units if {$damp <= 0} {set damp 0.1} ;# prevent lock/crash while {$a > 50} { set a [expr {$amplitude * exp(-$damp * $t)}] after [expr {$t*$dt}] [list $filter configure $freq $a] incr t 1 } after [expr {$t*$dt}] " $varName stop; $filter destroy; $varName destroy; unset $varName" } #------------- testing UI if {[file tail [info script]]==[file tail $argv0]} { proc radio {w varName values} { frame $w foreach i $values { radiobutton $w.b$i -variable $varName -value $i\ -text $i -indicatoron 0 } eval pack [winfo children $w] -side left -padx 0 } entry .e -textvar frequency -width 5 set frequency 1000 button .b -text Play -command \ {soundOff [soundOn $frequency 30000 $shape $type] $::dt $::damp} # command only for 'invoke' use, direct clicks are bound bind .b <1> {set last [soundOn $frequency 30000 $shape $type]; break} bind .b <ButtonRelease-1> {soundOff $last $dt $damp} label .1 -text dt: entry .2 -textvar dt -width 5 set dt 100 label .3 -text damp: entry .4 -textvar damp -width 5 set damp 0.2 label .5 -text shape: entry .6 -textvar shape -width 5 set shape 0.95 radio .type type {sine rectangle triangle noise} set type sine grid .e .b -sticky news grid .1 .2 -sticky news grid .3 .4 -sticky news grid .5 .6 -sticky news grid .type - -sticky news bind . <Return> {.b invoke} bind . ? {console show} bind . <Escape> {exec wish $argv0 &; exit} }