# -----------------------------------------------------------------------------
# Speak.plug version 2.0.5, 1.10.2004
# Mbrola player plugin for wavesurfer 
# 
# (c)2004, Dimitrios Zachariadis 
# dzach_at_hol.gr
# http://users.hol.gr/~dzach/index.htm
#
# First release 16.1.2004
#
# This software is provided as open source, under a GPL license.
# Portions of code have been copied from the WaveSurfer distribution files
# -----------------------------------------------------------------------------

wsurf::RegisterPlugin speak \
	-description "Plug-in that speaks the phonemes from the current or the last label pane found, \
		using the Mbrola engine and voices. Uses a pwline or a pitch contour pane \
		for prosody generation.  \
		Needs setting of the mbrola executable and voice database paths " \
	-addmenuentriesproc speak::addMenuEntries \
	-redrawproc speak::redraw \
	-propertiespageproc speak::propertyPane \
	-applypropertiesproc  speak::applyProperties \
	-panecreatedproc      speak::paneCreated \
	-getconfigurationproc speak::getConfiguration \
	-url http://users.hol.gr/~dzach/wavesurfer/speak.htm

#proctrace::showTraceGUI
#::tkcon::Init

# ----------------------------------------------------------------------------
namespace eval speak {
	variable Info
	set Info(script) [info script]
	set Info(path) ""
	set Info(mbrolaExe) ""
}
# ----------------------------------------------------------------------------
proc speak::widgetDeleted {w pane} {
}
# ----------------------------------------------------------------------------
proc speak::paneCreated { w pane } {
	namespace eval [namespace current]::${pane} {variable var}
	upvar [namespace current]::${pane}::var v
}
# ----------------------------------------------------------------------------
proc speak::addMenuEntries {w pane m hook x y} {
	variable Info
	if {[string match query $hook] || [string match *wavebar $pane]} {
		return 0
	}
	upvar [namespace current]::${pane}::var v
	if {[string length $hook]==0} {
	#	if {[anythingToSpeak $w]} {
			$m add command -label "Speak" -command [namespace code [list SpeakUp $w $pane]]
	#	}
	}
}
# ----------------------------------------------------------------------------
proc speak::propertyPane { w pane } {
	if {$pane==""} { return 0}
	upvar ::wsurf::trans::${pane}::var t
	upvar [namespace current]::${pane}::var v
	if {[info exists t(drawTranscription)] && $t(drawTranscription)} {
		if {![info exists v(speak)]} {
			set v(speak) 0
			set v(mbrolaParam) ""
			set v(mbrolaVoice) ""
			set v(t,mbrolaVoice) ""
			set v(t,mbrolaParam) ""
		}
		if {[info exists v(applyProp)]} {
			if {$v(applyProp)} {
				set Info(mbrolaExe) $v(t,mbrolaExe)
				set v(mbrolaParam) $v(t,mbrolaParam)
				set v(mbrolaVoice) $v(t,mbrolaVoice)
			}
		}
		set v(applyProp) 0
		return  [list "Speak" [namespace code drawSpeakPage]] 
	}
}
# ----------------------------------------------------------------------------
proc speak::cleanUp {w pane} {
	upvar [namespace current]::${pane}::var v
	if {[info exists v(speak)]} {
		unset v(mbrolaVoice)
		unset v(mbrolaParam)
		unset v(speak)
		if {[info exists v(t,mbrolaVoice)]} {unset v(t,mbrolaVoice)}
		if {[info exists v(t,mbrolaParam)]} {unset v(t,mbrolaParam)}
		if {[info exists v(t,mbrolaExe)]} {unset v(t,mbrolaExe)}
		#<< "cleaned up speak vars here"
	}
}
# ----------------------------------------------------------------------------
proc speak::applyProperties {w pane} {
	variable Info
	upvar ::wsurf::trans::${pane}::var t
	upvar [namespace current]::${pane}::var v
	if {[info exists t(drawTranscription)] && $t(drawTranscription)} {
			if {![info exists v(speak)]} {
				set v(speak) 0
				set v(mbrolaParam) ""
				set v(mbrolaVoice) ""
			}
		set Info(mbrolaExe) $v(t,mbrolaExe)
		set v(mbrolaParam) $v(t,mbrolaParam)
		set v(mbrolaVoice) $v(t,mbrolaVoice)
		set v(applyProp) 0
	}
}
# ----------------------------------------------------------------------------
proc speak::anythingToSpeak {w} {
	variable Info
	foreach otherpane [$w _getPanes] {
		upvar ::wsurf::trans::${otherpane}::var v
		if {[info exists v(headerFmt)] && [string match $v(headerFmt) "Mbrola"]} {
			#<< "Got something to speak"
			return 1
		}
	}
	return 0
}
# ----------------------------------------------------------------------------
proc speak::drawSpeakPage { w pane p } {
	variable Info
	upvar [namespace current]::${pane}::var v
	upvar ::wsurf::trans::${pane}::var t
	set v(t,mbrolaExe) $Info(mbrolaExe)
	set v(t,mbrolaParam) $v(mbrolaParam)
	set v(t,mbrolaVoice) $v(mbrolaVoice)
	foreach f [winfo children $p] {
		destroy $f
	}
	pack [frame $p.c1] -side left -pady 3 -padx 5 -anchor nw
	pack $p.c1 -side top -pady 2 -anchor w -fill x
	#	Draw label and input box for the executable.
	label $p.c1.l -text "Mbrola executable:" -width 15 -anchor w
	entry $p.c1.e -textvar [namespace current]::${pane}::var(t,mbrolaExe) -wi 20
	#	Draw the file selector  for the executable
	button $p.c1.b -text "Choose..." -command [namespace code [list chooseExe $w $pane]]
	pack $p.c1.l $p.c1.e $p.c1.b -side left -padx 3 -anchor w -fill x
	#	Draw the label and input box for the parameters. 
	pack [frame $p.c2] -side left -pady 3 -padx 5 -anchor nw
	pack $p.c2 -side top -pady 2 -anchor w -fill x
	label $p.c2.l -text "Mbola parameters:" -width 15 -anchor w
	entry $p.c2.e -textvar [namespace current]::${pane}::var(t,mbrolaParam) -wi 20
	pack $p.c2.l $p.c2.e -side left -padx 3 -pady 2 -anchor w -fill x
	#	Draw the label and input box for the voice.
	pack [frame $p.c3]  -side left -pady 3 -padx 5 -anchor nw
	pack $p.c3 -side top -pady 2 -anchor w -fill x
	label $p.c3.l -text "Mbrola voice file:" -width 15 -anchor w
	entry $p.c3.e -textvar [namespace current]::${pane}::var(t,mbrolaVoice) -wi 20
	#	Draw the file selector for the voice
	button $p.c3.b -text "Choose..." -command [namespace code [list chooseVoice $w $pane]]
	pack $p.c3.l $p.c3.e $p.c3.b -side left -padx 3 -anchor w -fill x
 }
