From 3f72399d2e506e1df0f93d3dcc524579644e1c7e Mon Sep 17 00:00:00 2001 From: Paul Brossier Date: Sun, 25 Oct 2009 22:12:16 +0100 Subject: [PATCH 1/1] imported from aubio-0.3.2 --- README | 9 + aubio.conf | 46 ++ aubio.plug | 2278 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 2333 insertions(+) create mode 100644 README create mode 100644 aubio.conf create mode 100644 aubio.plug diff --git a/README b/README new file mode 100644 index 0000000..f0ade4e --- /dev/null +++ b/README @@ -0,0 +1,9 @@ +This directory contains a plugin file and a configuration file for wavesurfer. +It's actually just a label widget with some added functions. Install them in + + ~/.wavesurfer/1.6/{plugins,configurations} + or /usr/lib/wsurf1.6/{plugins,configurations} + +and they should appear next time you launch wavesurfer. + +The config box to set different options is still to be written. diff --git a/aubio.conf b/aubio.conf new file mode 100644 index 0000000..03fe365 --- /dev/null +++ b/aubio.conf @@ -0,0 +1,46 @@ +# -*-Mode:Tcl-*- +# This file is automatically generated by WaveSurfer + +$widget configure -background "#d9d9d9" +$widget configure -foreground "Black" +$widget configure -troughcolor "#c3c3c3" +$widget configure -cursorcolor "red" +$widget configure -wavebarheight "25" +$widget configure -pixelspersecond "400.0" +$widget configure -playmapfilter "1" + +set pane [$widget addPane -maxheight 20 -minheight 20] +$pane configure -height {20} +$pane configure -scrollheight {20} +$pane configure -background {white} +$pane configure -yaxisfont {Helvetica 10} + +if {[wsurf::PluginEnabled transcription_format_htk]} { + set ::wsurf::transcription_format_htk::${pane}::var(matchComponents) 1 + set ::wsurf::transcription_format_htk::${pane}::var(level) 1 + set ::wsurf::transcription_format_htk::${pane}::var(mlf) "" + set ::wsurf::transcription_format_htk::${pane}::var(hideQuotes) 1 + set ::wsurf::transcription_format_htk::${pane}::var(alternative) 1 +} + +if {[wsurf::PluginEnabled transcription]} { + $widget trans::addTranscription $pane -alignment e -format "WaveSurfer" -extension ".lab" -labelcolor black -boundarycolor black -backgroundcolor white -labeldirectory "" -fileencoding "" -labelmenuevent Shift-ButtonPress-3 -adjustleftevent Control-l -adjustrightevent Control-r -playlabelevent Control-space -locked 0 -quickenter 1 -quickentertolerance 20 -extendboundaries 0 -linkboundaries 0 -playhighlight 0 -font {Courier 10} -labelmenu { + 2 7 + lab1 lab2 + lab3 lab4 + lab5 lab6 + lab7 lab8 + {} {} + {} {} + {} {} + } +} + +set pane [$widget addPane -maxheight 2048 -minheight 10] +$pane configure -background {#d9d9d9} +$pane configure -yaxisfont {Helvetica 10} + +if {[wsurf::PluginEnabled analysis]} { + $widget analysis::addWaveform $pane -channel all -predraw 0 -limit -1 -sectfftlength 512 -sectwintype Hamming -sectanalysistype FFT -sectlpcorder 20 -sectpreemphasis 0.0 -sectreference -110.0 -sectrange 110.0 -sectdoall 0 -sectexportheader 0 -subsample 1 -trimstart 1 -scrollspeed 250 -fill black +} + diff --git a/aubio.plug b/aubio.plug new file mode 100644 index 0000000..1878100 --- /dev/null +++ b/aubio.plug @@ -0,0 +1,2278 @@ +# -*-Mode:Tcl-*- +# +# Copyright (C) 2000-2004 Jonas Beskow and Kare Sjolander +# +# This file is part of the WaveSurfer package. +# The latest version can be found at http://www.speech.kth.se/wavesurfer/ +# +# ----------------------------------------------------------------------------- + +wsurf::RegisterPlugin transcription \ + -description "This plug-in is used to create transcription panes. Use the\ + properties-dialog to specify which transcription file that should be\ + displayed in a pane. It is usually practical to create a special\ + configuration for a certain combination of sound and transcription\ + files, specifying file properties such as filename extension, format,\ + file path, and encoding. There are\ + many options to control appearance and\ + editing functionality. Depending on the transcription file format\ + additional options might be available. There is a special pop-up menu\ + with functions to edit, play, convert and search labels. Unicode\ + characters are supported if using the source version of WaveSurfer,\ + in order to keep the binary versions small. The transcription plug-in is\ + used in combination with format handler plug-ins which handle\ + the conversion between file formats and the internal format\ + used by the transcription plug-in." \ + -url "http://www.speech.kth.se/wavesurfer/" \ + -addmenuentriesproc trans::addMenuEntries \ + -widgetcreatedproc trans::widgetCreated \ + -widgetdeletedproc trans::widgetDeleted \ + -panecreatedproc trans::paneCreated \ + -panedeletedproc trans::paneDeleted \ + -redrawproc trans::redraw \ + -getboundsproc trans::getBounds \ + -cursormovedproc trans::cursorMoved \ + -printproc trans::print \ + -propertiespageproc trans::propertyPane \ + -applypropertiesproc trans::applyProperties \ + -getconfigurationproc trans::getConfiguration \ + -openfileproc trans::openFile \ + -savefileproc trans::saveFile \ + -needsaveproc trans::needSave \ + -cutproc trans::cut \ + -copyproc trans::copy \ + -pasteproc trans::paste \ + -stateproc trans::state \ + -playproc trans::play \ + -stopproc trans::stop \ + -registercallbackproc trans::regCallback \ + -soundchangedproc trans::soundChanged + +# ----------------------------------------------------------------------------- + +namespace eval trans { + variable Info + + set Info(path) "" +} + +# ----------------------------------------------------------------------------- + +proc trans::addMenuEntries {w pane m hook x y} { + if {[string match query $hook]} { + upvar [namespace current]::${pane}::var v + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + return 1 + } + } + return 0 + } + if {[string match main $hook]} { + upvar [namespace current]::${pane}::var v + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + + for {set j 0} {$j < $v(menuNcols)} {incr j } { + for {set i 0} {$i < $v(menuNrows)} {incr i } { + if {$i==0} {set cb 1} else {set cb 0} + $m add command -label [subst $v($i$j)] -columnbreak $cb \ + -command [namespace code [list InsertLabel $w $pane $x $y \ + [subst $v($i$j)]]] \ + -font $v(font) + } + } + + $m add command -label "Onsets Detection ..." \ + -command [namespace code [list getComputeAubioOnset $w $pane]] + $m add command -label "Play Label" -columnbreak 1 \ + -command [namespace code [list PlayLabel $w $pane $x $y]] + $m add command -label "Insert Label" \ + -command [namespace code [list InsertLabel $w $pane $x $y]] + $m add command -label "Select Label" \ + -command [namespace code [list SelectLabel $w $pane $x $y]] + $m add command -label "Align Label" \ + -command [namespace code [list AlignLabel $w $pane $x $y]] + $m add command -label "Browse..." \ + -command [namespace code [list browse $w $pane]] + $m add command -label "Delete Label" \ + -command [namespace code [list DeleteLabel $w $pane $x $y]] + #$m add separator + $m add command -label "Convert..." \ + -command [namespace code [list convert $w $pane]] + $m add command -label "Load Transcription..." \ + -command [namespace code [list getOpenTranscriptionFile $w $pane]] + $m add command -label "Load Text Labels..." \ + -command [namespace code [list getOpenTextLabelFile $w $pane]] + $m add command -label "Save Transcriptions" \ + -command [namespace code [list saveTranscriptionFiles $w $pane]] + $m add command -label "Save Transcription As..." \ + -command [namespace code [list getSaveTranscriptionFile $w $pane]] + $m add command -label "Split Sound on Labels" \ + -command [namespace code [list SplitSoundFile $w $pane]] + } + } + } + + + if {[string match create $hook]} { + $m.$hook add command -label "AubioTranscription" \ + -command [namespace code [list createTranscription $w $pane]] + } elseif {[string length $hook] == 0} { + upvar [namespace current]::${pane}::var v + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + } + } + } +} + +proc trans::widgetCreated {w} { + variable Info + set Info($w,active) "" +} + +proc trans::widgetDeleted {w} { + variable Info + foreach key [array names Info $w*] {unset Info($key)} +} + +proc trans::paneCreated {w pane} { + namespace eval [namespace current]::${pane} { + variable var + } + upvar [namespace current]::${pane}::var v + set v(drawTranscription) 0 + +# foreach otherpane [$w _getPanes] { +# upvar wsurf::trans::${otherpane}::var ov +# if {[info exists ov(extBounds)] && $ov(extBounds)} { +# puts aaa +# $w _redraw +# } +# } +} + +proc trans::paneDeleted {w pane} { + upvar [namespace current]::${pane}::var v + + foreach otherpane [$w _getPanes] { + if {$pane == $otherpane} continue + upvar wsurf::analysis::${otherpane}::var ov + upvar wsurf::dataplot::${otherpane}::var dv + if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + if {[winfo exists $othercanvas]} { + $othercanvas delete tran$pane + } + } + } + namespace delete [namespace current]::${pane} +} + +proc trans::createTranscription {w pane} { + set pane [$w addPane -before $pane -height 20 -closeenough 3 \ + -minheight 20 -maxheight 20] + addTranscription $w $pane +} + +### Add-ons from Paul Brossier + + +proc trans::getComputeAubioOnset {w pane} { + set execFileName aubioonset + #exec which $execFileName > /dev/null || echo "$execFileName not found in the path" + # save selection to a file + # (from wavesurfer.tcl : SaveSelection) + set w [::wsurf::GetCurrent] + BreakIfInvalid $w + + # select all + set pane [lindex [$w _getPanes] 0] + if {$pane != ""} { + set length [$pane cget -maxtime] + } else { + set length [[$w cget -sound] length -unit seconds] + } + $w configure -selection [list 0.0 $length] + + # run on selection + foreach {left right} [$w cget -selection] break + if {$left == $right} return + set s [$w cget -sound] + set start [expr {int($left*[$s cget -rate])}] + set end [expr {int($right*[$s cget -rate])}] + set path [file dirname [$w getInfo fileName]] + + set tmpdir $::wsurf::Info(Prefs,tmpDir) + set fileName "$tmpdir/wavesurfer-tmp-aubio.snd" + set fileNameTxt "$tmpdir/wavesurfer-tmp-aubio.txt" + set aubioThreshold 0.2 + #[snack::getSaveFile -initialdir $path \ + #-format $::surf(fileFormat)] + #if {$fileName == ""} return + $s write $fileName -start $start -end $end -progress progressCallback + + # system command : compute onsets + exec aubioonset -i $fileName -t $aubioThreshold > $fileNameTxt 2> /dev/null + # some ed hacks to put the .txt in .lab format + # copy the times 3 times: 0.0000 0.0000 0.0000 + exec echo -e "e $fileNameTxt\\n,s/\\(.*\\)/\\\\1 \\\\1 \\\\1/\\nwq" | ed 2> /dev/null + + # open the file as a labelfile + openTranscriptionFile $w $pane $fileNameTxt labelfile + # delete both files + exec rm -f $fileName $fileNameTxt + $w _redrawPane $pane +} + +proc trans::getOpenTranscriptionFile {w pane} { + variable Info + upvar [namespace current]::${pane}::var v + + if {$v(changed)} { + if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} { + return + } + } + set file [file tail $v(fileName)] + if {$Info(path) != ""} { + set path $Info(path) + } else { + if {$v(labdir) == ""} { + set path [file dirname $v(fileName)] + } else { + set path [file normalize [file dirname $v(fileName)]] + set pathlist [file split $path] + set path [eval file join [lreplace $pathlist end end $v(labdir)]] + } + } + set fileName [tk_getOpenFile -title "Load Transcription" -initialfile $file \ + -initialdir $path -defaultextension $v(labext)] + if {$fileName == ""} return + + if {[string compare $path [file dirname $fileName]] != 0} { + set Info(path) [file dirname $fileName] + } + + openTranscriptionFile $w $pane $fileName labelfile + $w _redrawPane $pane +} + +proc trans::getOpenTextLabelFile {w pane} { + variable Info + upvar [namespace current]::${pane}::var v + + if {$v(changed)} { + if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} { + return + } + } + set file [file tail $v(fileName)] + if {$Info(path) != ""} { + set path $Info(path) + } else { + if {$v(labdir) == ""} { + set path [file dirname $v(fileName)] + } else { + set path [file normalize [file dirname $v(fileName)]] + set pathlist [file split $path] + set path [eval file join [lreplace $pathlist end end $v(labdir)]] + } + } + set fileName [tk_getOpenFile -title "Load Text Labels" -initialfile $file \ + -initialdir $path -defaultextension $v(labext)] + if {$fileName == ""} return + + if {[string compare $path [file dirname $fileName]] != 0} { + set Info(path) [file dirname $fileName] + } + + set f [open $fileName] + fconfigure $f -encoding utf-8 + set labels [split [read -nonewline $f]] + close $f + + + set start [expr 0.5 * [$pane cget -maxtime]] + set delta [expr 0.5 * [$pane cget -maxtime] / [llength $labels]] + set i 0 + set v(t1,start) 0.0 + foreach label $labels { + set v(t1,$i,end) [expr {$start + $i * $delta}] + set v(t1,$i,label) $label + set v(t1,$i,rest) "" + lappend map $i + incr i + } + set v(t1,end) [$pane cget -maxtime] + set v(nLabels) $i + set v(map) $map + set v(header) "" + set v(headerFmt) WaveSurfer + + $w _redrawPane $pane +} + +proc trans::saveTranscriptionFiles {w pane} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription) && $v(changed)} { + saveTranscriptionFile $w $pane + } + } +} + +proc trans::getSaveTranscriptionFile {w pane} { + upvar [namespace current]::${pane}::var v + + set file [file tail $v(fileName)] + if {$v(labdir) == ""} { + set path [file dirname $v(fileName)] + } else { + set path [file normalize [file dirname $v(fileName)]] + set pathlist [file split $path] + set path [eval file join [lreplace $pathlist end end $v(labdir)]] + } + + set fileName [tk_getSaveFile -title "Save Transcription" -initialfile $file \ + -initialdir $path -defaultextension $v(labext)] + if {$fileName == ""} return + + set v(fileName) $fileName + set v(labext) [file extension $fileName] + + saveTranscriptionFile $w $pane +} + +proc trans::addTranscription {w pane args} { + variable Info + upvar [namespace current]::${pane}::var v + + array set a [list \ + -alignment e \ + -labelcolor black \ + -boundarycolor black \ + -backgroundcolor white \ + -extension ".lab" \ + -font {Courier 8} \ + -format WaveSurfer \ + -labeldirectory "" \ + -fileencoding "" \ + -adjustleftevent Control-l \ + -adjustrightevent Control-r \ + -playlabelevent Control-space \ + -labelmenu {2 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8} \ + -locked 0 \ + -quickenter 1 \ + -quickentertolerance 20 \ + -extendboundaries 0 \ + -linkboundaries 0 \ + -playhighlight 0 \ + ] + if {[string match macintosh $::tcl_platform(platform)]} { + set a(-labelmenuevent) Shift-ButtonPress-1 + } else { + set a(-labelmenuevent) Shift-ButtonPress-3 + } + if {[string match Darwin $::tcl_platform(os)]} { + set a(-labelmenuevent) Shift-ButtonPress-1 + set a(-labelmenu) {1 6 lab1 lab2 lab3 lab4 lab5 lab6} + } + if {[string match unix $::tcl_platform(platform)] } { + set a(-font) {Courier 10} + } + array set a $args + + set v(alignment) $a(-alignment) + set v(labColor) $a(-labelcolor) + set v(bdColor) $a(-boundarycolor) + set v(bgColor) $a(-backgroundcolor) + set v(labext) .[string trim $a(-extension) .] + set v(font) $a(-font) + set v(format) $a(-format) + set v(labdir) $a(-labeldirectory) + set v(encoding) $a(-fileencoding) + set v(menuNcols) [lindex $a(-labelmenu) 0] + set v(menuNrows) [lindex $a(-labelmenu) 1] + set v(labelMenuEvent) $a(-labelmenuevent) + set v(adjustLeftEvent) $a(-adjustleftevent) + set v(adjustRightEvent) $a(-adjustrightevent) + set v(playLabelEvent) $a(-playlabelevent) + set v(locked) $a(-locked) + set v(quickenter) $a(-quickenter) + set v(quicktol) $a(-quickentertolerance) + set v(extBounds) $a(-extendboundaries) + set v(linkBounds) $a(-linkboundaries) + set v(highlight) $a(-playhighlight) + set v(changed) 0 + set v(t1,start) 0.0 + set v(t1,end) 0.0 + set v(nLabels) 0 + set v(fileName) "" + set v(lastPos) 0 + set v(map) {} + set v(lastmoved) -1 + set v(drawTranscription) 1 + set v(headerFmt) WaveSurfer + set v(header) "" + list { + set v(lastTag) "" + set v(hidden) "" + } + event add <> <$v(labelMenuEvent)> + event add <> <$v(adjustLeftEvent)> + event add <> <$v(adjustRightEvent)> + event add <> <$v(playLabelEvent)> + + for {set i 0} {$i < $v(menuNrows)} {incr i } { + for {set j 0} {$j < $v(menuNcols)} {incr j } { + set v($i$j) [lindex $a(-labelmenu) \ + [expr {2 + $v(menuNcols) * $i + $j}]] + } + } + + set c [$pane canvas] +list { + foreach tag {text bg bound} { + util::canvasbind $c $tag <> \ + [namespace code [list labelsMenu $w $pane %X %Y %x %y]] + } +} + util::canvasbind $c bound \ + [namespace code [list MoveBoundary $w $pane %x]] + util::canvasbind $c bound "" + + bind $c \ + [namespace code [list handleEvents PlayLabel %x %y]] + + $c bind bound [list $c configure \ + -cursor sb_h_double_arrow] + $c bind bound [list $c configure -cursor {}] + $c bind text [list $c configure -cursor xterm] + $c bind text [list $c configure -cursor {}] + + util::canvasbind $c text [namespace code \ + [list textB1Move $w $pane %W %x %y]] + util::canvasbind $c text "" + util::canvasbind $c text [namespace code \ + [list textClick $w $pane %W %x %y]] + + util::canvasbind $c bg [namespace code \ + [list boxClick $w $pane %W %x %y]] + bind $c [namespace code [list handleAnyKey $w $pane %W %x %y %A]] + bind $c [namespace code [list handleBackspace $w $pane %W]] + bind $c { + %W insert current insert "" + %W focus {} + } + + bind $c [namespace code [list handleEnterLeave $w $pane 1]] + bind $c [namespace code [list handleEnterLeave $w $pane 0]] + + bind [winfo toplevel $c] <> \ + [namespace code [list handleEvents AdjustLabel %x %y right]] + bind [winfo toplevel $c] <> \ + [namespace code [list handleEvents AdjustLabel %x %y left]] + + util::canvasbind $c text <> "" + util::canvasbind $c text <> "" + + bind $c <> \ + [namespace code [list handleEvents PlayLabel %x %y]] + bind [winfo toplevel $c] <> \ + [namespace code [list handleEvents PlayLabel %x %y]] + + bind $c <> "[namespace code [list handleDelete $w $pane %W]];break" + bind $c "[namespace code [list handleSpace $w $pane %W]];break" + bind $c "[namespace code [list FindNextLabel $w $pane]];break" + $c bind text [namespace code [list handleKeyRight $w $pane %W]] + $c bind text [namespace code [list handleKeyLeft $w $pane %W]] + + if {[$w getInfo fileName] != ""} { + openTranscriptionFile $w $pane [$w getInfo fileName] soundfile +# redraw $w $pane + } + + if {$::tcl_version > 8.2} { + if $v(locked) { + $c configure -state disabled + } else { + $c configure -state normal + } + } + # If the label file is longer than any current displayed pane, update them all + if {[info exists v(t1,end)]} { + if {$v(t1,end) > [$pane cget -maxtime]} { + $w _redraw + } + } +} + +proc trans::handleEvents {proc args} { + if {![info exists ::trpane]} { + return + } + if {[namespace which -variable \ + [namespace current]::${::trpane}::var] == ""} return + upvar [namespace current]::${::trpane}::var v + + if {[info exists v(cursorInPane)]} { + if {$v(cursorInPane)} { + eval $proc $::trw $::trpane $args + } + } +} + +proc trans::handleEnterLeave {w pane arg} { + upvar [namespace current]::${pane}::var v + + set v(cursorInPane) $arg +} + +proc trans::activateInput {w pane state} { + variable Info + upvar [namespace current]::${pane}::var v + + if {[info exists Info($w,active)]} { + if {$state == 1} { + set Info($w,active) $pane + [$pane yaxis] configure -relief solid + [$pane canvas] configure -relief solid + if {$v(extBounds)} { + drawExtendedBoundaries $w $pane + } + } + foreach p [$w _getPanes] { + if {$state == 0 || [string compare $p $pane]} { + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + [$p yaxis] configure -relief flat + [$p canvas] configure -relief flat + } + } + } + } + } +} + +proc trans::state {w state} { + variable Info + + if {[info exists Info($w,active)]} { + if {$Info($w,active) != ""} { + activateInput $w $Info($w,active) $state + set c [$Info($w,active) canvas] + if {$state} { + boxClick $w $Info($w,active) $c 0 0 + } + } + } +} + +proc trans::labelsMenu {w pane X Y x y} { + upvar [namespace current]::${pane}::var v + set m $w.popup + if {[winfo exists $m]} {destroy $m} + menu $m -tearoff 0 + $m add command -label "Play Label" \ + -command [namespace code [list PlayLabel $w $pane $x $y]] + $m add command -label "Insert Label" \ + -command [namespace code [list InsertLabel $w $pane $x $y]] + $m add command -label "Select Label" \ + -command [namespace code [list SelectLabel $w $pane $x $y]] + $m add command -label "Align Label" \ + -command [namespace code [list AlignLabel $w $pane $x $y]] + $m add command -label "Browse..." \ + -command [namespace code [list browse $w $pane]] + $m add command -label "Convert..." \ + -command [namespace code [list convert $w $pane]] + $m add separator + $m add command -label "Delete Label" \ + -command [namespace code [list DeleteLabel $w $pane $x $y]] + + for {set j 0} {$j < $v(menuNcols)} {incr j } { + for {set i 0} {$i < $v(menuNrows)} {incr i } { + if {$i==0} {set cb 1} else {set cb 0} + $m add command -label [subst $v($i$j)] -columnbreak $cb \ + -command [namespace code [list InsertLabel $w $pane $x $y \ + [subst $v($i$j)]]] \ + -font $v(font) + } + } + + if {[string match macintosh $::tcl_platform(platform)]} { + tk_popup $w.popup $X $Y 0 + } else { + tk_popup $w.popup $X $Y + } +} + +proc trans::textClick {w pane W x y} { + upvar [namespace current]::${pane}::var v + set ::trpane $pane + set ::trw $w + set c [$pane canvas] + focus $W + $W focus current + $W icursor current @[$W canvasx $x],[$W canvasy $y] + $W select clear + $W select from current @[$W canvasx $x],[$W canvasy $y] + set tagno [lindex [$c gettags current] 0] + activateInput $w $pane 1 + + set i [lsearch -exact $v(map) $tagno] + if {$i == -1} return + set start [GetStartByIndex $w $pane $i] + set end $v(t1,$tagno,end) + set len [expr $end - $start] + $w messageProc \ + "$v(t1,$tagno,label) ($tagno) start: $start end: $end length: $len" +} + +proc trans::textB1Move {w pane W x y} { + # clear widget selection before selecting any text + foreach {start end} [$w cget -selection] break + $w configure -selection [list $start $start] + + $W select to current @[$W canvasx $x],[$W canvasy $y] +} + +proc trans::boxClick {w pane W x y} { + upvar [namespace current]::${pane}::var v + set ::trpane $pane + set ::trw $w + set c [$pane canvas] + focus $W + $W focus hidden + set cx [$c canvasx $x] + set t [$pane getTime $cx] + $w configure -selection [list $t $t] + activateInput $w $pane 1 + set v(clicked) 1 +} + +proc trans::handleAnyKey {w pane W x y A} { + upvar [namespace current]::${pane}::var v + if {[string length $A] == 0} return + if {[string is print $A] == 0} return + set c [$pane canvas] + if {[$W focus] != $v(hidden)} { + set tag [$W focus] + catch {$W dchars $tag sel.first sel.last} + $W insert $tag insert $A + SetLabelText $w $pane [lindex [$c gettags $tag] 0] \ + [$c itemcget $tag -text] + } else { + if {$v(quickenter) == 0} return + set dx [expr {abs($v(lastPos) - $x)}] + if {$v(quicktol) > $dx && $v(clicked) == 0} { + set tagno $v(lastTag) + append v(t1,$tagno,label) $A + $c itemconf lab$v(lastTag) -text $v(t1,$tagno,label) + } else { + set v(lastTag) [InsertLabel $w $pane $x $y $A] + if {$v(lastTag) == ""} return + set v(lastPos) $x + set v(clicked) 0 + } + } + changed $w $pane +} + +proc trans::handleDelete {w pane W} { + set c [$pane canvas] + if {[$W focus] != {}} { + set tag [$W focus] + if {![catch {$W dchars $tag sel.first sel.last}]} { + return + } + $W dchars $tag insert + SetLabelText $w $pane [lindex [$c gettags $tag] 0] \ + [$c itemcget $tag -text] + changed $w $pane + } +} + +proc trans::handleBackspace {w pane W} { + set c [$pane canvas] + if {[$W focus] != {}} { + set tag [$W focus] + if {![catch {$W dchars $tag sel.first sel.last}]} { + return + } + set ind [expr {[$W index $tag insert]-1}] + if {$ind >= 0} { + $W icursor $tag $ind + $W dchars $tag insert + SetLabelText $w $pane [lindex [$c gettags $tag] 0] \ + [$c itemcget $tag -text] + changed $w $pane + } + } +} + +proc trans::handleSpace {w pane W} { + set c [$pane canvas] + if {[$W focus] != {}} { + $W select clear + $W insert [$W focus] insert _ + SetLabelText $w $pane [lindex [$c gettags [$W focus]] 0] \ + [$c itemcget [$W focus] -text] + } +} + +proc trans::handleKeyRight {w pane W} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + if {[$W focus] != {}} { + $W select clear + set __index [$W index [$W focus] insert] + $W icursor [$W focus] [expr {$__index + 1}] + if {$__index == [$W index [$W focus] insert]} { + set ti [lindex [$c gettags [$W focus]] 0] + set i [lsearch -exact $v(map) $ti] + set __focus [lindex $v(map) [expr {$i+1}]] + $W focus lab$__focus + $W icursor lab$__focus 0 + while {$width * [lindex [$c xview] 1]-10 < \ + [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 1] < 1} { + $w xscroll scroll 1 unit + } + } + } +} + +proc trans::handleKeyLeft {w pane W} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + if {[$W focus] != {}} { + $W select clear + set __index [$W index [$W focus] insert] + $W icursor [$W focus] [expr {[$W index [$W focus] insert] - 1}] + if {$__index == [$W index [$W focus] insert]} { + set ti [lindex [$c gettags [$W focus]] 0] + set i [lsearch -exact $v(map) $ti] + set __focus [lindex $v(map) [expr {$i-1}]] + $W focus lab$__focus + $W icursor lab$__focus end + while {$width * [lindex [$c xview] 0] +10 > \ + [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 0] > 0} { + $w xscroll scroll -1 unit + } + } + } +} + +proc trans::openFile {w soundFileName} { + variable Info + + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription)} { + openTranscriptionFile $w $pane [$w getInfo fileName] soundfile + } + } + return 0 +} + +proc trans::saveFile {w soundFileName} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription) && $v(changed)} { + saveTranscriptionFile $w $pane + } + } + return 0 +} + +proc trans::openTranscriptionFile {w pane fn type} { + variable Info + upvar [namespace current]::${pane}::var v + + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription) == 0} return + } + set fileName "" + if {[string match soundfile $type]} { + set path [file normalize [file dirname $fn]] + set pathlist [file split $path] + set rootname [file tail [file rootname $fn]] + set name $rootname.[string trim $v(labext) .] + + # Try to locate the corresponding label file + + if {$v(labdir) != ""} { + # Try the following directories in order + # 1. try to locate file in specified label file directory + # 2. try 'sound file path'/../'specified dir' + # 3. look in current directory + # 4. look in same directory as sound file + + if {[file readable [file join $v(labdir) $name]]} { + set fileName [file join $v(labdir) $name] + } elseif {[file readable [eval file join [lreplace $pathlist end end $v(labdir)] $name]]} { + set fileName [eval file join [lreplace $pathlist end end $v(labdir)] $name] + } + } + if {$fileName == ""} { + if {[file readable $name]} { + set fileName $name + } elseif {[file readable [file join $path $name]]} { + set fileName [file join $path $name] + } else { + set fileName $name + } + } + } else { + set fileName $fn + } + + # This filename should be correct, remember it + + set v(fileName) $fileName + set v(nLabels) 0 + set v(map) {} + set v(labext) [file extension $fileName] + + foreach {format loadProc saveProc} $Info(formats) { + if {[string compare $format $v(format)] == 0} { + set res [[namespace parent]::$loadProc $w $pane] + if {$res != ""} { + $w messageProc $res + set v(changed) 0 + return + } + } + } +} + +proc trans::saveTranscriptionFile {w pane} { + variable Info + upvar [namespace current]::${pane}::var v + + set fn $v(fileName) + set strip_fn [file tail [file rootname $fn]] + if {$strip_fn == ""} { + set strip_fn [file tail [file rootname [$w getInfo fileName]]] + } + set path [file dirname $fn] + set v(fileName) [file join $path $strip_fn.[string trim $v(labext) .]] + set fn $v(fileName) + catch {file copy $fn $fn~} + + foreach {format loadProc saveProc} $Info(formats) { + if {[string compare $format $v(format)] == 0} { + set res [[namespace parent]::$saveProc $w $pane] + if {$res != ""} { + $w messageProc $res + return + } + } + } + set v(changed) 0 + + return 0 +} + +proc trans::needSave {w pane} { + upvar [namespace current]::${pane}::var v + + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + if {$v(changed)} { + return 1 + } + } + } + return 0 +} + +proc trans::redraw {w pane} { + upvar [namespace current]::${pane}::var v + + if {!$v(drawTranscription)} return + + set c [$pane canvas] + $c delete tran + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var ov + upvar wsurf::dataplot::${otherpane}::var dv + if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + $othercanvas delete tran$pane + } + } + _redraw $w $pane $c 0 0 + # boxClick $w $pane $c 0 0 +} + +proc trans::_redraw {w pane c x y} { + upvar [namespace current]::${pane}::var v + + set progressproc [$w cget -progressproc] + if {$progressproc != "" && $v(nLabels) > 0} { +# $progressproc "Creating labels" 0.0 + } + set height [$pane cget -height] + set v(height) $height + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + set ascent [font metrics $v(font) -ascent] + set v(ascent) $ascent + $c configure -bg $v(bgColor) + + [$pane yaxis] delete ext + set vc [$pane yaxis] + set yw [winfo width $vc] + if {$::tcl_version > 8.2 && [string match disabled [$c cget -state]]} { + [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \ + -text L:$v(labext) \ + -font $v(font) -tags ext \ + -fill $v(labColor) + } else { + [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \ + -text $v(labext) \ + -font $v(font) -tags ext \ + -fill $v(labColor) + } + if {$v(nLabels) == 0} { + set slen [[$w cget -sound] length -unit seconds] + set endx [$pane getCanvasX $slen] + $c create rectangle [expr {$x+0}] $y \ + [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \ + -tags [list gEnd obj bg tran] -fill $v(bgColor) + set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \ + -text "" -tags [list hidden tran]] + return 0 + } else { + set start 0 + set end 0 + set label "" + + for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} { + set ind [lindex $v(map) $i] + if {$i == 0} { + set start $v(t1,start) + } else { + set ind2 [lindex $v(map) [expr {$i - 1}]] + set start $v(t1,$ind2,end) + } + set end $v(t1,$ind,end) + set label $v(t1,$ind,label) + set lx [$pane getCanvasX $start] + set rx [$pane getCanvasX $end] + + if {$lx >= 0 && $lx <= $width} { + #DrawLabel $w $pane $c $ind $i $x $y $lx $rx $label + set tx [ComputeTextPosition $w $pane $lx $rx] + $c create rectangle [expr {$x+$lx}] $y \ + [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \ + -tags [list g$ind obj bg tran] -fill $v(bgColor) + $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\ + -font $v(font) -anchor $v(alignment)\ + -tags [list $ind obj text lab$ind tran] \ + -fill $v(labColor) + $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \ + -tags [list b$ind obj bound tran topmost] -fill $v(bdColor) + } + if {$progressproc != "" && $i % 100 == 99} { +# $progressproc "Creating labels" [expr double($v(nLabels)-$i)/$v(nLabels)] + } + } + set start $v(t1,start) + set sx [$pane getCanvasX $start] + $c create rectangle [expr {$x+0}] $y \ + [expr {$x+$sx}] [expr {$y+$height-4}] -outline "" \ + -tags [list gStart obj bg tran] -fill $v(bgColor) + $c create line [expr {$x+$sx}] $y [expr {$x+$sx}] [expr {$y+$height}] \ + -tags [list bStart obj bound tran topmost] -fill $v(bdColor) + + set slen [[$w cget -sound] length -unit seconds] + set endx [$pane getCanvasX $slen] + $c create rectangle [expr {$x+$rx}] $y \ + [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \ + -tags [list gEnd obj bg tran] -fill $v(bgColor) + set prev [lindex $v(map) end] + $c lower gEnd g$prev + } + set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \ + -text "" -tags [list hidden tran]] + + if {$v(extBounds)} { + drawExtendedBoundaries $w $pane + } + + if {$progressproc != ""} { +# $progressproc "Creating labels" 1.0 + } + + return $height +} + +proc trans::drawExtendedBoundaries {w pane} { + upvar [namespace current]::${pane}::var v + + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var ov + upvar wsurf::dataplot::${otherpane}::var dv + if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + $othercanvas delete tran$pane + } + } + + set height [$pane cget -height] + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + + if {$v(nLabels) > 0} { + set start 0 + set end 0 + set label "" + + for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} { + set ind [lindex $v(map) $i] + if {$i == 0} { + set start $v(t1,start) + } else { + set ind2 [lindex $v(map) [expr {$i - 1}]] + set start $v(t1,$ind2,end) + } + set end $v(t1,$ind,end) + set label $v(t1,$ind,label) + set lx [$pane getCanvasX $start] + set rx [$pane getCanvasX $end] + + if {$lx >= 0 && $lx <= $width} { + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var av + upvar wsurf::dataplot::${otherpane}::var dv + if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + set height [$otherpane cget -height] + $othercanvas create line $rx 0 $rx \ + $height -tags [list b$ind$pane obj bound tran$pane] \ + -fill $v(bdColor) + } + } + } + } + } +} + +proc trans::DrawLabel {w pane c tagno i x y lx rx label} { + upvar [namespace current]::${pane}::var v + # set ascent [font metrics $v(font) -ascent] + # set height [$pane cget -height] + set ascent $v(ascent) + set height $v(height) + + set tx [ComputeTextPosition $w $pane $lx $rx] + $c create rectangle [expr {$x+$lx}] $y \ + [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \ + -tags [list g$tagno obj bg tran] -fill $v(bgColor) + $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\ + -font $v(font) -anchor $v(alignment)\ + -tags [list $tagno obj text lab$tagno tran] \ + -fill $v(labColor) + $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \ + -tags [list b$tagno obj bound tran topmost] -fill $v(bdColor) + + if {$i > 0} { + set prev [lindex $v(map) [expr {$i-1}]] + $c lower g$tagno g$prev + $c lower lab$tagno g$prev + $c lower b$tagno g$prev + } else { + $c lower g$tagno gStart + $c lower lab$tagno gStart + $c lower b$tagno gStart + } + + if {$v(extBounds)} { + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var av + upvar wsurf::dataplot::${otherpane}::var dv + if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + set height [$otherpane cget -height] + $othercanvas create line $rx 0 $rx \ + $height -tags [list b$tagno obj bound tran$pane] -fill $v(bdColor) + } + } + } +} + +proc trans::isLabel {tags} { + expr [string compare [lindex $tags 2] bg] == 0 || \ + [string compare [lindex $tags 2] text] == 0 +} + +proc trans::GetStartByIndex {w pane i} { + upvar [namespace current]::${pane}::var v + if {$i <= 0 || $i == "Start"} { + return $v(t1,start) + } else { + set ind [lindex $v(map) [expr $i-1]] + return $v(t1,$ind,end) + } +} + +proc trans::PlaceLabel {w pane tagno coords start end} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + if {$tagno != "Start"} { + # Place background and boundary + $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3] + $c coords g$tagno $start [lindex $coords 1] $end [expr [lindex $coords 3]-4] + + # Place label text + set tx [ComputeTextPosition $w $pane $start $end] + $c coords lab$tagno $tx [lindex [$c coords lab$tagno] 1] + } else { + $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3] + $c coords g$tagno 0 [lindex $coords 1] $end [expr [lindex $coords 3]-4] + } + + if {$v(extBounds)} { + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var av + upvar wsurf::dataplot::${otherpane}::var dv + if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + set height [$otherpane cget -height] + $othercanvas coords b$tagno$pane $end 0 $end $height + } + } + } +} + +proc trans::getBounds {w pane} { + upvar [namespace current]::${pane}::var v + + if {$v(drawTranscription)} { + list 0 0 $v(t1,end) 0 + } else { + list + } +} + +proc trans::MoveBoundary {w pane x} { + upvar [namespace current]::${pane}::var v + + set c [$pane canvas] + set s [$w cget -sound] + set coords [$c coords current] + set xc [$c canvasx $x] + if {$xc < 0} { set xc 0 } + set tagno [string trim [lindex [$c gettags current] 0] b] + set i [lsearch -exact $v(map) $tagno] + + # Logic which prevents a boundary to be moved past its neighbor + set h [lindex $v(map) [expr {$i-1}]] + set j [lindex $v(map) [expr {$i+1}]] + set px 0 + set nx [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + set pb [$c find withtag b$h] + set nb [$c find withtag b$j] + if {$pb != ""} { set px [lindex [$c coords $pb] 0]} + if {$nb != ""} { set nx [lindex [$c coords $nb] 0]} + if {$xc <= $px} { set xc [expr {$px + 1}] } + if {$nx <= $xc} { set xc [expr {$nx - 1}] } + + set start [$pane getCanvasX [GetStartByIndex $w $pane $i]] + + # Update time + if {$i == -1} { + set v(t1,start) [$pane getTime $xc] + } else { + set this [lindex $v(map) $i] + set oldTime $v(t1,$this,end) + set v(t1,$this,end) [$pane getTime $xc] + } + + # Place this label + PlaceLabel $w $pane $tagno $coords $start $xc + + # Place next label + PlaceNextLabel $w $pane $i $xc + + if {$v(linkBounds)} { + foreach otherpane [$w _getPanes] { + upvar [namespace current]::${otherpane}::var ov + if {$otherpane != $pane && $ov(drawTranscription) && \ + [info exists oldTime]} { + foreach tag $ov(map) { + if {$ov(t1,$tag,end) == $oldTime} { + set ov(t1,$tag,end) [$pane getTime $xc] + PlaceLabel $w $otherpane $tag $coords $start $xc + break + } + } + } + } + } + + if {$v(lastmoved) != $i} { + changed $w $pane + if {$tagno == "Start"} { + # wsurf::PrepareUndo "set [namespace current]::var(t1,start) \[list $v(t1,start)\]" "" + } else { + # wsurf::PrepareUndo "set [namespace current]::var(t1,$tagno,end) \[list $v(t1,$tagno,end)\]" "" + } + set v(lastmoved) $i + } + vtcanvas::motionEvent $pane $x 0 +} + +proc trans::SetLabelText {w pane tagno label} { + upvar [namespace current]::${pane}::var v + + $w messageProc [format "Transcription - %s" $label] + set v(t1,$tagno,label) $label +} + +proc trans::InsertLabel {w pane x y {label ""}} { + upvar [namespace current]::${pane}::var v + + set s [$w cget -sound] + set c [$pane canvas] + set cx [$c canvasx $x] + set t [$pane getTime $cx] + + set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]] + if {[isLabel $tags]} { + set tagno [string trim [lindex $tags 0] g] + if {$tagno == "End"} { + # set i $v(nLabels) + set i 0 + foreach ind $v(map) { + if {$t < $v(t1,$ind,end)} break + incr i + } + } else { + set i [lsearch -exact $v(map) $tagno] + } + } else { + set i 0 + foreach ind $v(map) { + if {$t < $v(t1,$ind,end)} break + incr i + } + } + + # Create label with a randomly chosen tag number + set n [clock clicks] + set v(t1,$n,end) $t + set v(t1,$n,label) $label + set v(t1,$n,rest) "" + set v(map) [linsert $v(map) $i $n] + incr v(nLabels) + + # Update start time if new label was inserted first + if {$i < 0} { + set v(t1,start) 0 + set co [$c coords bStart] + $c coords bStart 0 [lindex $co 1] 0 [lindex $co 3] + set co [$c coords gStart] + $c coords gStart 0 [lindex $co 1] 0 [lindex $co 3] + set start 0 + } else { + set start [$pane getCanvasX [GetStartByIndex $w $pane $i]] + } + + # Draw inserted label + DrawLabel $w $pane $c $n $i 0 0 $start $cx $label + + # Place next label + if {$i < 0} { incr i } + PlaceNextLabel $w $pane $i $cx + + # Display cursor if label is empty + if {$label==""} { + focus [$pane canvas] + [$pane canvas] focus lab$n + [$pane canvas] icursor lab$n @[$c canvasx $x],[$c canvasy $y] + } + + changed $w $pane + return $n +} + +proc trans::DeleteLabel {w pane x y} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]] + + if {[isLabel $tags] || [string compare [lindex $tags 2] bound] == 0} { + set tagno [string trim [lindex $tags 0] gb] + set i [lsearch -exact $v(map) $tagno] + if {$i == -1} return + + # Delete everything related to this label + unset v(t1,$tagno,label) + unset v(t1,$tagno,end) + unset v(t1,$tagno,rest) + set v(map) [lreplace $v(map) $i $i] + incr v(nLabels) -1 + $c delete b$tagno lab$tagno g$tagno + if {$v(extBounds)} { + foreach otherpane [$w _getPanes] { + upvar wsurf::analysis::${otherpane}::var av + upvar wsurf::dataplot::${otherpane}::var dv + if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} { + set othercanvas [$otherpane canvas] + $othercanvas delete b$tagno$pane + } + } + } + + # Place previous label box + set prev [lindex $v(map) [expr {$i-1}]] + if {$prev != ""} { + set end [lindex [$c coords g$prev] 2] + } else { + set end [$pane getCanvasX $v(t1,start)] + set prev 0 + } + set iprev [lsearch -exact $v(map) $prev] + PlaceNextLabel $w $pane $iprev $end + + changed $w $pane + } +} + +proc trans::AdjustLabel {w pane x y boundary} { + upvar [namespace current]::${pane}::var v + + set c [$pane canvas] + set xc [$c canvasx $x] + set t [$pane getTime $xc] + set tags [$c gettags [$c find closest $xc [$c canvasy $y]]] + + if {[isLabel $tags]} { + set tagno [string trim [lindex $tags 0] g] + set i [lsearch -exact $v(map) $tagno] + } else { + set i 0 + foreach ind $v(map) { + if {$t < $v(t1,$ind,end)} break + incr i + } + set tagno [lsearch -exact $v(map) $i] + } + + if {$i == $v(nLabels)} return + + if {$tagno != "End" && [string match left $boundary]} { + incr i -1 + set tagno [lindex $v(map) $i] + } + if {$tagno == "End"} return + if {$tagno != ""} { + set v(t1,$tagno,end) $t + } + + if {$i < 0} { + set v(t1,start) $t + set co [$c coords bStart] + set sx [$pane getCanvasX $t] + $c coords bStart $sx [lindex $co 1] $sx [lindex $co 3] + $c coords gStart 0 [lindex $co 1] $sx [lindex $co 3] + } + set start [$pane getCanvasX [GetStartByIndex $w $pane $i]] + + # Place this label + set co [$c coords b$tagno] + PlaceLabel $w $pane $tagno $co $start $xc + + # Place next label + PlaceNextLabel $w $pane $i $xc + + changed $w $pane + + $w messageProc [format "Transcription - %s" [$w formatTime $t]] +} + +proc trans::PlayLabel {w pane x y} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]] + + if {[isLabel $tags]} { + set tagno [string trim [lindex $tags 0] g] + set i [lsearch -exact $v(map) $tagno] + if {$i == -1} return + } else { + set i 0 + set cx [$c canvasx $x] + set t [$pane getTime $cx] + foreach ind $v(map) { + if {$t < $v(t1,$ind,end)} break + incr i + } + } + set start [GetStartByIndex $w $pane $i] + set this [lindex $v(map) $i] + if {$this == ""} return + set end $v(t1,$this,end) + + $w play $start $end +} + +proc trans::SelectLabel {w pane x y} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]] + + if {[isLabel $tags]} { + set tagno [string trim [lindex $tags 0] g] + set i [lsearch -exact $v(map) $tagno] + if {$i == -1} return + + set start [GetStartByIndex $w $pane $i] + set end $v(t1,$tagno,end) + + $w configure -selection [list $start $end] + } +} + +proc trans::AlignLabel {w pane x y} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]] + + if {[isLabel $tags]} { + set tagno [string trim [lindex $tags 0] g] + set i [lsearch -exact $v(map) $tagno] + if {$i == -1} return + + # Get current selection + foreach {start end} [$w cget -selection] break + if {$start == $end} return + + # Validate that selection and label overlap, otherwise generate warning msg + + set ostart [GetStartByIndex $w $pane $i] + set oend $v(t1,$tagno,end) + + if {$start >= $oend || $end <= $ostart} { + tk_messageBox -message "Label and selection must overlap!" + return + } + + # Update boundaries according to current selection + if {$i == 0} { + set v(t1,start) $start + } else { + set ind [lindex $v(map) [expr $i-1]] + set v(t1,$ind,end) $start + } + + set v(t1,$tagno,end) $end + + $w _redrawPane $pane + } +} + +proc trans::FindNextLabel {w pane} { + upvar [namespace current]::${pane}::var v + foreach {start end} [$w cget -selection] break + set i 0 + foreach ind $v(map) { + if {$end < $v(t1,$ind,end)} break + incr i + } + set tagno [lsearch -exact $v(map) $i] + if {$tagno == -1} return + set start [GetStartByIndex $w $pane $i] + set end $v(t1,$tagno,end) + + $w configure -selection [list $start $end] + set s [$w cget -sound] + set length [$s length -unit seconds] + $w xscroll moveto [expr {($start-1.0)/$length}] + $w play $start $end + set delay [expr 500 + int(1000 * ($end - $start))] + after $delay [namespace code [list FindNextLabel $w $pane]] +} + +proc trans::ComputeTextPosition {w pane start end} { + upvar [namespace current]::${pane}::var v + if {$v(alignment) == "c"} { + return [expr {($start+$end)/2}] + } elseif {$v(alignment) == "w"} { + return [expr {$start + 2}] + } else { + return [expr {$end - 2}] + } +} + +proc trans::PlaceNextLabel {w pane index pos} { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + incr index + set next [lindex $v(map) $index] + + if {$next == ""} { + set next End + set co [$c coords g$next] + $c coords g$next $pos [lindex $co 1] [lindex $co 2] [lindex $co 3] + } else { + set co [$c coords b$next] + $c coords g$next $pos [lindex $co 1] [lindex $co 2] [expr [lindex $co 3]-4] + # $c itemconf g$next -fill yellow + set xc [ComputeTextPosition $w $pane $pos [lindex $co 2]] + $c coords lab$next $xc [lindex [$c coords lab$next] 1] + } +} + +proc trans::print {w pane c x y} { + upvar [namespace current]::${pane}::var v + + upvar wsurf::analysis::${pane}::var ov + upvar wsurf::dataplot::${pane}::var dv + if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} { + foreach otherpane [$w _getPanes] { + upvar wsurf::trans::${otherpane}::var tv + if {[info exists tv(extBounds)] && $tv(extBounds)} { + set drawExtBounds 1 + break; + } + } + } + + if {[info exists drawExtBounds]} { + set height [$pane cget -height] + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + set yAxisCanvas [$pane yaxis] + set yAxisWidth [winfo width $yAxisCanvas] + + if {$tv(nLabels) > 0} { + set start 0 + set end 0 + set label "" + + for {set i [expr $tv(nLabels)-1]} {$i >= 0} {incr i -1} { + set ind [lindex $tv(map) $i] + if {$i == 0} { + set start $tv(t1,start) + } else { + set ind2 [lindex $tv(map) [expr {$i - 1}]] + set start $tv(t1,$ind2,end) + } + set end $tv(t1,$ind,end) + set label $tv(t1,$ind,label) + set lx [$pane getCanvasX $start] + set rx [$pane getCanvasX $end] + + if {$lx >= 0 && $lx <= $width} { + $c create line [expr {$rx+$yAxisWidth}] $y \ + [expr {$rx+$yAxisWidth}] [expr {$y+$height}] \ + -tags [list b$ind$pane obj bound tran$pane print tmpPrint] \ + -fill $tv(bdColor) + } + } + } + } + + + if {!$v(drawTranscription)} return + + $c raise bound + + set yAxisCanvas [$pane yaxis] + set yAxisWidth [winfo width $yAxisCanvas] + set h [$pane cget -height] + set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] + + $c create rectangle $yAxisWidth $y \ + [expr {$x+$width+$yAxisWidth}] [expr {$y+$h}] \ + -tags print -outline black + _redraw $w $pane $c $yAxisWidth $y +} + +proc trans::cursorMoved {w pane time value} { + upvar [namespace current]::${pane}::var v + + if {$v(drawTranscription)} { + $w messageProc \ + [format "%s: %s | $v(labelMenuEvent): Label menu" $v(fileName) [$w formatTime $time]] + } +} + +proc trans::soundChanged {w flag} { + set s [$w cget -sound] + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription)} { + $w _redrawPane $pane + } + } +} + +proc trans::propertyPane {w pane} { + if {$pane==""} return + upvar [namespace current]::${pane}::var v + + if {$v(drawTranscription)} { + list Trans1 [namespace code drawPage1] \ + Trans2 [namespace code drawPage2] + } +} + +proc trans::applyProperties {w pane} { + if {[string match *wavebar $pane]} return + variable Info + upvar [namespace current]::${pane}::var v + + if {[info exists v(drawTranscription)]} { + if {$v(drawTranscription)} { + foreach var {format alignment labext labdir encoding \ + labColor bdColor bgColor \ + font menuNrows menuNcols labelMenuEvent adjustLeftEvent \ + adjustRightEvent playLabelEvent locked quickenter quicktol \ + extBounds linkBounds highlight} { + if {[string compare $v(t,$var) $v($var)] !=0} { + if [string match labelMenuEvent $var] { + event delete <> <$v($var)> + event add <> <$v(t,$var)> + } + if [string match adjustLeftEvent $var] { + event delete <> <$v($var)> + event add <> <$v(t,$var)> + } + if [string match adjustRightEvent $var] { + event delete <> <$v($var)> + event add <> <$v(t,$var)> + } + if [string match playLabelEvent $var] { + event delete <> <$v($var)> + event add <> <$v(t,$var)> + } + if {$::tcl_version > 8.2 && [string match locked $var] == 1} { + set c [$pane canvas] + if $v(t,$var) { + $c configure -state disabled + } else { + $c configure -state normal + } + } + if {[string match format $var] || \ + [string match labext $var] || \ + [string match encoding $var] || \ + [string match labdir $var]} { + if {$v(changed)} { + if {[string match no [tk_messageBox -message "This operation will cause the transcription to be re-read from disk and you have unsaved changes.\nDo you want to continue?" -type yesno -icon question]]} { + return + } + } + set v($var) $v(t,$var) + openTranscriptionFile $w $pane [$w getInfo fileName] soundfile + set doRedraw 1 + } + set v($var) $v(t,$var) + if {[string match labColor $var] || \ + [string match bdColor $var] || \ + [string match font $var] || \ + [string match extBounds $var] || \ + [string match alignment $var] || \ + [string match bgColor $var]} { + set doRedraw 1 + } + if {[string match format $var]} { + set formatChanged 1 + } + } + } + if {[info exists doRedraw]} { + $w _redrawPane $pane + } + if {[info exists formatChanged]} { + wsurf::_remeberPropertyPage $w $pane + wsurf::_drawPropertyPages $w $pane + } + for {set i 0} {$i < $v(menuNrows)} {incr i } { + for {set j 0} {$j < $v(menuNcols)} {incr j } { + set v($i$j) $v(t,$i$j) + } + } + } + } +} + +proc trans::drawPage1 {w pane path} { + variable Info + upvar [namespace current]::${pane}::var v + + foreach f [winfo children $path] { + destroy $f + } + + foreach var {format alignment labext labdir encoding \ + labColor bdColor bgColor \ + font locked quickenter quicktol extBounds linkBounds} { + set v(t,$var) $v($var) + } + + pack [frame $path.f1] -anchor w + label $path.f1.l -text "Label file format:" -width 25 -anchor w + foreach {format loadProc saveProc} $Info(formats) { + lappend tmp $format + } + eval tk_optionMenu $path.f1.om [namespace current]::${pane}::var(t,format) \ + $tmp + pack $path.f1.l $path.f1.om -side left -padx 3 + + pack [frame $path.f2] -anchor w + label $path.f2.l -text "Label alignment:" -width 25 -anchor w + tk_optionMenu $path.f2.om [namespace current]::${pane}::var(t,alignment) \ + left center right + $path.f2.om.menu entryconfigure 0 -value w + $path.f2.om.menu entryconfigure 1 -value c + $path.f2.om.menu entryconfigure 2 -value e + pack $path.f2.l $path.f2.om -side left -padx 3 + + stringPropItem $path.f3 "Label filename extension:" 25 16 "" \ + [namespace current]::${pane}::var(t,labext) + + pack [frame $path.f4] -anchor w + label $path.f4.l -text "Label file path:" -width 25 -anchor w + entry $path.f4.e -textvar [namespace current]::${pane}::var(t,labdir) -wi 16 + pack $path.f4.l $path.f4.e -side left -padx 3 + if {[info command tk_chooseDirectory] != ""} { + button $path.f4.b -text Choose... \ + -command [namespace code [list chooseDirectory $w $pane]] + pack $path.f4.b -side left -padx 3 + } + + stringPropItem $path.f5 "Label file encoding:" 25 16 "" \ + [namespace current]::${pane}::var(t,encoding) + + colorPropItem $path.f6 "Label color:" 25 \ + [namespace current]::${pane}::var(t,labColor) + + colorPropItem $path.f7 "Boundary color:" 25 \ + [namespace current]::${pane}::var(t,bdColor) + + colorPropItem $path.f8 "Background color:" 25 \ + [namespace current]::${pane}::var(t,bgColor) + + stringPropItem $path.f9 "Font:" 25 16 "" \ + [namespace current]::${pane}::var(t,font) + + if {$::tcl_version > 8.2} { + booleanPropItem $path.f10 "Lock transcription" "" \ + [namespace current]::${pane}::var(t,locked) + } + + booleanPropItem $path.f11 "Quick transcribe" "" \ + [namespace current]::${pane}::var(t,quickenter) + + stringPropItem $path.f12 "Max cursor movement for current label:" 34 4 \ + pixels [namespace current]::${pane}::var(t,quicktol) + + booleanPropItem $path.f13 "Extend boundaries into waveform and spectrogram panes" "" \ + [namespace current]::${pane}::var(t,extBounds) + + booleanPropItem $path.f14 "Move coinciding boundaries in other transcription panes" "" \ + [namespace current]::${pane}::var(t,linkBounds) +} + +proc trans::confPage {w pane path} { + upvar [namespace current]::${pane}::var v + + for {set i 0} {$i < $v(t,menuNrows)} {incr i } { + if {![winfo exists $path.fl$i]} { + pack [frame $path.fl$i] -anchor w + } + for {set j 0} {$j < $v(t,menuNcols)} {incr j } { + if {![winfo exists $path.fl$i.e$j]} { + pack [entry $path.fl$i.e$j -width 6 \ + -textvar [namespace current]::${pane}::var(t,$i$j)] -side left + } + $path.fl$i.e$j configure -font $v(t,font) + } + while {[winfo exists $path.fl$i.e$j] == 1} { + destroy $path.fl$i.e$j + incr j + } + } + while {[winfo exists $path.fl$i] == 1} { + destroy $path.fl$i + incr i + } +} + +proc trans::chooseDirectory {w pane} { + upvar [namespace current]::${pane}::var v + set dir $v(t,labdir) + if {$dir == ""} { + set dir . + } + set res [tk_chooseDirectory -initialdir $dir -mustexist yes] + if {$res != ""} { + set v(t,labdir) $res + } +} + +proc trans::drawPage2 {w pane path} { + upvar [namespace current]::${pane}::var v + + foreach f [winfo children $path] { + destroy $f + } + + foreach var {adjustLeftEvent adjustRightEvent playLabelEvent labelMenuEvent \ + menuNrows menuNcols highlight} { + set v(t,$var) $v($var) + } + for {set i 0} {$i < $v(menuNrows)} {incr i } { + for {set j 0} {$j < $v(menuNcols)} {incr j } { + set v(t,$i$j) $v($i$j) + } + } + + booleanPropItem $path.f0 "Highlight labels during playback" "" \ + [namespace current]::${pane}::var(t,highlight) + + stringPropItem $path.f1 "Adjust left boundary event:" 28 25 "" \ + [namespace current]::${pane}::var(t,adjustLeftEvent) + + stringPropItem $path.f2 "Adjust right boundary event:" 28 25 "" \ + [namespace current]::${pane}::var(t,adjustRightEvent) + + stringPropItem $path.f3 "Play label event:" 28 25 "" \ + [namespace current]::${pane}::var(t,playLabelEvent) + + stringPropItem $path.f4 "Label menu event:" 28 25 "" \ + [namespace current]::${pane}::var(t,labelMenuEvent) + + pack [frame $path.f5] -anchor w + pack [label $path.f5.l -text "Label menu pane:" -width 25 -anchor w] -padx 3 + pack [frame $path.f6] -anchor w + pack [label $path.f6.lc -text "Columns:" -anchor w] -side left -padx 3 + pack [entry $path.f6.ec -width 2 -textvar \ + [namespace current]::${pane}::var(t,menuNcols)] -side left + pack [label $path.f6.lr -text "Rows:" -anchor w] -side left + pack [entry $path.f6.er -width 2 -textvar \ + [namespace current]::${pane}::var(t,menuNrows)] -side left + pack [button $path.f6.b -text Update \ + -command [namespace code [list confPage $w $pane $path]]] -side left \ + -padx 3 + bind $path.f6.ec [namespace code [list confPage $w $pane $path]] + bind $path.f6.er [namespace code [list confPage $w $pane $path]] + + for {set i 0} {$i < $v(t,menuNrows)} {incr i } { + pack [frame $path.fl$i] -anchor w + for {set j 0} {$j < $v(t,menuNcols)} {incr j } { + pack [entry $path.fl$i.e$j -font $v(t,font) \ + -textvar [namespace current]::${pane}::var(t,$i$j) -wi 6] \ + -side left + } + } +} + +proc trans::getConfiguration {w pane} { + upvar [namespace current]::${pane}::var v + + set result {} + if {$pane==""} {return {}} + if {$v(drawTranscription)} { + + lappend labmenu $v(menuNcols) $v(menuNrows) + for {set i 0} {$i < $v(menuNrows)} {incr i } { + for {set j 0} {$j < $v(menuNcols)} {incr j } { + if {[info exists v($i$j)]} { + lappend labmenu $v($i$j) + } else { + lappend labmenu \"\" + } + } + } + + append result "\$widget trans::addTranscription \$pane\ + -alignment $v(alignment)\ + -format \"$v(format)\"\ + -extension \"$v(labext)\"\ + -labelcolor $v(labColor)\ + -boundarycolor $v(bdColor)\ + -backgroundcolor $v(bgColor)\ + -labeldirectory \"$v(labdir)\"\ + -fileencoding \"$v(encoding)\"\ + -labelmenuevent $v(labelMenuEvent)\ + -adjustleftevent $v(adjustLeftEvent)\ + -adjustrightevent $v(adjustRightEvent)\ + -playlabelevent $v(playLabelEvent)\ + -locked $v(locked)\ + -quickenter $v(quickenter)\ + -quickentertolerance $v(quicktol)\ + -extendboundaries $v(extBounds)\ + -linkboundaries $v(linkBounds)\ + -playhighlight $v(highlight)\ + -font \{$v(font)\}" + append result " -labelmenu \{\n" + append result "[lrange $labmenu 0 1]\n" + for {set i 0} {$i < $v(menuNrows)} {incr i } { + append result "[lrange $labmenu [expr 2+$i*$v(menuNcols)] [expr 1+($i+1)*$v(menuNcols)]]\n" + } + append result "\}" + append result "\n" + } + return $result +} + +proc trans::cut {w t0 t1} { + set dt [expr {$t1-$t0}] + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if $v(drawTranscription) { + if {[llength $v(map)] == 0} continue + set c [$pane canvas] + + set i 0 + foreach ind $v(map) { + if {$t0 < $v(t1,$ind,end)} break + incr i + } + + # Adjust start time + if {$t0 < $v(t1,start)} { + if {$t1 < $v(t1,start)} { + # Current selection is to the left of start time + set v(t1,start) [expr {$v(t1,start)-$dt}] + } else { + # Left boundary of current selection is to the left of start time + set v(t1,start) $t0 + } + } + + # Left boundary is new end time for first label + if {$t0 < $v(t1,$ind,end) && \ + $t1 > $v(t1,$ind,end)} { + set v(t1,$ind,end) $t0 + incr i + set ind [lindex $v(map) $i] + } + set j $i + + # Delete labels within the selection + while {$ind != "" && $t1 > $v(t1,$ind,end)} { + # unset v(t1,$ind,label) + # unset v(t1,$ind,end) + # unset v(t1,$ind,rest) + incr i + set ind [lindex $v(map) $i] + } + if {$j <= [expr $i - 1] && $j < [llength $v(map)]} { + set v(map) [lreplace $v(map) $j [expr $i - 1]] + set v(nLabels) [llength $v(map)] + } + + # Move all remaining labels $dt to the left + set ind [lindex $v(map) $j] + while {$ind != "" && $t1 < $v(t1,$ind,end)} { + set v(t1,$ind,end) [expr {$v(t1,$ind,end)-$dt}] + incr j + set ind [lindex $v(map) $j] + } + changed $w $pane + $w _redrawPane $pane + } + } +} + +proc trans::copy {w t0 t1} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if $v(drawTranscription) { + set c [$pane canvas] + if {[$c focus] != {}} { + set tag [$c focus] + if {[catch {set s [$c index $tag sel.first]}]} return + set e [$c index $tag sel.last] + clipboard append [string range [$c itemcget $tag -text] $s $e] + } + } + } +} + +proc trans::paste {w t length} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if $v(drawTranscription) { + set c [$pane canvas] + if {[focus] == $c && [$c focus] != $v(hidden)} { + catch {set cbText [selection get -selection CLIPBOARD]} + if {[info exists cbText] == 0} { return 0 } + $c insert [$c focus] insert [selection get -selection CLIPBOARD] + SetLabelText $w $pane [lindex [$c gettags [$c focus]] 0] \ + [$c itemcget [$c focus] -text] + return 1 + } + } + } + return 0 + list { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if $v(drawTranscription) { + if {[llength $v(map)] == 0} return + set i 0 + foreach ind $v(map) { + if {$t < $v(t1,$ind,end)} break + incr i + } + + # Adjust start time + if {$t < $v(t1,start)} { + set v(t1,start) [expr {$v(t1,start)+$length}] + } + + # Move all remaining labels $length to the left + while {$ind != ""} { + set v(t1,$ind,end) [expr {$v(t1,$ind,end)+$length}] + incr i + set ind [lindex $v(map) $i] + } + + $w _redrawPane $pane + } + }} +} + +proc trans::find {w pane} { + upvar [namespace current]::${pane}::var v + + set p $v(browseTL) + set v(nMatch) 0 + $p.f2.list delete 0 end + set i 0 + if {$v(matchCase)} { + set nocase "" + } else { + set nocase -nocase + } + foreach ind $v(map) { + if {[eval regexp $nocase $v(pattern) \{$v(t1,$ind,label)\}]} { + if {$i == 0} { + set start $v(t1,start) + } else { + set prev [lindex $v(map) [expr $i-1]] + set start $v(t1,$prev,end) + } + if {[string match *\"* \{$v(t1,$ind,label)\}]} { + set tmp "\{$v(t1,$ind,label):\} $start $v(t1,$ind,end)" + } else { + set tmp "$v(t1,$ind,label): $start $v(t1,$ind,end)" + } + $p.f2.list insert end $tmp + incr v(nMatch) + } + incr i + } +} + +proc trans::select {w pane} { + upvar [namespace current]::${pane}::var v + + set p $v(browseTL) + + set cursel [$p.f2.list curselection] + if {$cursel == ""} return + set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1] + set end [lindex [$p.f2.list get [lindex $cursel end]] end] + $w configure -selection [list $start $end] + set s [$w cget -sound] + set length [$s length -unit seconds] + $w xscroll moveto [expr {$start/$length}] +} + +proc trans::findPlay {w pane} { + upvar [namespace current]::${pane}::var v + + set p $v(browseTL) + set cursel [$p.f2.list curselection] + if {$cursel != ""} { + set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1] + set end [lindex [$p.f2.list get [lindex $cursel end]] end] + $w play $start $end + } +} + +proc trans::browse {w pane} { + upvar [namespace current]::${pane}::var v + + regsub -all {\.} $pane _ tmp + set v(browseTL) .browse$tmp + catch {destroy .browse$tmp} + set p [toplevel .browse$tmp] + wm title $p "Browse Labels" + + pack [frame $p.f] + pack [entry $p.f.e -textvar [namespace current]::${pane}::var(pattern)]\ + -side left + pack [button $p.f.l -text Find \ + -command [namespace code [list find $w $pane]]] -side left + + pack [ label $p.l -text "Results:"] + pack [ frame $p.f2] -fill both -expand true + pack [ scrollbar $p.f2.scroll -command "$p.f2.list yview"] -side right \ + -fill y + listbox $p.f2.list -yscroll "$p.f2.scroll set" -setgrid 1 \ + -selectmode extended -height 6 -width 40 + pack $p.f2.list -side left -expand true -fill both + + pack [checkbutton $p.cb -text "Match case" -anchor w \ + -variable [namespace current]::${pane}::var(matchCase)] + + pack [ frame $p.f3] -pady 10 -fill x -expand true + pack [ button $p.f3.b1 -bitmap snackPlay \ + -command [namespace code [list findPlay $w $pane]]] \ + -side left + pack [ button $p.f3.b2 -bitmap snackStop -command "$w stop"] -side left + pack [ button $p.f3.b3 -text Close -command "destroy $p"] -side right + + bind $p.f.e [namespace code [list find $w $pane]] + bind $p.f2.list [namespace code [list select $w $pane]] + if {$v(pattern) != ""} { + find $w $pane + } + bind $p.f2.list [namespace code [list findPlay $w $pane]] + focus $p.f.e +} + +proc trans::convert {w pane} { + upvar [namespace current]::${pane}::var v + variable Info + regsub -all {\.} $pane _ tmp + set v(convertTL) .convert$tmp + catch {destroy .convert$tmp} + set p [toplevel .convert$tmp] + wm title $p "Convert Transcription File format" + + pack [ label $p.l1 -text "Current transcription file format: $v(format)"] + + set v(t,format) $v(format) + pack [frame $p.f1] -anchor w + label $p.f1.l -text "New transcription file format:" -anchor w + foreach {format loadProc saveProc} $Info(formats) { + lappend fmtlist $format + } + eval tk_optionMenu $p.f1.om [namespace current]::${pane}::var(t,format) \ + $fmtlist + pack $p.f1.l $p.f1.om -side left -padx 3 + + pack [frame $p.f] + pack [ button $p.f.b1 -text OK -command [namespace code [list doConvert $w $pane]]\n[list destroy $p]] -side left -padx 3 + pack [ button $p.f.b2 -text Close -command "destroy $p"] -side left -padx 3 +} + +proc trans::doConvert {w pane} { + upvar [namespace current]::${pane}::var v + set v(format) $v(t,format) +} + +proc trans::play {w} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription) && $v(highlight)} { + set v(playIndex) 0 + } + } + after 200 [namespace code [list _updatePlay $w]] +} + +proc trans::stop {w} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + if {$v(drawTranscription)} { + after cancel [namespace code [list FindNextLabel $w $pane]] + } + } +} + +proc trans::_updatePlay {w} { + if {[winfo exists $w] == 0} { + return + } + if {[$w getInfo isPlaying] == 0} { + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + set c [$pane canvas] + if {$v(drawTranscription)} { + if {$v(highlight) && [info exists v(playIndex)]} { + set ind [lindex $v(map) $v(playIndex)] + if {$ind != ""} { + $c itemconf g$ind -fill $v(bgColor) + } + } + } + } + return + } + set s [$w cget -sound] + foreach pane [$w _getPanes] { + upvar [namespace current]::${pane}::var v + if {$v(drawTranscription) && $v(highlight)} { + set cursorpos [$pane cget -cursorpos] + set c [$pane canvas] + set ind [lindex $v(map) $v(playIndex)] + if {$ind != ""} { + $c itemconf g$ind -fill $v(bgColor) + while (1) { + set ind [lindex $v(map) $v(playIndex)] + if {$ind == ""} return + if {$cursorpos < $v(t1,$ind,end)} break + incr v(playIndex) + } + $c itemconf g$ind -fill [$w cget -cursorcolor] + } + } + } + if {[$w getInfo isPlaying]} { + after 50 [namespace code [list _updatePlay $w]] + } +} + +# ----------------------------------------------------------------------------- +# !!! experimental + +proc trans::regCallback {name callback script} { + variable Info +# puts [info level 0] + if {$callback != "-transcription::transcriptionchangedproc"} { + error "unknown callback \"$callback\"" + } else { + set Info(Callback,$name,transChangedProc) $script + } +} + +proc trans::changed {w pane} { +# puts [info level 0]([info level -1]) + variable Info + upvar [namespace current]::${pane}::var v + set v(changed) 1 + foreach key [array names Info Callback,*,transChangedProc] { + puts "invoking callback $key" + $Info($key) $w $pane + } +} + + + + + + +proc trans::SplitSoundFile {w pane} { + upvar [namespace current]::${pane}::var v + set s [$w cget -sound] + + foreach ind $v(map) { + set start [expr {int([GetStartByIndex $w $pane $ind] * [$s cget -rate])}] + set end [expr {int($v(t1,$ind,end) * [$s cget -rate])}] + $s write $v(t1,$ind,label).wav -start $start -end $end + } +} -- 2.11.0