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 / cool.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  12.1 KB  |  420 lines
  1. #!/bin/sh
  2. # the next line restarts using wish \
  3. exec wish8.3 "$0" "$@"
  4.  
  5. # An example of how to build a sound application using Snack.
  6. # Can also be used as a base for specialized applications.
  7.  
  8. package require -exact snack 2.1
  9. # Try to load optional file format handlers
  10. catch { package require snacksphere }
  11. catch { package require snackogg }
  12.  
  13. # If they are present add new filetypes to file dialogs
  14. set extTypes  {}
  15. set loadTypes {}
  16. set loadKeys  {}
  17. set saveTypes {}
  18. set saveKeys  {}
  19. if {[info exists snack::snacksphere]} {
  20.     lappend extTypes {SPHERE .sph} {SPHERE .wav}
  21.     lappend loadTypes {{SPHERE Files} {.sph}} {{SPHERE Files} {.wav}}
  22.     lappend loadKeys SPHERE SPHERE
  23. }
  24. if {[info exists snack::snackogg]} {
  25.   lappend extTypes  {OGG .ogg}
  26.   lappend loadTypes {{Ogg Vorbis Files} {.ogg}}
  27.   lappend loadKeys  OGG
  28.   lappend saveTypes {{Ogg Vorbis Files} {.ogg}}
  29.   lappend saveKeys  OGG
  30. }
  31. snack::addExtTypes $extTypes
  32. snack::addLoadTypes $loadTypes $loadKeys
  33. snack::addSaveTypes $saveTypes $saveKeys
  34.  
  35. set v(debug) 0
  36. snack::sound snd -debug $v(debug)
  37. set v(rate) 16000
  38. set v(width) 600
  39. set v(height) 150
  40. set v(pps) 10
  41. set v(start) 0
  42. set v(end) [snd length]
  43. set v(pausex) -1
  44. set v(x0) 0
  45. set v(fileName) ""
  46. set v(skip) 0
  47. set v(rate) 16000
  48. set v(sfmt) LIN16
  49. set v(chan) 1
  50. set v(byteOrder) ""
  51.  
  52. wm protocol . WM_DELETE_WINDOW exit
  53.  
  54. pack [set s [scrollbar .scroll -orient horiz -command Scroll]] -fill x
  55. $s set 0 1
  56. #bind $s <ButtonRelease-1> Redisplay
  57.  
  58. pack [set c [canvas .c -width $v(width) -height $v(height) -highlightthi 0]] \
  59.     -expand yes -fill both
  60. $c create waveform 0 0 -sound snd -height $v(height) -width $v(width) \
  61.     -tag [list obj wave] -progress snack::progressCallback -trimstart 1 \
  62.     -debug $v(debug)
  63. if [string match macintosh $::tcl_platform(platform)] {
  64.     $c create rect  -1 -1 -1 -1 -tags mark -width 2 -outline red
  65. } else {
  66.     $c create rect  -1 -1 -1 -1 -tags mark -fill yellow -stipple gray25 \
  67.         -width 2 -outline red
  68. }
  69. $c create line -1 -1 -1 -1 -fill red -tags playmark
  70.  
  71. bind $c <ButtonPress-1>   { Button1Press %x }
  72. bind $c <ButtonRelease-1> { Button1Release }
  73. bind $c <Configure> Reconfigured
  74. bind $c <Double-Button-1> ClearMark
  75.  
  76. pack [frame .f] -side bottom -before $c -fill x
  77. pack [button .f.pl -bitmap snackPlay -command {Play 0}] -side left
  78. pack [button .f.pa -bitmap snackPause -command Pause] -side left
  79. pack [button .f.st -bitmap snackStop -command Stop] -side left
  80. snack::createIcons
  81. pack [button .f.op -image snackOpen -command LoadSound] -side left
  82. pack [button .f.zi -image snackZoomIn -command ZoomIn] -side left
  83. pack [button .f.zo -image snackZoomOut -command ZoomOut] -side left
  84. pack [radiobutton .f.rs -text Spectrogram -command DrawSpectrogram -val 1] -side left
  85. pack [radiobutton .f.rw -text Waveform -command DrawWaveform -val ""] -side left
  86. pack [label .f.l -textvar v(time)] -side left
  87.  
  88. proc ZoomIn {} {
  89.     global v c s
  90.  
  91.     set co [$c coords mark]
  92.     set start [expr int($v(start) + double($v(rate)) * [lindex $co 0] / $v(pps))]
  93.     set end   [expr int($v(start) + double($v(rate)) * [lindex $co 2] / $v(pps))]
  94.     if {$start == $end || [snd length] == 0} return
  95.  
  96. # Update scrollbar
  97.     $s set [expr double($start)/[snd length]] [expr double($end)/[snd length]]
  98.  
  99.     set v(pps) [expr $v(width) / (double($end - $start) / $v(rate))]
  100.     set v(start) $start
  101.     set v(end)   $end
  102.     ClearMark
  103.     Redisplay
  104. }
  105.  
  106. proc ZoomOut {} {
  107.     global v c s
  108.  
  109.     set n 2.0
  110.     set delta [expr int($v(rate) * $v(width) / $v(pps))]
  111.     set start [expr int($v(start)-($n-1)/2*$delta)]
  112.     set end   [expr int($v(start)+$delta+($n-1)/2*$delta)]
  113.     if {$start < 0}        { set start 0 }
  114.     if {$end > [snd length]} { set end [snd length] }
  115.     if {$start == $end} return
  116.  
  117. # Update scrollbar
  118.     $s set [expr double($start)/[snd length]] [expr double($end)/[snd length]]
  119.  
  120.     set v(pps) [expr $v(width) / (double($end - $start) / $v(rate))]
  121.     set v(start) $start
  122.     set v(end)   $end
  123.     ClearMark
  124.     Redisplay
  125. }
  126.  
  127. proc Scroll args {
  128.     global v s
  129.  
  130.     set delta [expr int($v(rate) * $v(width) / $v(pps))]
  131.     if {[lindex $args 0] == "moveto"} {
  132.     set v(start) [expr int([snd length] * [lindex $args 1])]
  133.     } elseif {[lindex $args 0] == "scroll"} {
  134.     if {[lindex $args 1] > 0} {
  135.         set v(start) [expr $v(start)+$delta]
  136.     } else {
  137.         set v(start) [expr $v(start)-$delta]
  138.     }
  139.     }
  140.     if {$v(start) < 0} { set v(start) 0 }
  141.     if {[expr $v(start)+$delta] > [snd length]} {
  142.     set v(start) [expr [snd length]-$delta]
  143.     }
  144.     set v(end) [expr $v(start)+$delta]
  145.  
  146. # Update scrollbar
  147.     $s set [expr double($v(start))/[snd length]] [expr double($v(end))/[snd length]]
  148.     ClearMark
  149.     Redisplay
  150. }
  151.  
  152. proc Redisplay {} {
  153.     global v c
  154.  
  155. # Display section [$start, $end] of the sound
  156.     $c itemconf obj -start $v(start) -end $v(end)
  157. }
  158.  
  159. proc Button1Press {x} {
  160.     global c
  161.  
  162.     set xc [$c canvasx $x]
  163.     $c raise mark
  164.     $c coords mark $xc 0 $xc [expr [winfo height $c]-2]
  165.     bind $c <Motion> { Button1Motion %x }
  166. }
  167.  
  168. proc Button1Motion {x} {
  169.     global c
  170.  
  171.     set xc [$c canvasx $x]
  172.     if {$xc < 0} { set xc 0 }
  173.     if {$xc > [winfo width $c]} { set xc [winfo width $c] }
  174.     set co [$c coords mark]
  175.     $c coords mark [lindex $co 0] 0 $xc [expr [winfo height $c]-2]
  176.     ShowTime
  177. }
  178.  
  179. proc Button1Release {} {
  180.     global c
  181.  
  182.     bind $c <Motion> {}
  183.     ShowTime
  184. }
  185.  
  186. proc DrawSpectrogram {} {
  187.     global v c
  188.  
  189.     $c delete obj
  190.     set colors {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \
  191.         #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00}
  192.     $c create spectrogram 0 0 -sound snd -height [winfo height $c]  \
  193.         -width [winfo width $c] -start $v(start) -end $v(end) \
  194.         -colormap $colors -tag obj -debug $v(debug)
  195.     $c lower obj
  196. }
  197.  
  198. proc DrawWaveform {} {
  199.     global v c
  200.  
  201.     $c delete obj
  202.     if {$v(fileName) == ""} {
  203.     $c create waveform 0 0 -sound snd -height [winfo height $c] \
  204.         -debug $v(debug) -width [winfo width $c] -tag [list obj wave]
  205.     } else {
  206.     snack::deleteInvalidShapeFile [file tail $v(fileName)]
  207.     $c create waveform 0 0 -sound snd -height [winfo height $c] \
  208.         -debug $v(debug) -trimstart 1 \
  209.         -width [winfo width $c] -start $v(start) -end $v(end) \
  210.         -tag [list obj wave] -progress snack::progressCallback
  211.     snack::makeShapeFileDeleteable [file tail $v(fileName)]
  212.     }
  213.     $c lower obj
  214. }
  215.  
  216. proc LoadSound {} {
  217.     global v c s
  218.  
  219.     set fileName [snack::getOpenFile]
  220.     if {$fileName == ""} return
  221.     $c itemconf wave -sound ""
  222.     set tmps [snack::sound]
  223.     set ffmt [$tmps read $fileName -end 1 -guessproperties 1]
  224.     if {$ffmt == "RAW"} {
  225.     set v(rate)      [$tmps cget -rate]
  226.     set v(sfmt)      [$tmps cget -encoding]
  227.     set v(chan)      [$tmps cget -channels]
  228.     set v(byteOrder) [$tmps cget -byteorder]
  229.     if {[InterpretRawDialog] == "cancel"} {
  230.         $tmps destroy
  231.         return
  232.     }
  233.     }
  234.     $tmps destroy
  235.     snd config -file $fileName -skip $v(skip) \
  236.         -rate $v(rate) -encoding $v(sfmt) -channels $v(chan) \
  237.         -byteorder $v(byteOrder)
  238.     set v(rate) [snd cget -rate]
  239.     set v(start) 0
  240.     set v(end) [snd length]
  241.     set v(pps) [expr $v(width) / (double($v(end) - $v(start)) / $v(rate))]
  242.     set v(fileName) $fileName
  243. # Update scrollbar
  244.     $s set 0.0 1.0
  245.     wm title . [file tail $fileName]
  246.     snack::deleteInvalidShapeFile [file tail $fileName]
  247.     $c itemconf wave -sound snd -start $v(start) -end $v(end) \
  248.         -shapefile [file rootname [file tail $fileName]].shape
  249.     snack::makeShapeFileDeleteable [file tail $fileName]
  250.     Redisplay
  251.     ShowTime
  252. }
  253.  
  254. proc InterpretRawDialog {} {
  255.     global v
  256.  
  257.     set w .rawDialog
  258.     toplevel $w -class Dialog
  259.     frame $w.q
  260.     pack $w.q -expand 1 -fill both -side top
  261.     pack [frame $w.q.f1] -side left -anchor nw -padx 3m -pady 2m
  262.     pack [frame $w.q.f2] -side left -anchor nw -padx 3m -pady 2m
  263.     pack [frame $w.q.f3] -side left -anchor nw -padx 3m -pady 2m
  264.     pack [frame $w.q.f4] -side left -anchor nw -padx 3m -pady 2m
  265.     pack [label $w.q.f1.l -text "Sample Rate"]
  266.     foreach e [snack::audio rates] {
  267.     pack [radiobutton $w.q.f1.r$e -text $e -val $e -var ::v(rate)]\
  268.         -anchor w
  269.     }
  270.     pack [label $w.q.f2.l -text "Sample Encoding"]
  271.     foreach e [snack::audio encodings] {
  272.     pack [radiobutton $w.q.f2.r$e -text $e -val $e -var ::v(sfmt)]\
  273.         -anchor w
  274.     }
  275.     pack [label $w.q.f3.l -text Channels]
  276.     pack [radiobutton $w.q.f3.r1 -text Mono -val 1 -var ::v(chan)] -anchor w
  277.     pack [radiobutton $w.q.f3.r2 -text Stereo -val 2 -var ::v(chan)] -anchor w
  278.     pack [radiobutton $w.q.f3.r4 -text 4 -val 4 -var ::v(chan)] -anchor w
  279.     pack [entry $w.q.f3.e -textvariable ::v(chan) -width 3] -anchor w
  280.     pack [label $w.q.f4.l -text "Byte Order"]
  281.     pack [radiobutton $w.q.f4.ri -text "Little Endian\n(Intel)" \
  282.         -value littleEndian -var ::v(byteOrder)] -anchor w
  283.     pack [radiobutton $w.q.f4.rm -text "Big Endian\n(Motorola)" \
  284.         -value bigEndian -var ::v(byteOrder)] -anchor w
  285.     pack [label $w.q.f4.l2 -text "\nRead Offset (bytes)"]
  286.     pack [entry $w.q.f4.e -textvar v(skip) -wi 6]
  287.     snack::makeDialogBox $w -title "Interpret Raw File As" -type okcancel
  288. }
  289.  
  290. proc ClearMark {} {
  291.     global c
  292.  
  293.     $c coords mark -1 -1 -1 -1
  294.     ShowTime
  295. }
  296.  
  297. proc Reconfigured {} {
  298.     global v c
  299.  
  300.     if {$v(end) == $v(start)} return
  301.     set co [$c coords mark]
  302.     if {[lindex $co 0] != -1} {
  303.     set start [expr int($v(start) + double($v(rate))*[lindex $co 0] / $v(pps))]
  304.     set end   [expr int($v(start) + double($v(rate))*[lindex $co 2] / $v(pps))]
  305.     set x0temp [expr int($v(start) + double($v(rate))*$v(x0) / $v(pps))]
  306.     }
  307.     set newHeight [winfo height $c]
  308.     set newWidth  [winfo width $c]
  309.     $c itemconf obj -height $newHeight -width $newWidth
  310.     set v(pps) [expr $newWidth / (double($v(end) - $v(start)) / $v(rate))]
  311.     set v(width)  $newWidth
  312.     set v(height) $newHeight
  313.     if {[lindex $co 0] != -1} {
  314.     set left  [expr double($start - $v(start))/$v(rate)*$v(pps)]
  315.     set right [expr double($end   - $v(start))/$v(rate)*$v(pps)]
  316.     set v(x0) [expr double($x0temp - $v(start))/$v(rate)*$v(pps)]
  317.     $c coords mark $left 0 $right [expr [winfo height $c]-2]
  318.     }
  319. }
  320.  
  321. proc Play x {
  322.     global v c s
  323.  
  324.     snd stop
  325.     set c0 [lindex [$c coords mark] 0]
  326.     set c2 [lindex [$c coords mark] 2]
  327.     if {$x == 0} {
  328.     set x $c0
  329.     if {$c0 == -1} {
  330.         set l $v(start)
  331.         set r $v(end)        
  332.     } elseif {$c0 == $c2} {
  333.         set l [expr int($v(start) + double($v(rate)) * $c0 / $v(pps))]
  334.         set r $v(end)
  335.     } else {
  336.         set l [expr int($v(start) + double($v(rate)) * $c0 / $v(pps))]
  337.         set r [expr int($v(start) + double($v(rate)) * $c2 / $v(pps))]
  338.     }
  339.     } else {
  340.     if {$c0 == $c2} {
  341.         set l [expr int($v(start) + double($v(rate)) * $x / $v(pps))]
  342.         set r $v(end)
  343.     } else {
  344.       set l [expr int($v(start) + double($v(rate)) * $x / $v(pps))]
  345.       set r [expr int($v(start) + double($v(rate)) * $c2 / $v(pps))]
  346.     }
  347.     }
  348.     snd play -start $l -end $r
  349.     after 0 PutPlayMarker $x
  350. }
  351.  
  352. proc Pause {} {
  353.     global v
  354.  
  355.     if [snack::audio active] {
  356.     set v(pausex) [expr $v(x0) + $v(pps) * [snack::audio elapsedTime]]
  357.     snd stop
  358.     } elseif {$v(pausex) != -1} {
  359.     Play $v(pausex)
  360.     }
  361. }
  362.  
  363. proc Stop {} {
  364.     global v
  365.  
  366.     snd stop
  367.     set v(pausex) -1
  368. }
  369.  
  370. proc PutPlayMarker args {
  371.     global v c
  372.  
  373.     if ![snack::audio active] {
  374.     $c coords playmark -1 -1 -1 -1
  375.     ShowTime
  376.     return
  377.     }
  378.     if {$args != ""} {
  379.     set v(x0) [lindex $args 0]
  380.     }
  381.     set x [expr $v(x0) + $v(pps) * [snack::audio elapsedTime]]
  382.     set co [$c coords mark]
  383.     if {[lindex $co 0] != [lindex $co 2] && $x > [lindex $co 2]} {
  384.     $c coords playmark -1 -1 -1 -1
  385.     ShowTime
  386.     return
  387.     }
  388.     $c coords playmark $x 0 $x $v(height)
  389.     after 50 PutPlayMarker
  390.     set time [expr int($v(start) + double($v(rate)) * $x / $v(pps))]
  391.     set v(time) "Time: [SampleIndex2Time $time]"
  392. }
  393.  
  394. proc ShowTime {} {
  395.     global v c
  396.  
  397.     set co [$c coords mark]
  398.     set start [expr int($v(start) + double($v(rate)) * [lindex $co 0] / $v(pps))]
  399.     set end   [expr int($v(start) + double($v(rate)) * [lindex $co 2] / $v(pps))]
  400.     if {[lindex $co 0] < 0.0} {
  401.     set v(time) "Length: [SampleIndex2Time [snd length -unit samples]]"
  402.     return
  403.     }
  404.     set v(t1) [SampleIndex2Time $start]
  405.     set v(t2) [SampleIndex2Time $end]
  406.     if {$end == $start} {
  407.     set v(time) "Time: $v(t1)"
  408.     return
  409.     }
  410.     set v(time) "\[$v(t1)-$v(t2)\]"
  411. }
  412.  
  413. proc SampleIndex2Time index {
  414.     global v
  415.  
  416.     set sec [expr int($index / $v(rate))]
  417.     set dec [format "%.2d" [expr int(100*((double($index) / $v(rate))-$sec))]]
  418.     return [clock format $sec -format "%M:%S.$dec"]
  419. }
  420.