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