ref: 180eecaabdf4a6b7309890d4301b50674f458593
parent: 1342c2f184764c8b3128dcd04a5b9306a708569b
author: Paul Brossier <piem@piem.org>
date: Sun Oct 25 18:16:24 EDT 2009
plugins/wavesurfer: moved to own branch
--- a/configure.ac
+++ b/configure.ac
@@ -266,7 +266,6 @@
interfaces/java/Makefile
interfaces/java/aubio/Makefile
plugins/Makefile
- plugins/wavesurfer/Makefile
plugins/puredata/Makefile
doc/Makefile
])
--- a/plugins/Makefile.am
+++ b/plugins/Makefile.am
@@ -1,4 +1,4 @@
if PUREDATAFOUND
PUREDATA = puredata
endif
-SUBDIRS = wavesurfer ${PUREDATA} +SUBDIRS = ${PUREDATA} --- a/plugins/wavesurfer/Makefile.am
+++ /dev/null
@@ -1,1 +1,0 @@
-EXTRA_DIST = README aubio.conf aubio.plug
--- a/plugins/wavesurfer/README
+++ /dev/null
@@ -1,9 +1,0 @@
-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.
--- a/plugins/wavesurfer/aubio.conf
+++ /dev/null
@@ -1,46 +1,0 @@
-# -*-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
-}
-
--- a/plugins/wavesurfer/aubio.plug
+++ /dev/null
@@ -1,2278 +1,0 @@
-# -*-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 <piem@altern.org>
-
-
-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 <<LabelMenuEvent>> <$v(labelMenuEvent)>
- event add <<AdjustLeftEvent>> <$v(adjustLeftEvent)>
- event add <<AdjustRightEvent>> <$v(adjustRightEvent)>
- event add <<PlayLabelEvent>> <$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 <<LabelMenuEvent>> \
- [namespace code [list labelsMenu $w $pane %X %Y %x %y]]
- }
-}
- util::canvasbind $c bound <B1-Motion> \
- [namespace code [list MoveBoundary $w $pane %x]]
- util::canvasbind $c bound <ButtonPress-1> ""
-
- bind $c <ButtonPress-2> \
- [namespace code [list handleEvents PlayLabel %x %y]]
-
- $c bind bound <Enter> [list $c configure \
- -cursor sb_h_double_arrow]
- $c bind bound <Leave> [list $c configure -cursor {}]- $c bind text <Enter> [list $c configure -cursor xterm]
- $c bind text <Leave> [list $c configure -cursor {}]-
- util::canvasbind $c text <B1-Motion> [namespace code \
- [list textB1Move $w $pane %W %x %y]]
- util::canvasbind $c text <ButtonRelease-1> ""
- util::canvasbind $c text <ButtonPress-1> [namespace code \
- [list textClick $w $pane %W %x %y]]
-
- util::canvasbind $c bg <ButtonPress-1> [namespace code \
- [list boxClick $w $pane %W %x %y]]
- bind $c <Any-Key> [namespace code [list handleAnyKey $w $pane %W %x %y %A]]
- bind $c <BackSpace> [namespace code [list handleBackspace $w $pane %W]]
- bind $c <Return> {- %W insert current insert ""
- %W focus {}- }
-
- bind $c <Enter> [namespace code [list handleEnterLeave $w $pane 1]]
- bind $c <Leave> [namespace code [list handleEnterLeave $w $pane 0]]
-
- bind [winfo toplevel $c] <<AdjustRightEvent>> \
- [namespace code [list handleEvents AdjustLabel %x %y right]]
- bind [winfo toplevel $c] <<AdjustLeftEvent>> \
- [namespace code [list handleEvents AdjustLabel %x %y left]]
-
- util::canvasbind $c text <<AdjustRightEvent>> ""
- util::canvasbind $c text <<AdjustLeftEvent>> ""
-
- bind $c <<PlayLabelEvent>> \
- [namespace code [list handleEvents PlayLabel %x %y]]
- bind [winfo toplevel $c] <<PlayLabelEvent>> \
- [namespace code [list handleEvents PlayLabel %x %y]]
-
- bind $c <<Delete>> "[namespace code [list handleDelete $w $pane %W]];break"
- bind $c <space> "[namespace code [list handleSpace $w $pane %W]];break"
- bind $c <Shift-Control-space> "[namespace code [list FindNextLabel $w $pane]];break"
- $c bind text <Key-Right> [namespace code [list handleKeyRight $w $pane %W]]
- $c bind text <Key-Left> [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 <<LabelMenuEvent>> <$v($var)>
- event add <<LabelMenuEvent>> <$v(t,$var)>
- }
- if [string match adjustLeftEvent $var] {- event delete <<AdjustLeftEvent>> <$v($var)>
- event add <<AdjustLeftEvent>> <$v(t,$var)>
- }
- if [string match adjustRightEvent $var] {- event delete <<AdjustRightEvent>> <$v($var)>
- event add <<AdjustRightEvent>> <$v(t,$var)>
- }
- if [string match playLabelEvent $var] {- event delete <<PlayLabelEvent>> <$v($var)>
- event add <<PlayLabelEvent>> <$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 <Key-Return> [namespace code [list confPage $w $pane $path]]
- bind $path.f6.er <Key-Return> [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 <Return> [namespace code [list find $w $pane]]
- bind $p.f2.list <ButtonRelease-1> [namespace code [list select $w $pane]]
- if {$v(pattern) != ""} {- find $w $pane
- }
- bind $p.f2.list <Double-Button-1> [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
- }
-}
--
⑨