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 / cutter.plg < prev    next >
Encoding:
Text File  |  2001-10-22  |  2.0 KB  |  69 lines
  1. # -*-Mode:Tcl-*-
  2.  
  3. namespace eval cutter_v1 {
  4.     variable basename
  5.     variable number
  6.  
  7.     lappend ::v(plugins) ::cutter_v1
  8.     snack::menuCommand Tools {Sound Cutter} ::cutter_v1::CutterWin
  9.  
  10.     proc Describe {} {
  11.     return "A tool for cutting long audio files into several short ones. Specify a basename and an utterance number. The save button saves the current marked region using filename \$basename\$number.wav. The number is also incremented and the markers repositioned."
  12.     }
  13.     
  14.     proc Unload {} {
  15.     snack::menuDelete Tools {Sound Cutter}
  16.     }
  17.     
  18.     proc Redraw y {
  19.     return 0
  20.     }
  21.     
  22.     proc Putmark m {
  23.     }
  24.     
  25.     proc CutterWin {} {
  26.     variable basename
  27.     variable number
  28.  
  29.     set w .cutter
  30.     catch {destroy $w}
  31.     toplevel $w
  32.     wm title $w {Sound cutter tool}
  33.     wm geometry $w [xsGetGeometry]
  34.     
  35.     pack [ frame $w.f1] -pady 2
  36.     pack [ label $w.f1.l1 -text Basename: -wi 20] -side left
  37.     pack [ label $w.f1.l2 -text "Utterance number:" -wi 20] -side left
  38.  
  39.     pack [ frame $w.f2]
  40.     pack [ entry $w.f2.e1 -textvar ::cutter_v1::basename] -side left
  41.     pack [ entry $w.f2.e2 -textvar ::cutter_v1::number] -side left
  42.  
  43.     pack [ frame $w.f3] -pady 10
  44.     pack [ button $w.f3.save -image snackSave -command ::cutter_v1::Save] -side left -padx 5
  45.     pack [ button $w.f3.play -bitmap play -command PlayMark] -side left -padx 5
  46.     pack [ button $w.f3.stop -bitmap stop -command StopPlay] -side left -padx 5
  47.  
  48.     pack [ frame $w.f] -side bottom -fill x   
  49.     label $w.f.lab -text "" -width 1 -relief sunken -bd 1 -anchor w
  50.     pack $w.f.lab -side left -expand yes -fill x
  51.     button $w.f.helpB -text Help -command {tk_messageBox -message [::cutter_v1::Describe] -type ok}
  52.     button $w.f.exitB -text Close -command "destroy $w"
  53.     pack $w.f.helpB $w.f.exitB -side left
  54.     }
  55.  
  56.     proc Save {} {
  57.     variable number
  58.     variable basename
  59.  
  60.     set start [Marker2Sample m1]
  61.     set end   [Marker2Sample m2]
  62.     snd write $basename$number.wav -start $start -end $end
  63.     puts "$basename$number.wav $start $end"
  64.     PutMarker m1 [Marker2Sample m2] 0
  65.     PutMarker m2 [expr [Marker2Sample m2]+32000] 0
  66.     incr number
  67.     }
  68. }
  69.