###############################################################################
# Copyright (c) 2005 Michael Hofmann
# 
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 of the License or (at your option) any later
# version.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
# 
# You should have received a copy of the GNU General Public License along with
# this program; see the file COPYING. If not, write to the Free Software
# Foundation Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA
###############################################################################

### Wavesurfer registration
wsurf::RegisterPlugin pmedit \
    -description "Plots pitchmarks contained in a pitchmarks file (.pm). The\
    format consists of lines with the fields 'Time Voiced Confidence\
    OldConfidence', where the last 3 fields can be omitted. For lines with\
    only one field negative positions are regarded as unvoiced pitchmarks. Use\
    a confidence of -1 for known and 0 for disabled pitchmarks. Mark voiced\
    pitchmarks with 1, unvoiced ones with 0." \
    -url "http://mh21.piware.de/" \
    -addmenuentriesproc   pmedit::addMenuEntries \
    -propertiespageproc   pmedit::propertyPane \
    -applypropertiesproc  pmedit::applyProperties \
    -panecreatedproc      pmedit::paneCreated \
    -panedeletedproc      pmedit::paneDeleted \
    -needsaveproc         pmedit::needSave \
    -savefileproc         pmedit::saveFile \
    -redrawproc           pmedit::redraw \
    -cursormovedproc      pmedit::cursorMoved \
    -getconfigurationproc pmedit::getConfiguration

### Namespace variables
namespace eval pmedit {
    variable Info
    set Info(OptionTable) [list \
	-colorvoiced colorVoiced red \
	-colorunvoiced colorUnvoiced blue \
	-colorvoicedbelow colorVoicedBelow darkred \
	-colorunvoicedbelow colorUnvoicedBelow darkblue \
	-colordisabled colorDisabled darkgray \
	-colorline colorLine black \
	-colorlimit colorLimit darkgray \
	-extension extension ".pm" \
	-extendvoicedboundaries extendVoicedBoundaries 1 \
	-extendunvoicedboundaries extendUnvoicedBoundaries 0 \
	-zoominmm zoomInMm 3000 \
	-zoomoutmm zoomOutMm 250 \
    ]
    # Voiced,Col2,Confidence>=0,Confidence>maxShow
    set Info(Colors,0,0,0,0) colorUnvoiced
    set Info(Colors,0,0,0,1) colorUnvoiced
    set Info(Colors,0,0,1,0) colorUnvoicedBelow
    set Info(Colors,0,0,1,1) colorUnvoiced
    set Info(Colors,0,1,0,0) colorUnvoiced
    set Info(Colors,0,1,0,1) colorUnvoiced
    set Info(Colors,0,1,1,0) colorDisabled
    set Info(Colors,0,1,1,1) colorUnvoicedBelow
    set Info(Colors,1,0,0,0) colorVoiced
    set Info(Colors,1,0,0,1) colorVoiced
    set Info(Colors,1,0,1,0) colorVoicedBelow
    set Info(Colors,1,0,1,1) colorVoiced
    set Info(Colors,1,1,0,0) colorVoiced
    set Info(Colors,1,1,0,1) colorVoiced
    set Info(Colors,1,1,1,0) colorDisabled
    set Info(Colors,1,1,1,1) colorVoicedBelow
}

### Event handler
proc pmedit::paneCreated {w pane} {
    namespace eval [namespace current]::${pane} {
	variable var
    }
    upvar [namespace current]::${pane}::var v
    set v(drawPMs) 0
}

proc pmedit::paneDeleted {w pane} {
    upvar [namespace current]::${pane}::var v
    # Delete labels in other panes
    foreach otherpane [$w _getPanes] {
	if {$pane == $otherpane} continue
	upvar wsurf::analysis::${otherpane}::var ov
	if {$ov(drawWaveform) || $ov(drawSpectrogram)} {
	    set othercanvas [$otherpane canvas]
	    if {[winfo exists $othercanvas]} {
		$othercanvas delete pmedit$pane
	    }
	}
    }
    # Delete namespace
    namespace delete [namespace current]::${pane}
}

