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 / snamp.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  5.9 KB  |  235 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. # Try to load optional file format handlers
  7. catch { package require snacksphere }
  8. catch { package require snackogg }
  9.  
  10. # If they are present add new filetypes to file dialogs
  11. set extTypes  {}
  12. set loadTypes {}
  13. set loadKeys  {}
  14. set saveTypes {}
  15. set saveKeys  {}
  16. if {[info exists snack::snacksphere]} {
  17.     lappend extTypes {SPHERE .sph} {SPHERE .wav}
  18.     lappend loadTypes {{SPHERE Files} {.sph}} {{SPHERE Files} {.wav}}
  19.     lappend loadKeys SPHERE SPHERE
  20. }
  21. if {[info exists snack::snackogg]} {
  22.   lappend extTypes  {OGG .ogg}
  23.   lappend loadTypes {{Ogg Vorbis Files} {.ogg}}
  24.   lappend loadKeys  OGG
  25.   lappend saveTypes {{Ogg Vorbis Files} {.ogg}}
  26.   lappend saveKeys  OGG
  27. }
  28. snack::addExtTypes $extTypes
  29. snack::addLoadTypes $loadTypes $loadKeys
  30. snack::addSaveTypes $saveTypes $saveKeys
  31.  
  32.  
  33. snack::debug 0
  34. snack::sound s -debug 0
  35. snack::sound s2
  36. snack::sound sa
  37.  
  38. set timestr ""
  39. option add *font {Helvetica 10 bold}
  40. wm title . "Snack Audio MPEG Player"
  41.  
  42. if 0 {
  43. set draw 1
  44. pack [frame .f]
  45. pack [canvas .f.c -width 140 -height 40] -side left
  46. pack [checkbutton .f.a -text Analyzer -variable draw] -side left
  47.  
  48. for {set i 0} {$i<16} {incr i} {
  49.   .f.c create rect [expr 10*$i] 20 [expr 10*$i+10] 40 -fill green  -outline ""
  50.   .f.c create rect [expr 10*$i] 10 [expr 10*$i+10] 20 -fill yellow -outline ""
  51.   .f.c create rect [expr 10*$i] 0  [expr 10*$i+10] 10 -fill red   -outline ""
  52.   .f.c create rect [expr 10*$i] 0  [expr 10*$i+10] 40 -fill black -tag c$i
  53. }
  54. for {set i 0} {$i<17} {incr i} {
  55.   .f.c create line [expr 10*$i] 0 [expr 10*$i] 40 -width 5
  56. }
  57. for {set i 0} {$i<7} {incr i} {
  58.   .f.c create line 0 [expr 6*$i] 140 [expr 6*$i] -width 3
  59. }
  60. }
  61.  
  62. pack [frame .frame] -side top -expand yes -fill both
  63. scrollbar .frame.scroll -command ".frame.list yview"
  64. listbox .frame.list -yscroll ".frame.scroll set" -setgrid 1 -selectmode single -exportselection false -height 16
  65. pack .frame.scroll -side right -fill y
  66. pack .frame.list -side left -expand 1 -fill both
  67. bind .frame.list <Double-ButtonPress-1> Play
  68. bind .frame.list <B1-Motion> {Drag %y}
  69. bind .frame.list <ButtonPress-1> {Select %y}
  70. bind . <BackSpace> Cut
  71.  
  72. snack::createIcons
  73. pack [frame .panel] -side bottom -before .frame
  74. pack [button .panel.bp -bitmap snackPlay -command Play] -side left
  75. pack [button .panel.bs -bitmap snackStop -command Stop] -side left
  76. pack [button .panel.bo -image snackOpen -command Open] -side left
  77. set p 0
  78. pack [scale .panel.ss -show no -orient horiz -len 130 -var p] -side left
  79. set gain [snack::audio play_gain]
  80. pack [scale .panel.sv -show no -orient horiz -command {snack::audio play_gain}\
  81.     -len 70 -var gain] -side left
  82. set setdrag 1
  83. bind .panel.ss <ButtonPress-1> {set setdrag 0}
  84. bind .panel.ss <ButtonRelease-1> {set setdrag 1 ; Play2}
  85. pack [label .panel.l -textvar timestr]
  86.  
  87. proc Open {} {
  88.     global files
  89.     set file [snack::getOpenFile -format MP3]
  90.     if {$file != ""} {
  91.     set name [file tail $file]
  92.     set files($name) $file
  93.     .frame.list insert end $name
  94.     }
  95. }
  96.  
  97. proc Play args {
  98.     global files t0 filelen
  99.     if {[.frame.list curselection] == ""} {
  100.     set i 0
  101.     } else {
  102.     set i [lindex [.frame.list curselection] 0]
  103.     }
  104.     .frame.list selection set $i
  105.     Stop
  106.     s config -file $files([.frame.list get $i])
  107.     sa config -file $files([.frame.list get $i])
  108.     if {$args == ""} {
  109.     s play -command Next
  110.     set t0 [clock scan now]
  111.     } else {
  112.     s play -start $args -command Next
  113.     set t0 [expr [clock scan now] - $args / [s cget -rate]]
  114.     }
  115.     set filelen [s length]
  116.     Timer
  117. }
  118.  
  119. proc Play2 {} {
  120.     global filelen p
  121.     Play [expr int($p/100.0*[s length])]
  122. }
  123.  
  124. proc Stop {} {
  125.     s stop
  126.     after cancel Timer
  127. }
  128.  
  129. proc Timer {} {
  130.     global t0 timestr setdrag
  131.     set time [expr [clock scan now] - $t0]
  132.     set timestr [clock format $time -format "%M:%S"]
  133.     if $setdrag {
  134.     .panel.ss set [expr int(100 * $time / [s length -unit sec])]
  135.     }
  136. #    Draw
  137.     after 100 Timer
  138. }
  139.  
  140. proc Next {} {
  141.     set i [lindex [.frame.list curselection] 0]
  142.     if {$i == ""} return
  143.     .frame.list selection clear $i
  144.     incr i
  145.     .frame.list selection set $i
  146.     .frame.list see $i
  147.     after 10 Play
  148. }
  149.  
  150. set cut ""
  151. proc Cut {} {
  152.     global cut
  153.     if {[.frame.list curselection] != ""} {
  154.     set cut [.frame.list get [.frame.list curselection]]
  155.     .frame.list delete [.frame.list curselection]
  156.     }
  157. }
  158.  
  159. proc Select y {
  160.     global old timestr files
  161.     set old [.frame.list nearest $y]
  162.     s2 config -file $files([.frame.list get $old])
  163.     set timestr [clock format [expr int([s2 length -unit sec])] -format "%M:%S"]
  164. }
  165.  
  166. proc Drag y {
  167.     global old
  168.     set new [.frame.list nearest $y]
  169.     if {$new == -1} return
  170.     set tmp [.frame.list get $old]
  171.     .frame.list delete $old
  172.     .frame.list insert $new $tmp
  173.     .frame.list selection set $new
  174.     set old $new
  175. }
  176.  
  177. array set map {
  178.     0 2
  179.     1 3
  180.     2 4
  181.     3 5
  182.     4 7
  183.     5 9
  184.     6 12
  185.     7 15
  186.     8 19
  187.     9 23
  188.     10 28
  189.     11 34
  190.     12 41
  191.     13 49
  192.     14 56
  193.     15 63
  194. }
  195.  
  196. proc Draw {} {
  197.     global draw
  198.     if ![snack::audio active] return
  199.     if {$draw == 1} {
  200. puts [time {
  201.     set pos [expr int([s cget -rate] * [snack::audio elapsed])]
  202.         if {$pos > 1000} {
  203.          set junk [sa sample [expr $pos - 1000]]
  204.          set junk [sa sample [expr $pos - 100]]
  205.          set junk [sa sample [expr $pos]]
  206. puts $junk
  207.     }
  208.     set spec [sa dBPower -start $pos -fftlen 128 -windowlength 128]
  209.     for {set i 0} {$i < 16} {incr i} {
  210.         set val [lindex $spec $::map($i)]
  211.         .f.c coords c$i [expr 10*($i-2)] 0 [expr 10*($i-2)+9] \
  212.             [expr 100-1.4*($val+100)]
  213.     }
  214.     }]
  215.     }
  216. }
  217.  
  218. if [info exists argv] {
  219.  if [file isdirectory $argv] {
  220.   catch {cd $argv}
  221.  }
  222. }
  223.  
  224. wm protocol . WM_DELETE_WINDOW exit
  225.  
  226. set filelist [glob -nocomplain *.mp3 *.wav *.MP3 *.WAV]
  227. if {[info exists snack::snackogg]} {
  228.   set filelist [concat $filelist [glob -nocomplain *.ogg *.OGG]]
  229. }
  230. foreach file [lsort -dictionary $filelist] {
  231.     set name [file tail $file]
  232.     set files($name) $file
  233.     .frame.list insert end $file
  234. }
  235.