home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / demos / Snack / Section.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  5.2 KB  |  153 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish8.3 "$0" "$@"
  4.  
  5. package require -exact snack 2.1
  6.  
  7. set width 300
  8. set height 200
  9. set start 0
  10. set end 48000
  11. set stipple ""
  12. set winlen 256
  13. set fftlen 512
  14. set filename section.ps
  15. set topfr 8000
  16. set maxval 0.0
  17. set minval -80.0
  18. set skip 500
  19. set atype FFT
  20. set order 20
  21. set wtype Hamming
  22. option add *font {Helvetica 10 bold}
  23.  
  24. pack [ canvas .c -width 400 -height 250]
  25. pack [ canvas .c2 -height 50 -width 400 -closeenough 5]
  26. pack [ label .l -text "Drag markers with left mouse button"]
  27. pack [ frame .f1] -pady 2
  28. pack [ 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
  31. pack [ 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
  34. pack [ 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
  37. pack [ 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
  40. pack [ 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
  43. pack [ 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.  
  47. pack [ frame .f2i] -pady 2
  48. pack [ label .f2i.lt -text "Type:"] -side left
  49. tk_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}
  52. pack .f2i.at -side left
  53.  
  54. pack [ label .f2i.lo -text "order:"] -side left
  55. entry .f2i.e -textvariable order -width 3
  56.  
  57. scale .f2i.s -variable order -from 1 -to 40 -orient horiz -length 60 -show no
  58. pack .f2i.e .f2i.s -side left
  59. .f2i.e configure -state disabled
  60. .f2i.s configure -state disabled
  61. bind .f2i.e <Key-Return> {.c itemconf sect -lpcorder $order}
  62. bind .f2i.s <Button1-Motion> {.c itemconf sect -lpcorder $order}
  63.  
  64. tk_optionMenu .f2i.cm wtype Hamming Hanning Bartlett Blackman Rectangle
  65. for {set i 0} {$i < 5} {incr i} {
  66.   .f2i.cm.menu entryconfigure $i -command {.c itemconf sect -windowtype $wtype}
  67. }
  68. pack .f2i.cm -side left
  69.  
  70. pack [ label .f2i.lw -text "window:"] -side left
  71. foreach 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.  
  76. pack [ frame .f3i] -pady 2
  77. pack [ label .f3i.lf -text "FFT points:"] -side left
  78. foreach 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.  
  83. set frame 1
  84. pack [ frame .f2] -pady 2
  85. pack [ checkbutton .f2.f -text Frame -variable frame \
  86.     -command {.c itemconf sect -frame $frame}] -side left
  87.  
  88. foreach 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. }
  92. set color Black
  93.  
  94. foreach {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.  
  99. pack [ frame .f3] -pady 2
  100. pack [ button .f3.br -bitmap snackRecord -command Record -fg red] -side left
  101. pack [ button .f3.bs -bitmap snackStop -command [list s stop]] -side left
  102. pack [ label .f3.l -text "Load sound file:"] -side left
  103. pack [ button .f3.b1 -text ex1.wav -command [list s read ex1.wav]] -side left
  104. pack [ button .f3.b2 -text ex2.wav -command [list s read ex2.wav]] -side left
  105.  
  106. proc Record {} {
  107.     s record
  108.     after cancel {.f3.bs invoke}
  109.     after 10000 {.f3.bs invoke}
  110. }
  111.  
  112. pack [ frame .f4] -pady 2
  113. pack [ label .f4.l -text "Generate postscript file:"] -side left
  114. pack [ entry .f4.e -textvariable filename] -side left
  115. pack [ button .f4.b -text Save -command {.c postscript -file $filename}] \
  116.     -side left
  117.  
  118. pack [ button .bClose -text Close -command exit]
  119.  
  120. bind .c <1> [list initDrag %x %y]
  121. bind .c <B1-Motion> [list Drag %x %y]
  122.  
  123. proc initDrag {x y} {
  124.   set ::ox [.c canvasx $x]
  125.   set ::oy [.c canvasy $y]
  126. }
  127.  
  128. proc 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.  
  136. snack::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.