proc pmedit::addMenuEntries {w pane m hook x y} {
    if {[string match query $hook]} {
	# Return whether we have a pane specific context menu
	return 1
    } elseif {[string match main $hook]} {
	# Menu entries that are available in a separate menu column
	upvar [namespace current]::${pane}::var v
	if {[info exists v(drawPMs)] && $v(drawPMs)} {
	    $m add command -label "Raise Confidence" \
		-command [namespace code [list _raiseConfidence $w $pane $x $y]]
	    $m add command -label "Lower Confidence" \
		-command [namespace code [list _lowerConfidence $w $pane $x $y]]
	    $m add command -label "Restore Confidence" \
		-command [namespace code [list _restoreConfidence $w $pane $x $y]]
	    $m add command -label "Change Voicing" \
		-command [namespace code [list _changeVoicing $w $pane]]
	    $m add separator
	    $m add command -label "Insert Pitchmark" \
		-command [namespace code [list _insertPM $w $pane $x $y]]
	    $m add command -label "Delete Pitchmark" \
		-command [namespace code [list _deletePM $w $pane]]
	    $m add separator
	    $m add command -label "Save All Pitchmarks" \
		-command [namespace code [list _savePMFiles $w $pane]]
	    $m add command -label "Save Pitchmarks As..." \
		-command [namespace code [list _getSavePMFile $w $pane]]
	    $m add command -label "Export Effective Pitchmarks..." \
		-command [namespace code [list _getExportPMFile $w $pane]]
	}
    } elseif {[string length $hook] == 0} {
        # Menu entries that are available for in the main context menu
    } elseif {[string match create $hook]} {
        # Create menu entries
	$m.$hook add command -label "Pitchmarks" \
	    -command [namespace code [list createPmedit $w $pane]]
    }
}

proc pmedit::createPmedit {w pane} {
    set pane [$w addPane -before $pane -height 100 -scrollheight 100 \
	-showyaxis true]
    addPmedit $w $pane
}

proc pmedit::addPmedit {w pane args} {
    variable Info
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]

    foreach {option key default} $Info(OptionTable) {
	set a($option) $default
    }
    array set a $args

    foreach {option key default} $Info(OptionTable) {
	set v($key) $a($option)
    }
    set v(fileName) ""
    set v(maxShow)  0
    set v(maxVal)   1
    set v(changed)  0

    $c bind limit <Enter> [list $c configure \
	-cursor sb_v_double_arrow]
    $c bind limit <Leave> [list $c configure -cursor {}]

    # Pitchmark event handlers
    util::canvasbind $c pm <ButtonPress-1> \
	[namespace code [list _showInfo $w $pane]]
    util::canvasbind $c pm <B2-Motion> \
	[namespace code [list _movePM $w $pane %x]]
    util::canvasbind $c pm <Double-Button-1> \
	[namespace code [list _swapConfidence $w $pane]]
    # New/delete
    bind $c <Double-Button-2> \
	[namespace code [list _insertPM $w $pane %x %y]]
    util::canvasbind $c pm <Double-Button-2> \
	[namespace code [list _deletePM $w $pane]]
    # Swap voiced/unvoiced
    util::canvasbind $c pm <B1-Motion> \
	[namespace code [list _dragVoicing $w $pane %y]]
    # Limit event handlers
    util::canvasbind $c limit <B1-Motion> \
	[namespace code [list _moveLimit $w $pane %y]]
    util::canvasbind $c limit <ButtonPress-1> ""
    util::canvasbind $c limit <ButtonRelease-1> \
	[namespace code [list _drawPMs $w $pane]]
    # Zoom
    bind $c <ButtonPress-4> \
	[namespace code [list _zoomIn $w $pane %x]]
    bind $c <ButtonPress-5> \
	[namespace code [list _zoomOut $w $pane %x]]

    _readPMfile $w $pane
    _drawPMs $w $pane
}

proc pmedit::needSave {w pane} {
    upvar [namespace current]::${pane}::var v

    if {[info exists v(drawPMs)] && $v(drawPMs) && $v(changed)} {
	return 1
    }
    return 0
}

proc pmedit::saveFile {w soundFileName} {
    foreach pane [$w _getPanes] {
	upvar [namespace current]::${pane}::var v
	    if {$v(drawPMs) && $v(changed)} {
		_savePMFile $w $pane
	}
    }
    return 0
}

proc pmedit::redraw {w pane} {
    upvar [namespace current]::${pane}::var v

    if [$w getInfo isRecording] return

    if {$v(drawPMs)} {
	_drawPMs $w $pane
    }
}

