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