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 / pitch.plg < prev    next >
Encoding:
Text File  |  2001-10-22  |  2.1 KB  |  85 lines
  1. # -*-Mode:Tcl-*-
  2.  
  3. catch {tk_getOpenFile -junk}
  4.  
  5. namespace eval pitchPlot_v1 {
  6.     variable pitchPlot
  7.  
  8.     set pitchPlot(vector) {}
  9.     set pitchPlot(height) 0
  10.     set pitchPlot(max) 400
  11.     set pitchPlot(min) 60
  12.  
  13.     lappend ::v(plugins) ::pitchPlot_v1
  14.     snack::menuCommand Tools {Plot Pitch} ::pitchPlot_v1::PitchWin
  15.  
  16.     proc Describe {} {
  17.     return "This plug-in adds the capability to plot the pitch of speech."
  18.     }
  19.     
  20.     proc Unload {} {
  21.     snack::menuDelete Tools {Plot Pitch}
  22.     }
  23.     
  24.     proc Redraw ypos {
  25.     global c v
  26.     variable pitchPlot
  27.  
  28.     if {[llength $pitchPlot(vector)] == 0} {
  29.         return 0
  30.     }
  31.     .cf.fyc.yc delete pitch
  32.     snack::frequencyAxis .cf.fyc.yc 0 $ypos $v(yaxisw) $pitchPlot(height) \
  33.         -topfrequency $pitchPlot(max) -tags pitch -fill $v(fg) \
  34.         -font $v(sfont)
  35.  
  36.     $c delete pitch
  37.     set i 0
  38.     foreach val $pitchPlot(vector) {
  39.         set x [expr $i * 0.01 * $v(pps)]
  40.         set y [expr $ypos+$pitchPlot(height)-0.25*$val]
  41.         $c create oval [expr $x-1] [expr $y-1] [expr $x+1] [expr $y+1]\
  42.             -tags pitch
  43.         incr i
  44.     }
  45.     return $pitchPlot(height)
  46.     }
  47.  
  48.     proc Putmark m {
  49.     }
  50.     
  51.     proc ComputeCoords {} {
  52.     global v
  53.     variable pitchPlot
  54.  
  55.     set pitchPlot(vector) [snd pitch -maxpitch $pitchPlot(max) \
  56.         -minpitch $pitchPlot(min) -progress snack::progressCallback]
  57.     set pitchPlot(height) 100
  58.     ::Redraw
  59.     }
  60.     
  61.     proc PitchWin {} {
  62.     global v
  63.     variable pitchPlot
  64.  
  65.     set w .pitch
  66.     catch {destroy $w}
  67.     toplevel $w
  68.     wm title $w "Plot pitch"
  69.     wm geometry $w [xsGetGeometry]
  70.     
  71.     pack [ frame $w.fMax]
  72.     pack [ label $w.fMax.l -text "Max pitch value (Hz):"] -side left
  73.     pack [ entry $w.fMax.e -textvar [namespace current]::pitchPlot(max) -wi 4] -side left
  74.     pack [ frame $w.fMin]
  75.     pack [ label $w.fMin.l -text "Min pitch value (Hz):"] -side left
  76.     pack [ entry $w.fMin.e -textvar [namespace current]::pitchPlot(min) -wi 4] -side left
  77.     pack [ frame $w.fb]
  78.     pack [ button $w.fb.bPlot -text Plot -command ::pitchPlot_v1::ComputeCoords] -side left
  79.  
  80.     pack [ frame $w.f] -side bottom -fill x
  81.     label $w.f.lab -text "" -width 1 -relief sunken -bd 1 -anchor w
  82.     pack $w.f.lab -side left -expand yes -fill x
  83.     pack [ button $w.f.bExit -text Close -command "destroy $w"] -side left
  84.     }
  85. }