1#!/bin/sh
2# the next line restarts using wish \
3exec wish8.4 "$0" "$@"
4
5package require -exact snack 2.2
6
7set width 300
8set height 200
9set start 0
10set end 48000
11set stipple ""
12set winlen 256
13set fftlen 512
14set filename section.ps
15set topfr 8000
16set maxval 0.0
17set minval -80.0
18set skip 500
19set atype FFT
20set order 20
21set wtype Hamming
22option add *font {Helvetica 10 bold}
23
24pack [ canvas .c -width 400 -height 250]
25pack [ canvas .c2 -height 50 -width 400 -closeenough 5]
26pack [ label .l -text "Drag markers with left mouse button"]
27pack [ frame .f1] -pady 2
28pack [ scale .f1.s1 -variable width -label Width -from 10 -to 400 \
29    -orient horizontal -length 100 \
30    -command [list .c itemconf sect -width ]] -side left
31pack [ scale .f1.s2 -variable height -label Height -from 10 -to 250 \
32    -orient horizontal -length 100 \
33    -command [list .c itemconf sect -height ]] -side left
34pack [ scale .f1.s3 -variable topfr -label "Top frequency" -from 1000 -to 8000 \
35    -orient horizontal -length 100 -command [list .c itemconf sect -topfr ]] \
36    -side left
37pack [ scale .f1.s4 -variable maxval -label "Max value" -from 40 -to -40 \
38    -orient horizontal -length 100 -command [list .c itemconf sect -maxvalue ]]\
39    -side left
40pack [ scale .f1.s5 -variable minval -label "Min value" -from -20 -to -100 \
41    -orient horizontal -length 100 -command [list .c itemconf sect -minvalue ]]\
42    -side left
43pack [ scale .f1.s6 -variable skip -label "Skip" -from 50 -to 500 \
44    -orient horizontal -length 100 -command [list .c itemconf sect -skip ]] \
45    -side left
46
47pack [ frame .f2i] -pady 2
48pack [ label .f2i.lt -text "Type:"] -side left
49tk_optionMenu .f2i.at atype FFT LPC
50.f2i.at.menu entryconfigure 0 -command {.c itemconf sect -analysistype $atype;.f2i.e configure -state disabled;.f2i.s configure -state disabled}
51.f2i.at.menu entryconfigure 1 -command {.c itemconf sect -analysistype $atype;.f2i.e configure -state normal;.f2i.s configure -state normal}
52pack .f2i.at -side left
53
54pack [ label .f2i.lo -text "order:"] -side left
55entry .f2i.e -textvariable order -width 3
56
57scale .f2i.s -variable order -from 1 -to 40 -orient horiz -length 60 -show no
58pack .f2i.e .f2i.s -side left
59.f2i.e configure -state disabled
60.f2i.s configure -state disabled
61bind .f2i.e <Key-Return> {.c itemconf sect -lpcorder $order}
62bind .f2i.s <Button1-Motion> {.c itemconf sect -lpcorder $order}
63
64tk_optionMenu .f2i.cm wtype Hamming Hanning Bartlett Blackman Rectangle
65for {set i 0} {$i < 5} {incr i} {
66  .f2i.cm.menu entryconfigure $i -command {.c itemconf sect -windowtype $wtype}
67}
68pack .f2i.cm -side left
69
70pack [ label .f2i.lw -text "window:"] -side left
71foreach n {32 64 128 256 512} {
72    pack [ radiobutton .f2i.w$n -text $n -variable winlen -value $n \
73	-command {.c itemconf sect -winlength $winlen}] -side left
74}
75
76pack [ frame .f3i] -pady 2
77pack [ label .f3i.lf -text "FFT points:"] -side left
78foreach n {64 128 256 512 1024} {
79  pack [ radiobutton .f3i.f$n -text $n -variable fftlen -value $n \
80      -command {.c itemconf sect -fft $fftlen}] -side left
81}
82
83set frame 1
84pack [ frame .f2] -pady 2
85pack [ checkbutton .f2.f -text Frame -variable frame \
86    -command {.c itemconf sect -frame $frame}] -side left
87
88foreach color {Black Red Blue} {
89  pack [ radiobutton .f2.c$color -text $color -variable color -value $color \
90      -command [list .c itemconf sect -fill $color]] -side left
91}
92set color Black
93
94foreach {text value} {100% "" 50% gray50 25% gray25} {
95  pack [ radiobutton .f2.$text -text $text -variable stipple -value $value \
96      -command {.c itemconf sect -stipple $stipple}] -side left
97}
98
99pack [ frame .f3] -pady 2
100pack [ button .f3.br -bitmap snackRecord -command Record -fg red] -side left
101pack [ button .f3.bs -bitmap snackStop -command [list s stop]] -side left
102pack [ label .f3.l -text "Load sound file:"] -side left
103pack [ button .f3.b1 -text ex1.wav -command [list s read ex1.wav]] -side left
104pack [ button .f3.b2 -text ex2.wav -command [list s read ex2.wav]] -side left
105
106proc Record {} {
107    s record
108    after cancel [list catch {.f3.bs invoke}]
109    after 10000  [list catch {.f3.bs invoke}]
110}
111
112pack [ frame .f4] -pady 2
113pack [ label .f4.l -text "Generate postscript file:"] -side left
114pack [ entry .f4.e -textvariable filename] -side left
115pack [ button .f4.b -text Save -command {.c postscript -file $filename}] \
116    -side left
117
118pack [ button .bClose -text Close -command exit]
119
120bind .c <1> [list initDrag %x %y]
121bind .c <B1-Motion> [list Drag %x %y]
122
123proc initDrag {x y} {
124  set ::ox [.c canvasx $x]
125  set ::oy [.c canvasy $y]
126}
127
128proc Drag {x y} {
129  set x [.c canvasx $x]
130  set y [.c canvasy $y]
131  .c move current [expr $x - $::ox] [expr $y - $::oy]
132  set ::ox $x
133  set ::oy $y
134}
135
136snack::sound s -load ex1.wav
137
138.c create section 200 125 -anchor c -sound s -height $height -width $width \
139    -tags sect -frame $frame -debug 0 -start 9002 -end 12000
140
141.c2 create spectrogram 0 0 -sound s -height 50 -width 400 -tags s
142.c2 create line        5 0 5 50     -tags m1
143.c2 create line        395 0 395 50 -tags m2
144
145.c2 bind m1 <B1-Motion> {
146    .c2 coords m1 [.c2 canvasx %x] 0 [.c2 canvasx %x] 100
147    .c itemconf sect -start [expr int(16000 * [.c2 canvasx %x] / 600)]
148}
149.c2 bind m2 <B1-Motion> {
150    .c2 coords m2 [.c2 canvasx %x] 0 [.c2 canvasx %x] 100
151    .c itemconf sect -end [expr int(16000 * [.c2 canvasx %x] / 600)]
152}
153