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 / Spectrogram.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  4.4 KB  |  126 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 pps 300
  10. set bright 0.0
  11. set contrast 0.0
  12. set winlen 128
  13. set fftlen 256
  14. set gridfspacing 0
  15. set gridtspacing 0.0
  16. set filename spectrogram.ps
  17. set colors {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \
  18.         #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00}
  19. set color Red
  20. set type Hamming
  21. option add *font {Helvetica 10 bold}
  22.  
  23. pack [ canvas .c -width 600 -height 300]
  24. pack [ label .l -text "Drag spectrogram with left mouse button"]
  25. pack [ frame .f1] -pady 2
  26. pack [ scale .f1.s1 -variable width -label Width -from 10 -to 600 -orient hori\
  27.     -length 100 -command {.c itemconf speg -width }] -side left
  28. pack [ scale .f1.s2 -variable height -label Height -from 10 -to 300 -orient\
  29.     hori -length 100 -command {.c itemconf speg -height }] -side left
  30. pack [ scale .f1.s3 -variable pps -label Pix/sec -from 10 -to 600 -orient hori\
  31.     -length 100 -command {.c itemconf speg -pixelspersec }] -side left
  32. pack [ scale .f1.s4 -variable bright -label Brightness -from -100 -to 100\
  33.     -res 0.1 -orient hori -length 100 -command {.c itemconf speg -brightness }] -side left
  34. pack [ scale .f1.s5 -variable contrast -label Contrast -from -100 -to 100 -res 0.1 -orient hori -length 100 -command {.c itemconf speg -contrast }] -side left
  35.  
  36. set topfr 8000
  37. pack [ scale .f1.s7 -variable topfr -label Top -from 1000 -to 8000 -orient hori -length 100 -command {.c itemconf speg -topfr }] -side left
  38.  
  39. pack [ frame .f2] -pady 2
  40. tk_optionMenu .f2.cm type Hamming Hanning Bartlett Blackman Rectangle
  41. for {set i 0} {$i < 5} {incr i} {
  42.   .f2.cm.menu entryconfigure $i -command {.c itemconf speg -windowtype $type}
  43. }
  44. pack .f2.cm -side left
  45. pack [ label .f2.lw -text "window:"] -side left
  46. foreach n {32 64 128 256 512 1024 2048} {
  47.     pack [ radiobutton .f2.w$n -text $n -variable winlen -value $n\
  48.         -command {.c itemconf speg -winlength $winlen}] -side left
  49. }
  50.  
  51. pack [ frame .f3] -pady 2
  52. pack [ label .f3.lf -text "FFT points:"] -side left
  53. foreach n {64 128 256 512 1024 2048 4096} {
  54.     pack [ radiobutton .f3.f$n -text $n -variable fftlen -value $n\
  55.         -command {.c itemconf speg -fft $fftlen}] -side left
  56. }
  57.  
  58. pack [ frame .f4] -pady 2
  59. pack [ label .f4.lf -text "Grid f-spacing:"] -side left
  60. foreach n {0 500 1000 2000} {
  61.     pack [ radiobutton .f4.f$n -text $n -variable gridfspacing -value $n\
  62.         -command {.c itemconf speg -gridfspacing $gridfspacing}] -side left
  63. }
  64. pack [ label .f4.lf2 -text "Grid t-spacing:"] -side left
  65. foreach n {0 1 25 5} {
  66.     pack [ radiobutton .f4.t$n -text 0.$n -variable gridtspacing -value 0.$n\
  67.         -command {.c itemconf speg -gridtspacing $gridtspacing}] -side left
  68. }
  69.  
  70. pack [ frame .f42] -pady 2
  71. pack [ label .f42.lf3 -text "Grid color:"] -side left
  72. foreach f {Black Red Blue White Cyan} {
  73.     pack [ radiobutton .f42.c$f -text $f -variable color -value $f \
  74.         -command {.c itemconf speg -gridcolor $color}] -side left
  75. }
  76.  
  77. pack [ frame .f5] -pady 2
  78. pack [ button .f5.br -bitmap snackRecord -command Record -fg red] -side left
  79. pack [ button .f5.bs -bitmap snackStop -command {s stop}] -side left
  80. pack [ label .f5.l -text "Load sound file:"] -side left
  81. pack [ button .f5.b1 -text ex1.wav -command {s read ex1.wav}] -side left
  82. pack [ button .f5.b2 -text ex2.wav -command {s read ex2.wav}] -side left
  83.  
  84. proc Record {} {
  85.     global width pps
  86.     
  87.     s flush
  88.     .c itemconf speg -pixelspersecond $pps -width $width
  89.     s record
  90.     after cancel {.f5.bs invoke}
  91.     after 10000 {.f5.bs invoke}
  92. }
  93.  
  94. set col ""
  95. pack [ frame .f6] -pady 2
  96. pack [ label .f6.l1 -text "Colors:"] -side left
  97. pack [ radiobutton .f6.r1 -text B/W -var col -val "" -command {.c itemconf speg -colormap $col}] -side left
  98. pack [ radiobutton .f6.r2 -text Rainbow -var col -val $colors -command {.c itemconf speg -colormap $col}] -side left
  99. pack [ label .f6.l2 -text "Generate postscript file:"] -side left
  100. pack [ entry .f6.e -textvariable filename] -side left
  101. pack [ button .f6.b -text Save -command {.c postscript -file $filename}] -side left
  102.  
  103. pack [ button .bClose -text Close -command exit]
  104.  
  105. bind .c <1> [list initDrag %x %y]
  106. bind .c <B1-Motion> [list Drag %x %y]
  107.  
  108. proc initDrag {x y} {
  109.   set ::ox [.c canvasx $x]
  110.   set ::oy [.c canvasy $y]
  111. }
  112.  
  113. proc Drag {x y} {
  114.   set x [.c canvasx $x]
  115.   set y [.c canvasy $y]
  116.   .c move current [expr $x - $::ox] [expr $y - $::oy]
  117.   set ::ox $x
  118.   set ::oy $y
  119. }
  120.  
  121. snack::sound s -load ex1.wav
  122.  
  123. update
  124.  
  125. .c create spectrogram 300 150 -anchor c -sound s -height $height -width $width -tags speg -pixelsp $pps
  126.