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