proc pmedit::cursorMoved {w pane t var} {
    upvar [namespace current]::${pane}::var v

    if [$w getInfo isPlaying] return

    if {$v(drawPMs)} {
	set bx "single:double:drag"
	set b1 "button-1 info:confidence:voicing"
	set b2 "button-2 -:new/delete:move"
	$w messageProc [format "pmedit - %s limit=%s (%s: %s, %s)" \
	    [$w formatTime $t] $v(maxShow) $bx $b1 $b2]
    }
}

### Zoom
proc pmedit::_zoomIn {w pane x} {
    upvar [namespace current]::${pane}::var v
    _zoom $w $pane $x $v(zoomInMm)
}

proc pmedit::_zoomOut {w pane x} {
    upvar [namespace current]::${pane}::var v
    _zoom $w $pane $x $v(zoomOutMm)
}

proc pmedit::_zoom {w pane x z} {
    upvar wsurf::${w}::data d
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set length [$pane cget -maxtime]
    set left $d(xviewT1)
    set right $d(xviewT2)
    set curPixPerSecond [$pane cget -pixelspersecond]
    set newPixPerSecond [expr $z * [winfo fpixels $w 1m]]
    set pixScale [expr $curPixPerSecond / $newPixPerSecond]
    if {$pixScale > 0.99 && $pixScale < 1.01} return
    set pos [expr [$c canvasx $x] / $curPixPerSecond]
    set start [expr ($pos - ($pos - $left) * $pixScale) / $length]
    set end [expr ($pos + ($right - $pos) * $pixScale) / $length]
    wsurf::xzoom $w $start $end
    update
    wsurf::xscroll $w moveto $start
}

### Import and export
proc pmedit::_savePMFiles {w pane} {
    foreach pane [$w _getPanes] {
	upvar [namespace current]::${pane}::var v
	if {$v(drawPMs) && $v(changed)} {
	    _savePMFile $w $pane
	}
    }
}

proc pmedit::_getSavePMFile {w pane} {
    upvar [namespace current]::${pane}::var v
    # Split name
    set file [file tail $v(fileName)]
    set path [file dirname $v(fileName)]
    # Get new name
    set fileName [tk_getSaveFile -title "Save Pitchmarks" -initialfile $file \
	-initialdir $path -defaultextension $v(extension)]
    if {$fileName == ""} return
    # Set variables to new name
    set v(fileName) $fileName
    set v(extension) [file extension $fileName]
    # Save
    _savePMFile $w $pane
}

proc pmedit::_getExportPMFile {w pane} {
    upvar [namespace current]::${pane}::var v
    # Split name
    set file [file tail [file rootname $v(fileName)]].effective.[string trim $v(extension) .]
    set path [file dirname $v(fileName)]
    # Get new name
    set fileName [tk_getSaveFile -title "Export Effective Pitchmarks" -initialfile $file \
	-initialdir $path]
    if {$fileName == ""} return
    # Save
    _exportPMFile $w $pane 1 $fileName
}

proc pmedit::_savePMFile {w pane} {
    upvar [namespace current]::${pane}::var v
    # Set filename
    set fileName $v(fileName)
    set strippedName [file tail [file rootname $fileName]]
    if {$strippedName == ""} {
	set strippedName [file tail [file rootname [$w getInfo fileName]]]
	set path [file dirname $fileName]
	set v(fileName) [file join $path $strippedName.[string trim $v(extension) .]]
	set fileName $v(fileName)
    }
    _exportPMFile $w $pane 0 $fileName
    set v(changed) 0
}

proc pmedit::_exportPMFile {w pane effective fileName} {
    upvar [namespace current]::${pane}::var v
    # Open file
    catch {file copy $fileName $fileName~}
    if {[catch {open $fileName w} out]} {
	$w messageProc $out
	return
    }
    fconfigure $out -translation {auto auto}
    # Write pitchmarks
    if {!$effective} {
	puts $out [format "# %.8f" $v(maxShow)]
    }
    foreach {pos voiced confidence origConfidence} [join [lsort -real \
	-index 0 $v(zxlist)]] {
	if {($confidence == -1 && $origConfidence == $confidence) || \
	    ($effective && ($confidence == -1 || $confidence >= $v(maxShow)))} {
	    set line [format "%.6f" [expr {$voiced ? $pos : -$pos}]]
	} elseif {!$effective} {
	    if {$origConfidence == $confidence} {
		set line [format "%.8f %d %f" $pos [expr $voiced != 0] \
		    $confidence]
	    } else {
		set line [format "%.8f %d %f %f" $pos [expr $voiced != 0] \
		    $confidence $origConfidence]
	    }
	} else continue
	puts $out $line
    }
    close $out
    $w messageProc "Wrote $v(fileName)"
}