# ----------------------------------------------------------------------------
proc speak::redraw {w pane} {
	variable Info
	upvar [namespace current]::${pane}::var v
	if {[info exists v(speak)]} {
		upvar ::wsurf::trans::${pane}::var t
		set t(headerFmt) "Mbrola"
	}
	if {[namespace exists ::wsurf::pwline]} {upvar ::wsurf::pwline::${pane}::var p}
	if {[info exists p(pwline)] && $p(pwline)} {
		#<< "Found a pwline pane. Attaching SpeakUp routine to B1clickAction"
		set p(B1clickAction) {::wsurf::speak::SpeakUp $w $pane}
	}

}
# ----------------------------------------------------------------------------
proc speak::getConfiguration {w pane} {
	variable Info
	if {$pane==""} {return {}}
	set result {}
	upvar [namespace current]::${pane}::var v
	if {[info exists v(speak)]} {
#		append result "upvar wsurf::trans::\$\{pane\}::var t" "\n"
#		append result "set t(headerFmt) \"Mbrola\"" "\n"
		append result "upvar wsurf::speak::\$\{pane\}::var v" "\n"
		append result "set v(speak) \"0\"" "\n"
		append result "set ::wsurf::speak::Info(mbrolaExe) \"$Info(mbrolaExe)\"" "\n"
		append result "set v(mbrolaParam) \"$v(mbrolaParam)\"" "\n"
		append result "set v(mbrolaVoice) \"$v(mbrolaVoice)\"" "\n"
	}
	return $result
}
# ----------------------------------------------------------------------------
proc speak::chooseExe {w pane} {
#	Handle file selector for the executable
	upvar [namespace current]::${pane}::var v
	set file $v(t,mbrolaExe)
	set res [tk_getOpenFile -title "Find Mbrola executable" -initialfile $file]
	if {$res != ""} { set v(t,mbrolaExe) $res	}
}
# ----------------------------------------------------------------------------
proc speak::chooseVoice {w pane} {
#	Handle file selector for the voice
	upvar [namespace current]::${pane}::var v
	set file $v(t,mbrolaVoice)
	set res [tk_getOpenFile -title "Find Mbrola voice" -initialfile $file]
	if {$res != ""} { set v(t,mbrolaVoice) $res }
}
# ----------------------------------------------------------------------------
proc speak::SpeakUp {w pane} {
#	Find out what phonemes and prosody curve to use 
	variable Info
	upvar ::wsurf::trans::${pane}::var t
	upvar [namespace current]::${pane}::var v
	#<<																			"Checking if Mbrola is set up and there is a pane to speak..."
	if {[info exists v(mbrolaVoice)] && [set v(speak) [mbrolaCheckOk $Info(mbrolaExe) $v(mbrolaVoice)]]} {
		if {[info exists t(drawTranscription)] && $t(drawTranscription) } {#<< 				"	Ok, current pane is  transcription pane ready for speech."
			set tr $pane
			$w messageProc ""
		} else {#<<																											"	Mbrola ok, but current pane has no transcription."
			$w messageProc "	Current pane has no transcription."
		}
	} else {#<<																												"	Current pane is no good for speech."
			$w messageProc "	Current pane cannot be spoken."
			if {[info exists ::trpane] && $::trpane!=""} {#<<											"	There is one focused trans pane, continuing..."
				set tr $::trpane
				upvar [namespace current]::${tr}::var v
				if {[info exists v(mbrolaVoice)] && [set v(speak) [mbrolaCheckOk $Info(mbrolaExe) $v(mbrolaVoice)]]} {#<<	"	Focused pane is set up for mbrola."
					upvar ::wsurf::trans::${tr}::var t
					if {[info exists t(nLabels)] && $t(nLabels) } {#<< 									"	Ok, focused pane is ready for speech."
						$w messageProc ""
					} else {#<<																								"	Mbrola ok, but pane has no transcription."
						$w messageProc "	Focused pane has no transcription."
						return 0
					}
				} else {#<<																									"	Mbrola is not set up properly in focused pane."
					return 0
				}
			} else {#<<																										"There is no pane selected for speech."
				$w messageProc "	Please select a transcritpion pane for speech."
				return 0
			}
	}
	#<<																																"Now checking for any prosody existing..."
	upvar [namespace current]::${tr}::var v
	if {[namespace exists ::wsurf::pwline]} {upvar ::wsurf::pwline::${pane}::var p}
	if {[info exists p(nodeCoords)] && [llength $p(nodeCoords)]!=0} {#<< 				"	Current pane has pwnodes."
		set v(nodes) ""
		foreach {x y} $p(nodeCoords) {#						mbrola pitch targets will reside in the speak namespace transcription pane
			lappend v(nodes) [format "%.3f" [::vtcanvas::getTime $pane $x]] [expr round([::vtcanvas::getValue $pane $y])]
		}
		#<<																															"	Ok, ready to speak with the pwnodes."
	} else {#<< 																												"	No pwline nodes."
		if {[info exists p(pitchNodes)] && [llength $p(pitchNodes)]!=0} {#<<				"	Found pwline pitch contour nodes."
		}
		if { [info exists p(pitch)] && ($p(pitchLine) || $p(pitchDots))} {#<<						"	Found a visible pwline pitch contour."
			set v(nodes) ""
			set fr 0.01;set tic 0.0
			foreach {i} $p(pitch) { 
				set tic [expr $tic + $fr]
				set hz [lindex $i 0]
				if {$hz != 0.0} {lappend v(nodes) [format "%.3f" $tic] [expr round($hz)]}
			}
			#<<																														"	Ok, ready to speak with pwline pitch contour."
		} else {#<< 																											"	Current pane has NO pwline pitch."
			if {[info exists ::wsurf::analysis::${pane}::var(pitchList)]} {#<< 					"	Current pane has pitch contour targets."
				set v(nodes) ""
				upvar ::wsurf::dataplot::${pane}::var d
				foreach {tic hz} $d($d(plotlist),points) { 
					if {$hz != 0.0} {lappend v(nodes) [format "%.3f" $tic] [expr round($hz)]}
				}
				#<<																														"	Ok, ready to speak with pitch contour targets."
			} else {#<< 																											"	Current pane has NO pitch contour targets."
				#<<																														 "Well, we'll speak with the previous prosody, or none."
			}
		}
	}
	preparePho $w $tr
	mbrolaSay $Info(mbrolaExe) $v(mbrolaParam) $v(mbrolaVoice) "ws.pho"
	file delete "ws.pho"
	return 0
}
# ----------------------------------------------------------------------------
proc speak::preparePho {w trpane} {
#	Prepare the pho file for output
	variable Info
	if {$trpane != ""} {
		upvar [namespace current]::${trpane}::var v
		upvar ::wsurf::trans::${trpane}::var t
		set tn -1
		if {[catch {open "ws.pho" w} out]} {
				#<<																															"Cannot open output file."
				return $out
		}
		if {[info command encoding] != ""} {#<<																		"Configuring output for '$t(encoding)' encoding..."
			fconfigure $out -encoding $t(encoding);#<<																"	Ok."
		}
		fconfigure $out -translation {auto lf}
    for {set i 0} {$i < $t(nLabels)} {incr i} {
      set ind [lindex $t(map) $i]
	  set end $t(t1,$ind,end)
      set label $t(t1,$ind,label)
	  lappend lt $label $end
    }
	set ss [lindex [$w cget -selection] 0]
	set se [lindex [$w cget -selection] 1]
	if {$ss==$se} {set ss 0.0;set se [$trpane cget -maxtime]}
	puts $out [lt_tf_pho lt v(nodes) $ss $se]
    close $out
	} 
}
# ----------------------------------------------------------------------------
proc speak::mbrolaSay {mbrola param mvoice phofile} {
	eval exec "$mbrola $param $mvoice $phofile ws.wav"
	snack::sound ss -load ws.wav
	ss play -command "[list ss destroy]" 
}
# ----------------------------------------------------------------------------
proc speak::mbrolaCheckOk {mbrola mvoice} {
#	Check for proper mbrolaExe and mbrolaVoice setup and warn user
	variable Info
	if {$mbrola=="" && $mvoice==""} {
		tk_messageBox -icon warning -title "Speak.plug setup" \
			-message 	" Speak.plug properties are not set! \n\n \
						Mbrola executable and voice fields are empty. \n \
						You can set Mbrola properties from the \n \
						\"Speak\" property tab"
		return 0
	}
	if {$mbrola==""} {
		tk_messageBox -icon warning -title "Speak.plug setup" \
			-message 	" Speak.plug properties are not set correctly!\n \
						Mbrola executable field is empty.\n\n"
		return 0
	}
	if {$mvoice==""} {
		tk_messageBox -icon warning -title "Speak.plug setup" \
			-message	" Speak.plug properties are not set correctly!\n \
						Mbrola voice field is empty.\n\n"
		return 0
	}
	if {![file exists $mbrola]} {
		tk_messageBox -icon warning -title "Speak.plug setup" \
		-message " The Mbrola executable was not found!"
		return 0
	} else {
		set Info(mbrolaOk) 1
	}
	if {![file exists $mvoice]} {
		tk_messageBox -icon warning -title "Speak.plug setup" -message " The selected Mbrola voice was not found!"
		return 0
	}
	return 1
}
# ----------------------------------------------------------------------------
proc speak::lt_tf_pho {ltr tfr s e} {
	upvar $ltr lt $tfr tf
	set ret ";Mbrola PHO file created with Wavesurfer and the speak.plug\n;"
	set lidx 0
	set t1 0
	set lsf ""; set rsf ""
	set aF "67"
	if {[info exists lt]} {
		set nL [expr [llength $lt] / 2]
	} else {
		return 0
	}
	if {[info exists tf]} {
		set nN [expr [llength $tf] / 2]
	} else {
		set nN 0
	}
	set t2 [lindex $lt [expr $lidx * 2 + 1]]
	while {$t2<$s} {#find first label within selection
		set t1 $t2 
		incr lidx
		set t2 [lindex $lt [expr $lidx * 2 +1]]
	}
	set nidx 0
	if {$nN==0} {set tn 0.0}
	set t1t $t1
	set t1 $s; #start at the middle of a label, if so selected by the user
	while {$nL>0 && $t1<$e && $lidx < $nL} {
		set t2t $t2
		if {$e<$t2} { ##<< "the selection end is in the middle of this label. nidx=$nidx nN=$nN e=$e t2=$t2"
			set t2 $e
		}
		set label [lindex $lt [expr $lidx * 2]]
		set dur [expr $t2 - $t1]
		set sout ""
		if {$nN>0} {
			set tn [lindex $tf [expr $nidx * 2]]
			while {$tn<$t1 && $nidx<$nN} {# "proceed to the first node within the selection"
				incr nidx
				set tn [lindex $tf [expr $nidx * 2]]
			}
			if {$t1t!=""} {#do this only once for the start of selection
				set lsf [valBet $t1 [lindex $tf [expr ($nidx-1)*2]] [lindex $tf [expr ($nidx-1)*2+1]] $tn [lindex $tf [expr $nidx*2+1]]]; #<< "start selection freq = $lsf"
				if {$lsf!=""} {set sout "0 [expr round($lsf)] "} 
				set t1t ""
			}
			while {$nidx<$nN && $t1<$tn && $tn<=$t2} {
				set aF [lindex $tf [expr $nidx * 2 + 1]]
				if {$dur > 0.0} {
						set per [expr round(($tn - $t1 ) / $dur * 100)]
				} else {
					set per 0.0
				}
				lappend sout $per $aF
				incr nidx
				set tn [lindex $tf [expr $nidx * 2]]
			}
#			if {$t2t>$e && $tn>$e} {#do this only once for the end of selection
				set rsf [valBet $t2 [lindex $tf [expr ($nidx-1)*2]] [lindex $tf [expr ($nidx-1)*2+1]] $tn [lindex $tf [expr $nidx*2+1]]]; #<< "end selection freq = $rsf"
#			}
		}
		set dur [expr round($dur * 1000)]
		append ret "\n" $label "\t"  $dur "\t" $sout
		set t1 $t2 
		incr lidx
		set t2 [lindex $lt [expr $lidx * 2 +1]]
#		#<< "ret=$ret t2=$t2 lidx=$lidx"
	}
	if {$rsf==""} {
		if {$dur!="100"} {set ending " 100 $aF"}
	} else {set ending " 100 $rsf"}
	append ret $ending
	return [append ret "\n#\n"]
}
# ----------------------------------------------------------------------------
proc speak::valBet {t t1 f1 t2 f2} {
	if {$t=="" || $t1=="" || $t2==0 || $f1=="" || $f2==""} {return ""}
	return [expr round($f1 + ($f2 - $f1) * ($t -$t1) / ($t2 - $t1))]
}
# -----------------------------------------------------------------------------
namespace eval trans {
  lappend Info(formats) Mbrola \
	speak::load \
	speak::save \
	speak::test
} 

