1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
#!/bin/sh
# the next line restarts using wish \
exec wish8.5 "$0" "$@"
package require -exact snack 2.2
set width 300
set height 200
set pps 300
set bright 0.0
set contrast 0.0
set winlen 128
set fftlen 256
set gridfspacing 0
set gridtspacing 0.0
set filename spectrogram.ps
set colors {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \
#0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00}
set color Red
set type Hamming
option add *font {Helvetica 10 bold}
pack [ canvas .c -bg lightblue -width 600 -height 300]
pack [ label .l -text "Drag spectrogram with left mouse button"]
pack [ frame .f1] -pady 2
pack [ scale .f1.s1 -variable width -label Width -from 10 -to 600 -orient hori\
-length 100 -command {.c itemconf speg -width }] -side left
pack [ scale .f1.s2 -variable height -label Height -from 10 -to 300 -orient\
hori -length 100 -command {.c itemconf speg -height }] -side left
pack [ scale .f1.s3 -variable pps -label Pix/sec -from 10 -to 600 -orient hori\
-length 100 -command {.c itemconf speg -pixelspersec }] -side left
pack [ scale .f1.s4 -variable bright -label Brightness -from -100 -to 100\
-res 0.1 -orient hori -length 100 -command {.c itemconf speg -brightness }] -side left
pack [ scale .f1.s5 -variable contrast -label Contrast -from -100 -to 100 -res 0.1 -orient hori -length 100 -command {.c itemconf speg -contrast }] -side left
set topfr 8000
pack [ scale .f1.s7 -variable topfr -label Top -from 1000 -to 8000 -orient hori -length 100 -command {.c itemconf speg -topfr }] -side left
pack [ frame .f2] -pady 2
tk_optionMenu .f2.cm type Hamming Hanning Bartlett Blackman Rectangle
for {set i 0} {$i < 5} {incr i} {
.f2.cm.menu entryconfigure $i -command {.c itemconf speg -windowtype $type}
}
pack .f2.cm -side left
pack [ label .f2.lw -text "window:"] -side left
foreach n {32 64 128 256 512 1024 2048} {
pack [ radiobutton .f2.w$n -text $n -variable winlen -value $n\
-command {.c itemconf speg -winlength $winlen}] -side left
}
pack [ frame .f3] -pady 2
pack [ label .f3.lf -text "FFT points:"] -side left
foreach n {64 128 256 512 1024 2048 4096} {
pack [ radiobutton .f3.f$n -text $n -variable fftlen -value $n\
-command {.c itemconf speg -fft $fftlen}] -side left
}
pack [ frame .f4] -pady 2
pack [ label .f4.lf -text "Grid f-spacing:"] -side left
foreach n {0 500 1000 2000} {
pack [ radiobutton .f4.f$n -text $n -variable gridfspacing -value $n\
-command {.c itemconf speg -gridfspacing $gridfspacing}] -side left
}
pack [ label .f4.lf2 -text "Grid t-spacing:"] -side left
foreach n {0 1 25 5} {
pack [ radiobutton .f4.t$n -text 0.$n -variable gridtspacing -value 0.$n\
-command {.c itemconf speg -gridtspacing $gridtspacing}] -side left
}
pack [ frame .f42] -pady 2
pack [ label .f42.lf3 -text "Grid color:"] -side left
foreach f {Black Red Blue White Cyan} {
pack [ radiobutton .f42.c$f -text $f -variable color -value $f \
-command {.c itemconf speg -gridcolor $color}] -side left
}
pack [ frame .f5] -pady 2
pack [ button .f5.br -bitmap snackRecord -command Record -fg red] -side left
pack [ button .f5.bs -bitmap snackStop -command {s stop}] -side left
pack [ label .f5.l -text "Load sound file:"] -side left
pack [ button .f5.b1 -text ex1.wav -command {s read ex1.wav}] -side left
pack [ button .f5.b2 -text ex2.wav -command {s read ex2.wav}] -side left
proc Record {} {
global width pps
s flush
.c itemconf speg -pixelspersecond $pps -width $width
s record
after cancel [list catch {.f5.bs invoke}]
after 10000 [list catch {.f5.bs invoke}]
}
set col ""
pack [ frame .f6] -pady 2
pack [ label .f6.l1 -text "Colors:"] -side left
pack [ radiobutton .f6.r1 -text B/W -var col -val "" -command {.c itemconf speg -colormap $col}] -side left
pack [ radiobutton .f6.r2 -text Rainbow -var col -val $colors -command {.c itemconf speg -colormap $col}] -side left
pack [ label .f6.l2 -text "Generate postscript file:"] -side left
pack [ entry .f6.e -textvariable filename] -side left
pack [ button .f6.b -text Save -command {.c postscript -file $filename}] -side left
pack [ button .bClose -text Close -command exit]
bind .c <1> [list initDrag %x %y]
bind .c <B1-Motion> [list Drag %x %y]
proc initDrag {x y} {
set ::ox [.c canvasx $x]
set ::oy [.c canvasy $y]
}
proc Drag {x y} {
set x [.c canvasx $x]
set y [.c canvasy $y]
.c move current [expr $x - $::ox] [expr $y - $::oy]
set ::ox $x
set ::oy $y
}
snack::sound s -load ex1.wav
update
.c create spectrogram 300 150 -anchor c -sound s -height $height -width $width -tags speg -pixelsp $pps
|
