1# -*-Mode:Tcl-*- 2 3catch {tk_getOpenFile -junk} 4 5namespace 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}