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"
24pack [canvas .c -bg white -width 200 -height 200]
25.c create oval 100 100 100 100 -width 8 -outline black -tag point
26.c create line 195 5 195 195 -fill red -arrow last
27.c create line 5 5 195 5 -fill green -arrow first
28
29set pixpsec 25
30set samplePos 0
31#.c create spectrogram 0 0 -sound s -height 200 -pixelspersec $pixpsec
32
33proc Stop {} {
34  s stop
35  after cancel Draw
36}
37
38proc Start {} {
39  Stop
40  s record
41  set ::samplePos 0
42  set ::ox  0
43  set ::oy  0
44  .f.c delete all
45  .f.c create line 0 $::ty 1280 $::ty -tags target
46  after 50 Draw
47}
48
49proc Draw {} {
50  set length [s length]
51  while {$::samplePos < $length - 700-0*320} {
52    t copy s -start $::samplePos -end [expr {$::samplePos+700+0*320}]
53    set formants [lindex [t formant] end]
54    set x [expr {$::ox + 0.01 * $::pixpsec}]
55    set y [expr {[winfo height .f.c]*((4000-[lindex $formants 0])/4000.0)}]
56    .f.c create oval $x $y $x $y -width 2 -outline red
57    set y [expr {[winfo height .f.c]*((4000-[lindex $formants 1])/4000.0)}]
58    .f.c create oval $x $y $x $y -width 2 -outline green
59    set y [expr {[winfo height .f.c]*((4000-[lindex $formants 2])/4000.0)}]
60    .f.c create oval $x $y $x $y -width 2 -outline blue
61    set y [expr {[winfo height .f.c]*((4000-[lindex $formants 3])/4000.0)}]
62    .f.c create oval $x $y $x $y -width 2 -outline yellow
63    incr ::samplePos 160
64    set ::ox $x
65    if {$x > [winfo width .f.c]} Stop
66    set y [expr {[winfo height .c]*(([lindex $formants 0]-0)/800.0)}]
67    set x [expr {[winfo width .c]*((2300-[lindex $formants 1]+0)/2300.0)}]
68    .c coords point $x $y $x $y
69  }
70  after 50 Draw
71  if {[s length] > 320000} Stop
72}
73
74bind .f.c <Configure> Configure
75
76proc Configure {} {
77  .f.d delete all
78  snack::frequencyAxis .f.d 0 0 40 [winfo height .f.c] -topfr 4000
79}
80
81set ty 150
82.f.c create line 0 $::ty 1280 $::ty -tags target
83bind .f.c <1> [list initDrag %x %y]
84bind .f.c <B1-Motion> [list Drag %x %y]
85
86proc initDrag {x y} {
87  set ::ty [.f.c canvasy $y]
88  .f.c coords target 0 $::ty 1280 $::ty
89}
90
91proc Drag {x y} {
92  set y [.f.c canvasy $y]
93  .f.c coords target 0 $::ty 1280 $::ty
94  set ::ty $y
95}
96