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 / polarspec.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  1.6 KB  |  67 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 rate 16000
  8. snack::sound s -rate $rate
  9.  
  10. # Length of FFT 
  11. set n 1024
  12. set type FFT
  13.  
  14. # Start recording, create polygon, and schedule a draw in 100 ms
  15.  
  16. proc Start {} {
  17.   Stop
  18.   set ::pos 0
  19.   .c delete all
  20.   .c create polygon -1 -1 -1 -1 -tags polar -fill green
  21.   s record
  22.   after 100 Draw
  23. }
  24.  
  25. # Stop recording and updating the plot
  26.  
  27. proc Stop {} {
  28.   s stop
  29.   after cancel Draw
  30. }
  31.  
  32. # Calculate spectrum and plot it
  33.  
  34. proc Draw {} {
  35.   if {[s length] > $::n} {
  36.     set ::pos [expr [s length] - $::n]
  37.     set spec [s dBPowerSpectrum -start $::pos -fftlen $::n -winlen $::n \
  38.     -analysistype $::type]
  39.     set coords {}
  40.     set f 0.0001
  41.     foreach val $spec {
  42.       set v [expr {6.282985 * log($f)/log(2.0)}]
  43.       set a [expr {[winfo height .c]/214.0*($val+100)}]
  44.       set x [expr {[winfo width .c]/2+$a*cos($v)}]
  45.       set y [expr {[winfo height .c]/2+$a*sin($v)}]
  46.       lappend coords $x $y
  47.       set f [expr {$f + 16000.0 / $::n}]
  48.     }
  49.     eval .c coords polar $coords
  50.   }
  51.   after 10 Draw
  52.   if {[s length -unit sec] > 20} Stop
  53. }
  54.  
  55. # Create simple GUI
  56.  
  57. pack [ frame .f] -side bottom
  58. pack [ button .f.b1 -bitmap snackRecord -command Start -fg red -width 40] \
  59.     -side left
  60. pack [ button .f.b2 -bitmap snackStop   -command Stop -width 40] -side left
  61. pack [ radiobutton .f.b3 -text FFT -variable type -value FFT] -side left
  62. pack [ radiobutton .f.b4 -text LPC -variable type -value LPC] -side left
  63. pack [ canvas .c -width 300 -height 300 -bg black] -side top -expand true \
  64.     -fill both
  65. .c create text 150 150 -text "Polar spectrum plot of microphone signal" \
  66.     -fill red
  67.