proc pmedit::_readPMfile {w pane} {
    upvar [namespace current]::${pane}::var v

    $w messageProc "Reading pitchmarks file..."

    set v(zxlist) {}
    set v(maxVal) 0
    set v(maxShow) 0
    set v(changed) 0
    set v(fileName) [file root [$w getInfo fileName]].[string trim $v(extension) .]
    
    if {[catch {open $v(fileName)} in]} {
	set v(maxShow) 1
	set v(maxVal) 1
        return $in
    }
    set first 1
    gets $in row
    while {[eof $in] == 0} {
	if {$first > 0} {
	    set first 0
	    if {[scan $row "# %f" limit] == 1} {
		set v(maxShow) $limit
		gets $in row
		continue;
	    }
	}
	set num [scan $row "%f %f %f %f" pos voiced confidence origConfidence]
	if {$num == 1} {
	    if {$pos >= 0} {
		set voiced 1
	    } else {
		set voiced 0
		set pos [expr -$pos]
	    }
	}
	if {$num < 3} {
	  set confidence -1 
	}
	if {$num < 4} { set origConfidence $confidence }
	if {$num !=0} {
	    lappend v(zxlist) [list $pos $voiced $confidence $origConfidence]
	    if {$v(maxVal) < $confidence} { set v(maxVal) $confidence }
	}
	gets $in row
    }
    close $in
    if {$v(maxVal) == 0} {
	set v(maxShow) 1
	set v(maxVal) 1
    } elseif {$v(maxShow) == 0} {
        set v(maxShow) [expr 0.1*$v(maxVal)]
    }

    $w messageProc "Pitchmarks file read"
}

### Draw
proc pmedit::_drawPM {w pane pos voiced confidence} {
    variable Info
    upvar [namespace current]::${pane}::var v

    set xpos [expr $pos * [$w cget -pixelspersecond]]

    set c [$pane canvas]
    set height [$pane cget -scrollheight]
    set hstart [expr $height/2]
    set hend [expr {$voiced == 0 ? $height : 0}]
    set hmid [expr {$confidence >= 0 ? $hstart + ($hend - $hstart) * $confidence / $v(maxVal) : $hend}]
    $c delete pos$pos
    # Voiced,Col2,Confidence>=0,Confidence>maxShow
    set col1 $Info(Colors,[expr $voiced != 0],0,[expr $confidence >= 0],[expr $confidence > $v(maxShow)])
    set col2 $Info(Colors,[expr $voiced != 0],1,[expr $confidence >= 0],[expr $confidence > $v(maxShow)])
    $c create line $xpos $hstart $xpos $hmid -fill $v($col1) -tags [list pm pmedit pos$pos]
    if {$hmid != $hend} {
        $c create line $xpos $hmid $xpos $hend -fill $v($col2) -tags [list pm pmedit pos$pos]
    }

    foreach otherpane [$w _getPanes] {
	upvar wsurf::analysis::${otherpane}::var ov
	if {$ov(drawWaveform) || $ov(drawSpectrogram)} {
	    set othercanvas [$otherpane canvas]
	    set height [$otherpane cget -height]
	    $othercanvas delete pos$pos$pane
	    set col $Info(Colors,[expr $voiced != 0],0,0,0)
	    if {($confidence < 0 || $confidence > $v(maxShow)) &&
		($voiced == 0 && $v(extendUnvoicedBoundaries) || \
		$voiced != 0 && $v(extendVoicedBoundaries))} {
		$othercanvas create line $xpos 0 $xpos $height -fill \
		    $v($col) -tags [list pmedit$pane pos$pos$pane]
	    }
	}
    }
}

