1#!/bin/sh 2# the next line restarts using wish \ 3exec wish8.4 "$0" "$@" 4 5package require -exact snack 2.2 6 7sound s 8sound t 9 10pack [frame .b] -side bottom 11pack [button .b.r -bitmap snackRecord -command Start -fg red -width 40] \ 12 -side left 13pack [button .b.s -bitmap snackStop -command Stop -width 40] -side left 14pack [button .b.p -bitmap snackPlay -command {Stop;s play} -width 40] \ 15 -side left 16pack [checkbutton .b.l -text "Erase dots" -variable erase] -side left 17pack [frame .f] -side top -expand true -fill both 18pack [canvas .f.c -bg white] -side left -expand true -fill both 19.f.c create text 130 100 -text "Phonetogram plot (pitch and intensity)" 20 21set samplePos 0 22set erase 0 23 24proc Stop {} { 25 s stop 26 after cancel Draw 27} 28 29proc Start {} { 30 Stop 31 s record 32 set ::samplePos 0 33 .f.c delete all 34 after 200 Draw 35} 36 37proc Draw {} { 38 if {$::erase} { .f.c delete all } 39 set length [s length] 40 while {$::samplePos < $length - 666-1*320} { 41 t copy s -start $::samplePos -end [expr {$::samplePos+665+1*320}] 42 t changed new 43 set pitch [lindex [lindex [t pitch -method esps] 2] 0] 44 set amplitude [t max] 45 if {$amplitude < 1} { set amplitude 1 } 46 set y [expr {[winfo height .f.c]*(2.0-log10($amplitude)/2.26)}] 47 set x [expr {[winfo width .f.c]*($pitch/300.0)}] 48 if {$pitch > 0.0} { 49 .f.c create oval [expr {$x-1}] [expr {$y-1}] [expr {$x+1}] [expr {$y+1}] 50 } 51 incr ::samplePos 160 52 } 53 after 50 Draw 54 if {[s length] > 320000} Stop 55} 56