1#!/bin/sh 2# the next line restarts using wish \ 3exec wish8.4 "$0" "$@" 4 5package require -exact snack 2.2 6package require http 7if {[catch {package require tile} msg]} { 8} else { 9 namespace import -force ttk::button 10} 11 12option add *font {Helvetica 10 bold} 13set home http://www.speech.kth.se/snack/ 14set version "" 15set colors {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \ 16 #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00} 17 18snack::sound s1 -load ex1.wav 19snack::sound s2 20 21snack::menuInit 22snack::menuPane File 23snack::menuCommand File About { tk_messageBox -icon info -type ok \ 24 -title "About Widget Demo" -message \ 25 "Snack sound toolkit demonstration\n\n\ 26 Get the latest version at $home\n\n\ 27 Copyright (c) 1997-2001\n\nKare Sjolander" 28} 29snack::menuCommand File "Version" { 30 set version "Looking up latest version at $home ..." 31 catch {::http::geturl $home/$tcl_platform(platform).date -command CheckV} 32} 33snack::menuCommand File Mixer... snack::mixerDialog 34snack::menuCommand File Quit exit 35 36proc CheckV token { 37 set ::version "Your version of Snack was released December 14, 2005. \ 38 Latest version released [::http::data $token]." 39} 40 41# Title label 42 43pack [frame .t] -pady 5 44pack [label .t.l -text "Snack Sound Toolkit Demonstrations"\ 45 -font {Helvetica 14 bold}] 46 47# Basic sound handling 48 49snack::createIcons 50pack [frame .f0] -pady 5 51pack [label .f0.l -text "Basic sound handling:"] -anchor w 52label .f0.time -text "0.00 sec" -width 10 53button .f0.bp -image snackPlay -command {s2 play} 54button .f0.bu -image snackPause -command {s2 pause} 55button .f0.bs -image snackStop -command {s2 stop ; after cancel Timer} 56button .f0.br -image snackRecord -command {s2 record ; Timer} 57button .f0.bl -image snackOpen -command OpenSound -width 21 -height 21 58button .f0.ba -image snackSave -command SaveSound -width 21 -height 21 59pack .f0.bp .f0.bu .f0.bs .f0.br .f0.bl .f0.ba .f0.time -side left 60 61proc OpenSound {} { 62 set filename [snack::getOpenFile] 63 if {$filename == ""} return 64 s2 read $filename 65 .f0.time config -text [format "%.2f sec" [s2 length -unit seconds]] 66} 67 68proc SaveSound {} { 69 set filename [snack::getSaveFile] 70 if {$filename == ""} return 71 s2 write $filename 72} 73 74proc Timer {} { 75 .f0.time config -text [format "%.2f sec" [s2 length -unit seconds]] 76 after 100 Timer 77} 78 79# Canvas item types 80 81pack [canvas .c -width 680 -height 140 -highlightthickness 0] -pady 5 82.c create text 0 0 -text "Waveform canvas item type:" -anchor nw 83.c create waveform 0 20 -sound s1 -height 120 -width 250 -frame yes 84.c create text 250 0 -text "Spectrogram canvas item type:" -anchor nw 85.c create spectrogram 250 20 -sound s1 -hei 120 -wid 250 -colormap $colors 86.c create text 480 0 -text "Spectrum section canvas item type:" -anchor nw 87.c create section 500 20 -sound s1 -height 120 -width 180 -frame yes -start 8002 -end 10000 -minval -100 88 89pack [frame .f1] -pady 2 90pack [label .f1.l -text "Waveform examples:" -wi 27 -anchor w] -side left 91pack [button .f1.b1 -text "Simple" -command {Run MinWave.tcl}] -side left 92pack [button .f1.b2 -text "See Code" -command {Browse MinWave.tcl}] -side left 93pack [button .f1.b3 -text "Fancy" -command {Run Waveform.tcl}] -side left 94pack [button .f1.b4 -text "See Code" -command {Browse Waveform.tcl}] -side left 95pack [frame .f2] -pady 2 96pack [label .f2.l -text "Spectrogram examples:" -wi 27 -anchor w] -side left 97pack [button .f2.b1 -text "Simple" -command {Run MinSpeg.tcl}] -side left 98pack [button .f2.b2 -text "See Code" -command {Browse MinSpeg.tcl}] -side left 99pack [button .f2.b3 -text "Fancy" -command {Run Spectrogram.tcl}] -side left 100pack [button .f2.b4 -text "See Code" -command {Browse Spectrogram.tcl}] -side left 101pack [frame .f3] -pady 2 102pack [label .f3.l -text "Spectrum section examples:" -wi 27 -anchor w] -side left 103pack [button .f3.b1 -text "Simple" -command {Run MinSect.tcl}] -side left 104pack [button .f3.b2 -text "See Code" -command {Browse MinSect.tcl}] -side left 105pack [button .f3.b3 -text "Fancy" -command {Run Section.tcl}] -side left 106pack [button .f3.b4 -text "See Code" -command {Browse Section.tcl}] -side left 107pack [frame .f4] -pady 2 108pack [label .f4.l -text "Filter examples:"] -side left 109pack [button .f4.b1 -text "Channel Map" -command {Run mapChan.tcl}] -side left 110pack [button .f4.b2 -text "Echo" -command {Run echo.tcl}] -side left 111pack [button .f4.b3 -text "Composite" -command {Run compose.tcl}] -side left 112pack [button .f4.b4 -text "Generator" -command {Run generator.tcl}] -side left 113pack [button .f4.b5 -text "Generator2" -command {Run generator2.tcl}] -side left 114pack [button .f4.b6 -text "Notescale" -command {Run notescale.tcl}] -side left 115pack [frame .f5] -pady 2 116pack [label .f5.l -text "Sound tools:"] -side left 117pack [button .f5.b1 -text "Simple" -command {Run cool.tcl}] -side left 118pack [button .f5.b2 -text "dbrec" -command {Run dbrec.tcl}] -side left 119pack [button .f5.b3 -text "record" -command {Run record.tcl}] -side left 120pack [button .f5.b4 -text "xs" -command {Run xs.tcl demo}] -side left 121pack [label .f5.l2 -text "MP3 player:"] -side left 122pack [button .f5.b5 -text "tomAmp" -command {Run tomAmp.tcl}] -side left 123pack [label .f5.l3 -text "Mixer:"] -side left 124pack [button .f5.b6 -text "mixer" -command {Run mixer.tcl}] -side left 125pack [frame .f6] -pady 2 126pack [label .f6.l -text "Speech toys:"] -side left 127pack [button .f6.b1 -text "Synthesis" -command {Run formant.tcl}] -side left 128pack [button .f6.b2 -text "Pitch" -command {Run pitch.tcl}] -side left 129pack [button .f6.b3 -text "Phonetogram" -command {Run phonetogram.tcl}] -side left 130pack [button .f6.b4 -text "Vowel-space" -command {Run vowelspace.tcl}] -side left 131pack [button .f6.b5 -text "Spectrum" -command {Run polarspec.tcl}] -side left 132if {$::tcl_platform(platform) == "unix" || \ 133 $::tcl_platform(platform) == "windows"} { 134 pack [label .f6.l2 -text "Script compiler:"] -side left 135 pack [button .f6.b6 -text "wrap" -command {Run wrap.tcl}] -side left 136 pack [label .v -textvar version] 137} 138 139proc Run {script {demoFlag 0}} { 140 set i [interp create] 141 load {} Tk $i 142 $i eval rename exit dontexit 143 interp alias $i exit {} interp delete $i 144 if {$demoFlag != 0} { 145 $i eval set demoFlag $demoFlag 146 } 147 $i eval wm title . $script 148 $i eval source $script 149} 150 151proc Browse file { 152 set w .browse 153 catch {destroy $w} 154 toplevel $w 155 wm title $w "View source: $file" 156 157 pack [ button $w.b -text Close -command "destroy $w"] -side bottom 158 pack [ frame $w.f] -fill both -expand yes 159 text $w.f.t -width 60 -height 20 -setgrid true -wrap none 160 $w.f.t config -xscrollcommand [list $w.f.xscroll set] -yscrollcommand [list $w.f.yscroll set] 161 scrollbar $w.f.xscroll -orient horizontal -command [list $w.f.t xview] 162 scrollbar $w.f.yscroll -orient vertical -command [list $w.f.t yview] 163 pack $w.f.xscroll -side bottom -fill x 164 pack $w.f.yscroll -side right -fill y 165 pack $w.f.t -side left -fill both -expand yes 166 167 if [catch {open $file} in] { 168 set text $in 169 } else { 170 catch {set text [read $in]} 171 } 172 $w.f.t insert 1.0 $text 173} 174