proc pmedit::_drawPMs {w pane} {
    upvar [namespace current]::${pane}::var v

    set height [$pane cget -scrollheight]
    set c [$pane canvas]
    $c delete pmedit
    foreach otherpane [$w _getPanes] {
	upvar wsurf::analysis::${otherpane}::var ov
	if {$ov(drawWaveform) || $ov(drawSpectrogram)} {
	    set othercanvas [$otherpane canvas]
	    $othercanvas delete pmedit$pane
	}
    }

    set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
    $c create line 0 [expr $height/2] $width [expr $height/2] -fill \
	$v(colorLine) -tags pmedit

    foreach {pos voiced confidence origConfidence} [join $v(zxlist)] {
	_drawPM $w $pane $pos $voiced $confidence
    }

    set rulerpos [expr $height/2*$v(maxShow)/$v(maxVal)]
    $c create line 0 [expr $height / 2 - $rulerpos] $width [expr $height / 2 - \
	$rulerpos] -fill $v(colorLimit) -tags [list pmedit limit limitv topmost]
    $c create line 0 [expr $height / 2 + $rulerpos] $width [expr $height / 2 + \
	$rulerpos] -fill $v(colorLimit) -tags [list pmedit limit limituv topmost]

    set v(drawPMs) 1
}

### Behaviour
proc pmedit::_showInfo {w pane} {
    upvar [namespace current]::${pane}::var v
 
    set c [$pane canvas]
    set pos [_pmPos [$c gettags current]]
    set index [lsearch $v(zxlist) [list $pos *]]
    set voiced [lindex $v(zxlist) $index 1]
    set confidence [lindex $v(zxlist) $index 2]
    set origConfidence [lindex $v(zxlist) $index 3]
    set result {}
    append result "$index t=$pos"
    append result [expr {$voiced == 0 ? " unvoiced" : " voiced"}]
    if {$confidence != -1 || $origConfidence != $confidence} {
	append result " confidence=$confidence"
	if {$origConfidence != $confidence} {
	    append result " orig=$origConfidence"
	}
    }
    $w messageProc $result
}

proc pmedit::_pmPos {tags} {
    string trim [lsearch -inline $tags pos*] pos
}

proc pmedit::_isPM {tags} {
    expr [lsearch $tags pm] != -1
}

proc pmedit::_swapConfidence {w pane} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set tags [$c gettags current]
    if [_isPM $tags] { 
	set pos [_pmPos $tags]
	set index [lsearch $v(zxlist) [list $pos *]]
	set voiced [lindex $v(zxlist) $index 1]
	set confidence [lindex $v(zxlist) $index 2]
	if {$confidence  == -1 || $confidence >= $v(maxShow)} {
	    set confidence 0
	} else {
	    set confidence -1
	}
	lset v(zxlist) $index 2 $confidence
	set v(changed) 1
	_drawPM $w $pane $pos $voiced $confidence
    }
}

proc pmedit::_restoreConfidence {w pane x y} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set tags [$c gettags current]
    if [_isPM $tags] {
	set pos [_pmPos $tags]
	set index [lsearch $v(zxlist) [list $pos *]]
	set voiced [lindex $v(zxlist) $index 1]
	set origConfidence [lindex $v(zxlist) $index 3]
	lset v(zxlist) $index 2 $origConfidence
	set v(changed) 1
	_drawPM $w $pane $pos $voiced $origConfidence
    }
}

proc pmedit::_setConfidence {w pane x y confidence} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set tags [$c gettags current]
    if [_isPM $tags] {
	set pos [_pmPos $tags]
	set index [lsearch $v(zxlist) [list $pos *]]
	set voiced [lindex $v(zxlist) $index 1]
	lset v(zxlist) $index 2 $confidence
	set v(changed) 1
	_drawPM $w $pane $pos $voiced $confidence
    }
}

proc pmedit::_lowerConfidence {w pane x y} {
    _setConfidence $w $pane $x $y 0
}

proc pmedit::_raiseConfidence {w pane x y} {
    _setConfidence $w $pane $x $y -1
}

