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 [label .b.l -text "Draw speed:"] -side left 17tk_optionMenu .b.om pixpsec 25 50 100 200 18pack .b.om -side left 19pack [label .b.l2 -text "pixels per second"] -side left 20pack [frame .f] -side top -expand true -fill both 21pack [canvas .f.d -width 40 -bg white] -side left -fill y 22pack [canvas .f.c -bg white] -side left -expand true -fill both 23.f.c create text 150 100 -text "Pitch plot of microphone signal" 24 25set pixpsec 25 26set samplePos 0 27#.c create spectrogram 0 0 -sound s -height 200 -pixelspersec $pixpsec 28 29proc Stop {} { 30 s stop 31 after cancel Draw 32} 33 34proc Start {} { 35 Stop 36 s record 37 set ::samplePos 0 38 set ::ox 0 39 set ::oy 0 40 .f.c delete all 41 .f.c create line 0 $::ty 1280 $::ty -tags target 42 after 200 Draw 43} 44 45proc Draw {} { 46 set length [s length] 47 while {$::samplePos < $length - 666-1*320} { 48 t copy s -start $::samplePos -end [expr {$::samplePos+665+1*320}] 49 set pitch [lindex [lindex [t pitch -method esps] 2] 0] 50 set x [expr {$::ox + 0.01 * $::pixpsec}] 51 set y [expr {[winfo height .f.c]*((300-$pitch)/300.0)}] 52 if {$::oy == 0} { set ::oy $y } 53 if {$pitch > 0.0 && abs($::oy-$y) < 10} { 54 .f.c create oval [expr {$x-1}] [expr {$y-1}] [expr {$x+1}] [expr {$y+1}] 55 } 56 incr ::samplePos 160 57 set ::ox $x 58 set ::oy $y 59 if {$x > [winfo width .f.c]} Stop 60 } 61 after 50 Draw 62 if {[s length] > 320000} Stop 63} 64 65bind .f.c <Configure> Configure 66 67proc Configure {} { 68 .f.d delete all 69 snack::frequencyAxis .f.d 0 0 40 [winfo height .f.c] -topfr 300 70} 71 72set ty 150 73.f.c create line 0 $::ty 1280 $::ty -tags target 74bind .f.c <1> [list initDrag %x %y] 75bind .f.c <B1-Motion> [list Drag %x %y] 76 77proc initDrag {x y} { 78 set ::ty [.f.c canvasy $y] 79 .f.c coords target 0 $::ty 1280 $::ty 80} 81 82proc Drag {x y} { 83 set y [.f.c canvasy $y] 84 .f.c coords target 0 $::ty 1280 $::ty 85 set ::ty $y 86} 87