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 / spectrum.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  1.3 KB  |  63 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. snack::sound s
  8.  
  9. array set map {
  10.     0 2
  11.     1 3
  12.     2 4
  13.     3 5
  14.     4 7
  15.     5 9
  16.     6 12
  17.     7 15
  18.     8 19
  19.     9 23
  20.     10 28
  21.     11 34
  22.     12 41
  23.     13 49
  24.     14 56
  25.     15 63
  26. }
  27.  
  28. pack [canvas .c -width 140 -height 100]
  29.  
  30. for {set i 0} {$i<16} {incr i} {
  31.   .c create rect [expr 10*$i] 50 [expr 10*$i+10] 100 -fill green  -outline ""
  32.   .c create rect [expr 10*$i] 20 [expr 10*$i+10] 50  -fill yellow -outline ""
  33.   .c create rect [expr 10*$i] 0  [expr 10*$i+10] 20  -fill red   -outline ""
  34.   .c create rect [expr 10*$i] 0  [expr 10*$i+10] 100 -fill black -tag c$i
  35. }
  36. for {set i 0} {$i<17} {incr i} {
  37.   .c create line 0 [expr 6*$i] 140 [expr 6*$i] -width 3
  38.   .c create line [expr 10*$i] 0 [expr 10*$i] 100 -width 5
  39. }
  40.  
  41. pack [frame .f]
  42. pack [button .f.a -text On -command On] -side left
  43. pack [button .f.b -text Off -command {s stop}] -side left
  44.  
  45. proc On {} {
  46.   s record
  47.   after 100 Draw
  48. }
  49.  
  50. proc Draw {} {
  51.   if {[s length] > 129} {
  52.     set spec [s dBPower -fftlen 128 -windowlength 128]
  53.     s length 0
  54.     for {set i 0} {$i < 16} {incr i} {
  55.       set val [lindex $spec $::map($i)]
  56.       .c coords c$i [expr 10*($i-2)] 0 [expr 10*($i-2)+9] \
  57.           [expr 100-1.4*($val+100)]
  58.     }
  59.   }
  60.   if ![snack::audio active] return
  61.   after 100 Draw
  62. }
  63.