proc pmedit::_deletePM {w pane} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set tags [$c gettags current]
    if [_isPM $tags] {
	set pos [_pmPos $tags]
	set index [lsearch $v(zxlist) [list $pos *]]
	set v(zxlist) [lreplace $v(zxlist) $index $index]
	set v(changed) 1
	$c delete pos$pos
	foreach otherpane [$w _getPanes] {
	    upvar wsurf::analysis::${otherpane}::var ov
	    if {$ov(drawWaveform) || $ov(drawSpectrogram)} {
		set othercanvas [$otherpane canvas]
		$othercanvas delete pos$pos
	    }
	}
    }
}

proc pmedit::_insertPM {w pane x y} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set xc [$c canvasx $x]
    set yc [$c canvasy $y]
    set pos [expr $xc / [$w cget -pixelspersecond]]
    set voiced [expr {$yc < [$pane cget -scrollheight] / 2}]
    set confidence -1
    lappend v(zxlist) [list $pos $voiced $confidence $confidence]
    set v(changed) 1
    _drawPM $w $pane $pos $voiced $confidence
}

proc pmedit::_changeVoicing {w pane} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set tags [$c gettags current]
    if [_isPM $tags] {
	set pos [_pmPos $tags]
	set index [lsearch $v(zxlist) [list $pos *]]
	set voiced [expr ! [lindex $v(zxlist) $index 1]]
	set confidence [lindex $v(zxlist) $index 2]
	lset v(zxlist) $index 1 $voiced
	set v(changed) 1
	_drawPM $w $pane $pos $voiced $confidence
    }
}

proc pmedit::_dragVoicing {w pane y} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    set pos [_pmPos [$c gettags current]]
    set index [lsearch $v(zxlist) [list $pos *]]
    set voiced [lindex $v(zxlist) $index 1]
    set confidence [lindex $v(zxlist) $index 2]
    set limit [expr [$pane cget -scrollheight]/2]
    set yc [$c canvasy $y]
    if {$voiced == 1 && $yc > $limit} {
	lset v(zxlist) $index 1 0
	set v(changed) 1
	_drawPM $w $pane $pos 0 $confidence
    } elseif {$voiced == 0 && $yc < $limit} {
	lset v(zxlist) $index 1 1
	set v(changed) 1
	_drawPM $w $pane $pos 1 $confidence
    }
}

proc pmedit::_movePM {w pane x} {
    upvar [namespace current]::${pane}::var v
    # Calculate new position
    set c [$pane canvas]
    set xc [$c canvasx $x]
    set pos [_pmPos [$c gettags current]]
    set newPos [expr $xc / [$pane cget -pixelspersecond]]
    if {"pos$newPos" == "pos$pos"} return
    # Set new position in internal list
    set index [lsearch $v(zxlist) [list $pos *]]
    lset v(zxlist) $index 0 $newPos
    # Move pitchmark, change tags
    set coords [$c coords current]
    if {$xc < 0} { set xc 0 }
    $c move pos$pos [expr $xc - [lindex $coords 0]] 0
    $c addtag pos$newPos withtag pos$pos 
    $c dtag pos$pos
    # Move pitchmarks in other panes
    foreach otherpane [$w _getPanes] {
	upvar wsurf::analysis::${otherpane}::var ov
	if {$ov(drawWaveform) || $ov(drawSpectrogram)} {
	    set othercanvas [$otherpane canvas]
	    $othercanvas move pos$pos$pane [expr $xc - [lindex $coords 0]] 0
	    $othercanvas addtag pos$newPos$pane withtag pos$pos$pane 
	    $othercanvas dtag pos$pos$pane
	}
    }
    # ???
    vtcanvas::motionEvent $pane $x 0
    # Mark pitchmarks dirty
    set v(changed) 1
}

proc pmedit::_moveLimit {w pane y} {
    upvar [namespace current]::${pane}::var v
    set c [$pane canvas]
    # Calculate relative position
    set height [$pane cget -scrollheight]
    set yc [$c canvasy $y]
    if {[$c find withtag {current && limituv}] != ""} { set yc [expr $height - $yc] }
    if {$yc < 0} { set yc 0 }
    if {$yc > $height / 2} { set yc [expr $height / 2] }
    # Move limits
    set coords [$c coords limitv]
    $c coords limitv [lindex $coords 0] $yc [lindex $coords 2] $yc
    set coords [$c coords limituv]
    $c coords limituv [lindex $coords 0] [expr $height - $yc] [lindex $coords 2] [expr $height - $yc]
    set v(maxShow) [expr (1-$yc/($height/2))*$v(maxVal)]
    $w messageProc [format "%s" $v(maxShow)]
}