# -----------------------------------------------------------------------------
proc speak::load {w pane} {
#<< "Entering Transcription Mbrola plugin"
  upvar ::wsurf::trans::${pane}::var v
	if {[string match "Mbrola" $v(headerFmt)]} {;#<<  "User calls us into action"
	  set map {}
	  set i 0
	  set start 0.0
	  set end 0
	  if {[catch {open $v(fileName)} in]} {;#<< "File not found"
		return $in
	  } else {;#<< "Openning file $v(fileName)"
		if {[info command encoding] != ""} {
		  fconfigure $in -encoding $v(encoding)
		}
		if {[catch {set labelfile [read $in]}]} { return 0 };#<< "Here is what we read:\n$labelfile"
		close $in
		set pw ""
		foreach otherpane [$w _getPanes] {
			if {[info exists ::wsurf::pwline::${otherpane}::var]} {
			upvar ::wsurf::pwline::${otherpane}::var p
				if {[info exists p(pwline)] && $p(pwline)} {
					set pw $otherpane
					break
				}
			}
		}
		if {$pw != ""} {
			::wsurf::pwline::delAllNodes $w $pw
		}
		# Format decoding loop
		foreach row [split $labelfile \n] {;#<< line-->$row
		  set rest ""
		  set row [join [regsub -all {([^\(,\)]*)([\(,\)])} $row {\1 }]]
		  if {[scan $row {%s %d} label dur] >= 2} {
			  set rest [lrange $row 2 end]
			  set end [expr double($dur/1000.0)  + $start]
			  set v(t1,$i,label) $label
			  set v(t1,$i,end)   $end
			  set v(t1,$i,rest)  $rest
			  lappend map $i
			  if {$i == 0} {
				  set v(t1,start) $start
			  }
				if {[info exists ::wsurf::speak::${pane}::var]} {
					upvar ::wsurf::speak::${pane}::var s
					#<< "$rest"
					foreach {pt hz} $rest {
						set t [expr $start + ($end - $start) * double($pt/100.0)]
						set x [vtcanvas::getCanvasX $pw $t]
						set y [vtcanvas::getCanvasY $pw $hz]
						lappend s(nodes) $t $hz
						::wsurf::pwline::insertNode $w $pw $x $y
					}
				}
			  set start $end
			  incr i
		  }
		}
	  }
	  set v(t1,end)  $end
	  set v(nLabels) $i
	  set v(map)     $map
	}
	set header "Wavesurfer Mbrola transcription"
	set v(headerFmt) "Mbrola"
	::wsurf::_redraw $w
	}

