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