### Property pages
proc pmedit::propertyPane {w pane} {
    upvar [namespace current]::${pane}::var v
    if {$pane == ""} return
    if {$v(drawPMs)} {
	return [list "pmedit" [namespace code drawPmeditPage]]
    }
}

proc pmedit::applyProperties {w pane} {
    if {[string match *wavebar $pane]} return
    upvar [namespace current]::${pane}::var v

    if [info exists v(drawPMs)] {
	if {$v(drawPMs)} {
	    foreach var {colorVoiced colorUnvoiced colorVoicedBelow \
		colorUnvoicedBelow colorDisabled colorLine colorLimit \
		zoomInMm zoomOutMm extension extendUnvoicedBoundaries \
		extendVoicedBoundaries} {
		if {[string compare $v(t,$var) $v($var)] != 0} {
		    set v($var) $v(t,$var)
		    set doRedraw 1
		    if {[string match extension $var]} {
			_readPMfile $w $pane
		    }
		}
	    }
	    if [info exists doRedraw] {
		$w _redrawPane $pane
	    }
	}
    }
}

proc pmedit::drawPmeditPage {w pane p} {
    upvar [namespace current]::${pane}::var v

    foreach f [winfo children $p] {
	destroy $f
    }

    foreach var {colorVoiced colorUnvoiced colorVoicedBelow colorUnvoicedBelow \
	colorDisabled colorLine colorLimit extension zoomInMm zoomOutMm \
	extendUnvoicedBoundaries extendVoicedBoundaries} {
	set v(t,$var) $v($var)
    }

    colorPropItem $p.f1 "Color voiced:" 28 \
	[namespace current]::${pane}::var(t,colorVoiced)

    colorPropItem $p.f3 "Color voiced below threshold:" 28 \
	[namespace current]::${pane}::var(t,colorVoicedBelow)

    colorPropItem $p.f2 "Color unvoiced:" 28 \
	[namespace current]::${pane}::var(t,colorUnvoiced)

    colorPropItem $p.f4 "Color unvoiced below threshold:" 28 \
	[namespace current]::${pane}::var(t,colorUnvoicedBelow)

    colorPropItem $p.f5 "Color disabled:" 28 \
	[namespace current]::${pane}::var(t,colorDisabled)

    colorPropItem $p.f6 "Color middle line:" 28 \
	[namespace current]::${pane}::var(t,colorLine)

    colorPropItem $p.f7 "Color limit lines:" 28 \
	[namespace current]::${pane}::var(t,colorLimit)

    stringPropItem $p.f8 "Filename extension:" 28 10 "" \
	[namespace current]::${pane}::var(t,extension)

    stringPropItem $p.f9 "Zoom in" 28 10 "mm/s" \
	[namespace current]::${pane}::var(t,zoomInMm)
    stringPropItem $p.f10 "Zoom out" 28 10 "mm/s" \
	[namespace current]::${pane}::var(t,zoomOutMm)

    booleanPropItem $p.f11 \
	"Extend voiced boundaries into other panes" "" \
	[namespace current]::${pane}::var(t,extendVoicedBoundaries)
    booleanPropItem $p.f12 \
	"Extend unvoiced boundaries into other panes" "" \
	[namespace current]::${pane}::var(t,extendUnvoicedBoundaries)
}

proc pmedit::getConfiguration {w pane} {
    variable Info
    upvar [namespace current]::${pane}::var v

    set result {}
    if {$pane==""} {return {}}
    if {$v(drawPMs)} {
	append result "\$widget pmedit::addPmedit \$pane"
	foreach {option key default} $Info(OptionTable) {
	    if {$v($key) != $default} {
		append result " $option \"$v($key)\""
	    }
	}
	append result "\n"
    }
    return $result
}

### VIM
## Modelines
# vi: set ft=tcl fdc=3 fdl=1 fdm=expr :
# vi: set fde=getline(v\:lnum)=~'^###'?'>1'\:getline(v\:lnum)=~'^\\%(proc\\|namespace\\|wsurf\:\:RegisterPlugin\\|##\\\)\ '?'>2'\:'=' :