# -----------------------------------------------------------------------------
proc speak::save {w pane} {
	upvar ::wsurf::trans::${pane}::var v
	set lt ""
  if {[catch {open $v(fileName) w} out]} {
    return $out
  } else {
    if {[info command encoding] != ""} {
      fconfigure $out -encoding $v(encoding)
    }  
    fconfigure $out -translation {auto lf}
    for {set i 0} {$i < $v(nLabels)} {incr i} {
      set ind [lindex $v(map) $i]
	  set end $v(t1,$ind,end)
      set label $v(t1,$ind,label)
	  lappend lt $label $end
    }
	set ss [lindex [$w cget -selection] 0]
	set se [lindex [$w cget -selection] 1]
	if {$ss==$se} {set ss 0.0;set se [$pane cget -maxtime]}
	if {[info exists ::wsurf::speak::${pane}::var]} {
		upvar ::wsurf::speak::${pane}::var s
		puts $out [lt_tf_pho lt s(nodes) $ss $se]
	} else {
		puts $out [lt_tf_pho lt "" $ss $se]
	}
    close $out
  }
  set v(headerFmt) "Mbrola"
  $w messageProc \
      "Wrote $v(fileName) in $v(headerFmt) format"
  return
}

proc speak::test {w pane rows} {
 set lastrow [lindex $rows end]
# if {[regexp {(\d+\.\d+)\s+(\d+\.\d+)\s+\S+} $lastrow a b c] == 1} {
#  if {[info exists c]} {
#   return WaveSurfer
#  }
# }
return Mbrola
}