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}