source: plugins/wavesurfer/aubio.plug @ d9101a5

feature/autosinkfeature/cnnfeature/cnn_orgfeature/constantqfeature/crepefeature/crepe_orgfeature/pitchshiftfeature/pydocstringsfeature/timestretchfix/ffmpeg5pitchshiftsamplertimestretchyinfft+
Last change on this file since d9101a5 was 96fb8ad, checked in by Paul Brossier <piem@altern.org>, 20 years ago

import 0.1.7.1

  • Property mode set to 100644
File size: 64.1 KB
Line 
1# -*-Mode:Tcl-*-
2#
3#  Copyright (C) 2000-2004 Jonas Beskow and Kare Sjolander
4#
5# This file is part of the WaveSurfer package.
6# The latest version can be found at http://www.speech.kth.se/wavesurfer/
7#
8# -----------------------------------------------------------------------------
9
10wsurf::RegisterPlugin transcription \
11  -description "This plug-in is used to create transcription panes. Use the\
12  properties-dialog to specify which transcription file that should be\
13  displayed in a pane. It is usually practical to create a special\
14  configuration for a certain combination of sound and transcription\
15  files, specifying file properties such as filename extension, format,\
16  file path, and encoding. There are\
17  many options to control appearance and\
18  editing functionality. Depending on the transcription file format\
19  additional options might be available. There is a special pop-up menu\
20  with functions to edit, play, convert and search labels. Unicode\
21  characters are supported if using the source version of WaveSurfer,\
22  in order to keep the binary versions small. The transcription plug-in is\
23  used in combination with format handler plug-ins which handle\
24  the conversion between file formats and the internal format\
25  used by the transcription plug-in." \
26  -url "http://www.speech.kth.se/wavesurfer/" \
27  -addmenuentriesproc   trans::addMenuEntries \
28  -widgetcreatedproc    trans::widgetCreated \
29  -widgetdeletedproc    trans::widgetDeleted \
30  -panecreatedproc      trans::paneCreated \
31  -panedeletedproc      trans::paneDeleted \
32  -redrawproc           trans::redraw \
33  -getboundsproc        trans::getBounds \
34  -cursormovedproc      trans::cursorMoved \
35  -printproc            trans::print \
36  -propertiespageproc   trans::propertyPane \
37  -applypropertiesproc  trans::applyProperties \
38  -getconfigurationproc trans::getConfiguration \
39  -openfileproc         trans::openFile \
40  -savefileproc         trans::saveFile \
41  -needsaveproc         trans::needSave \
42  -cutproc              trans::cut \
43  -copyproc             trans::copy \
44  -pasteproc            trans::paste \
45  -stateproc            trans::state \
46  -playproc             trans::play \
47  -stopproc             trans::stop \
48  -registercallbackproc trans::regCallback \
49  -soundchangedproc     trans::soundChanged
50
51# -----------------------------------------------------------------------------
52
53namespace eval trans {
54 variable Info
55
56 set Info(path) ""
57}
58
59# -----------------------------------------------------------------------------
60
61proc trans::addMenuEntries {w pane m hook x y} {
62 if {[string match query $hook]} {
63  upvar [namespace current]::${pane}::var v
64  if {[info exists v(drawTranscription)]} {
65   if {$v(drawTranscription)} {
66    return 1
67   }
68  }
69  return 0
70 }
71 if {[string match main $hook]} {
72  upvar [namespace current]::${pane}::var v
73  if {[info exists v(drawTranscription)]} {
74   if {$v(drawTranscription)} {
75
76    for {set j 0} {$j < $v(menuNcols)} {incr j } {
77     for {set i 0} {$i < $v(menuNrows)} {incr i } {
78      if {$i==0} {set cb 1} else {set cb 0}
79      $m add command -label [subst $v($i$j)] -columnbreak $cb \
80        -command [namespace code [list InsertLabel $w $pane $x $y \
81        [subst $v($i$j)]]] \
82        -font $v(font)
83     }
84    }
85
86    $m add command -label "Onsets Detection ..." \
87      -command [namespace code [list getComputeAubioOnset $w $pane]]
88    $m add command -label "Play Label" -columnbreak 1 \
89      -command [namespace code [list PlayLabel $w $pane $x $y]]
90    $m add command -label "Insert Label" \
91      -command [namespace code [list InsertLabel $w $pane $x $y]]
92    $m add command -label "Select Label" \
93      -command [namespace code [list SelectLabel $w $pane $x $y]]
94    $m add command -label "Align Label" \
95      -command [namespace code [list AlignLabel $w $pane $x $y]]
96    $m add command -label "Browse..." \
97      -command [namespace code [list browse $w $pane]]
98    $m add command -label "Delete Label" \
99      -command [namespace code [list DeleteLabel $w $pane $x $y]]
100    #$m add separator
101    $m add command -label "Convert..." \
102      -command [namespace code [list convert $w $pane]]
103    $m add command -label "Load Transcription..." \
104      -command [namespace code [list getOpenTranscriptionFile $w $pane]]
105    $m add command -label "Load Text Labels..." \
106      -command [namespace code [list getOpenTextLabelFile $w $pane]]
107    $m add command -label "Save Transcriptions" \
108      -command [namespace code [list saveTranscriptionFiles $w $pane]]
109    $m add command -label "Save Transcription As..." \
110      -command [namespace code [list getSaveTranscriptionFile $w $pane]]   
111    $m add command -label "Split Sound on Labels" \
112        -command [namespace code [list SplitSoundFile $w $pane]]   
113   }
114  }
115 } 
116
117
118 if {[string match create $hook]} {
119  $m.$hook add command -label "AubioTranscription" \
120    -command [namespace code [list createTranscription $w $pane]]
121 } elseif {[string length $hook] == 0} {
122  upvar [namespace current]::${pane}::var v
123  if {[info exists v(drawTranscription)]} {
124   if {$v(drawTranscription)} {
125   }
126  }
127 }
128}
129
130proc trans::widgetCreated {w} {
131 variable Info
132 set Info($w,active) ""
133}
134
135proc trans::widgetDeleted {w} {
136 variable Info
137 foreach key [array names Info $w*] {unset Info($key)}
138}
139
140proc trans::paneCreated {w pane} {
141 namespace eval [namespace current]::${pane} {
142  variable var
143 }
144 upvar [namespace current]::${pane}::var v
145 set v(drawTranscription) 0
146 
147# foreach otherpane [$w _getPanes] {
148#  upvar wsurf::trans::${otherpane}::var ov
149#  if {[info exists ov(extBounds)] && $ov(extBounds)} {
150#   puts aaa
151#   $w _redraw
152#  }
153# }
154}
155
156proc trans::paneDeleted {w pane} {
157 upvar [namespace current]::${pane}::var v
158 
159 foreach otherpane [$w _getPanes] {
160  if {$pane == $otherpane} continue
161  upvar wsurf::analysis::${otherpane}::var ov
162  upvar wsurf::dataplot::${otherpane}::var dv
163  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
164   set othercanvas [$otherpane canvas]
165   if {[winfo exists $othercanvas]} {
166    $othercanvas delete tran$pane
167   }
168  }
169 }
170 namespace delete [namespace current]::${pane}
171}
172
173proc trans::createTranscription {w pane} {
174 set pane [$w addPane -before $pane -height 20 -closeenough 3 \
175   -minheight 20 -maxheight 20]
176 addTranscription $w $pane
177}
178
179### Add-ons from Paul Brossier <piem@altern.org>
180
181
182proc trans::getComputeAubioOnset {w pane} {
183 set execFileName aubioonset
184 #exec which $execFileName > /dev/null || echo "$execFileName not found in the path"
185 # save selection to a file
186 # (from wavesurfer.tcl : SaveSelection)
187 set w [::wsurf::GetCurrent]
188 BreakIfInvalid $w
189
190 # select all
191 set pane [lindex [$w _getPanes] 0]
192 if {$pane != ""} {
193  set length [$pane cget -maxtime]
194 } else {
195  set length [[$w cget -sound] length -unit seconds]
196 }
197 $w configure -selection [list 0.0 $length]
198
199 # run on selection
200 foreach {left right} [$w cget -selection] break
201 if {$left == $right} return
202 set s [$w cget -sound]
203 set start [expr {int($left*[$s cget -rate])}]
204 set end   [expr {int($right*[$s cget -rate])}]
205 set path [file dirname [$w getInfo fileName]]
206 
207 set tmpdir      $::wsurf::Info(Prefs,tmpDir)
208 set fileName    "$tmpdir/wavesurfer-tmp-aubio.snd"
209 set fileNameTxt "$tmpdir/wavesurfer-tmp-aubio.txt"
210 set aubioThreshold 0.2
211        #[snack::getSaveFile -initialdir $path \
212     #-format $::surf(fileFormat)]
213 #if {$fileName == ""} return
214 $s write $fileName -start $start -end $end -progress progressCallback
215
216 # system command : compute onsets
217 exec aubioonset -i $fileName -t $aubioThreshold > $fileNameTxt 2> /dev/null
218 # some ed hacks to put the .txt in .lab format
219 # copy the times 3 times: 0.0000 0.0000 0.0000
220 exec echo -e "e $fileNameTxt\\n,s/\\(.*\\)/\\\\1 \\\\1 \\\\1/\\nwq" | ed 2> /dev/null
221 
222 # open the file as a labelfile
223 openTranscriptionFile $w $pane $fileNameTxt labelfile
224 # delete both files
225 exec rm -f $fileName $fileNameTxt
226 $w _redrawPane $pane
227}
228
229proc trans::getOpenTranscriptionFile {w pane} {
230 variable Info
231 upvar [namespace current]::${pane}::var v
232
233 if {$v(changed)} {
234  if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} {
235   return
236  }
237 }
238 set file [file tail $v(fileName)]
239 if {$Info(path) != ""} {
240  set path $Info(path)
241 } else {
242  if {$v(labdir) == ""} {
243   set path [file dirname $v(fileName)]
244  } else {
245   set path [file normalize [file dirname $v(fileName)]]
246   set pathlist [file split $path]
247   set path [eval file join [lreplace $pathlist end end $v(labdir)]]
248  }
249 }
250 set fileName [tk_getOpenFile -title "Load Transcription" -initialfile $file \
251   -initialdir $path -defaultextension $v(labext)]
252 if {$fileName == ""} return
253
254 if {[string compare $path [file dirname $fileName]] != 0} {
255  set Info(path) [file dirname $fileName]
256 }
257
258 openTranscriptionFile $w $pane $fileName labelfile
259 $w _redrawPane $pane
260}
261
262proc trans::getOpenTextLabelFile {w pane} {
263 variable Info
264 upvar [namespace current]::${pane}::var v
265
266 if {$v(changed)} {
267  if {[string match no [tk_messageBox -message "You have unsaved changes.\nDo you really want to continue?" -type yesno -icon question]]} {
268   return
269  }
270 }
271 set file [file tail $v(fileName)]
272 if {$Info(path) != ""} {
273  set path $Info(path)
274 } else {
275  if {$v(labdir) == ""} {
276   set path [file dirname $v(fileName)]
277  } else {
278   set path [file normalize [file dirname $v(fileName)]]
279   set pathlist [file split $path]
280   set path [eval file join [lreplace $pathlist end end $v(labdir)]]
281  }
282 }
283 set fileName [tk_getOpenFile -title "Load Text Labels" -initialfile $file \
284   -initialdir $path -defaultextension $v(labext)]
285 if {$fileName == ""} return
286
287 if {[string compare $path [file dirname $fileName]] != 0} {
288  set Info(path) [file dirname $fileName]
289 }
290
291 set f [open $fileName]
292 fconfigure $f -encoding utf-8
293 set labels [split [read -nonewline $f]]
294 close $f
295
296
297 set start [expr 0.5 * [$pane cget -maxtime]]
298 set delta [expr 0.5 * [$pane cget -maxtime] / [llength $labels]]
299 set i 0
300 set v(t1,start) 0.0
301 foreach label $labels {
302  set v(t1,$i,end)   [expr {$start + $i * $delta}]
303  set v(t1,$i,label) $label
304  set v(t1,$i,rest)  ""
305  lappend map $i
306  incr i
307 }
308 set v(t1,end)  [$pane cget -maxtime]
309 set v(nLabels) $i
310 set v(map)     $map
311 set v(header)  ""
312 set v(headerFmt) WaveSurfer
313
314 $w _redrawPane $pane
315}
316
317proc trans::saveTranscriptionFiles {w pane} {
318 foreach pane [$w _getPanes] {
319  upvar [namespace current]::${pane}::var v
320  if {$v(drawTranscription) && $v(changed)} {
321   saveTranscriptionFile $w $pane
322  }
323 }
324}
325
326proc trans::getSaveTranscriptionFile {w pane} {
327 upvar [namespace current]::${pane}::var v
328
329 set file [file tail $v(fileName)]
330 if {$v(labdir) == ""} {
331  set path [file dirname $v(fileName)]
332 } else {
333  set path [file normalize [file dirname $v(fileName)]]
334  set pathlist [file split $path]
335  set path [eval file join [lreplace $pathlist end end $v(labdir)]]
336 }
337
338 set fileName [tk_getSaveFile -title "Save Transcription" -initialfile $file \
339   -initialdir $path -defaultextension $v(labext)]
340 if {$fileName == ""} return
341
342 set v(fileName) $fileName
343 set v(labext) [file extension $fileName]
344
345 saveTranscriptionFile $w $pane
346}
347
348proc trans::addTranscription {w pane args} {
349 variable Info
350 upvar [namespace current]::${pane}::var v
351 
352 array set a [list \
353   -alignment e \
354   -labelcolor black \
355   -boundarycolor black \
356   -backgroundcolor white \
357   -extension ".lab" \
358   -font {Courier 8} \
359   -format WaveSurfer \
360   -labeldirectory "" \
361   -fileencoding "" \
362   -adjustleftevent Control-l \
363   -adjustrightevent Control-r \
364   -playlabelevent Control-space \
365   -labelmenu {2 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8} \
366   -locked 0 \
367   -quickenter 1 \
368   -quickentertolerance 20 \
369   -extendboundaries 0 \
370   -linkboundaries 0 \
371   -playhighlight 0 \
372   ]
373 if {[string match macintosh $::tcl_platform(platform)]} {
374  set a(-labelmenuevent) Shift-ButtonPress-1
375 } else {
376  set a(-labelmenuevent) Shift-ButtonPress-3
377 }
378 if {[string match Darwin $::tcl_platform(os)]} {
379  set a(-labelmenuevent) Shift-ButtonPress-1
380  set a(-labelmenu) {1 6 lab1 lab2 lab3 lab4 lab5 lab6}
381 }
382 if {[string match unix $::tcl_platform(platform)] } {
383  set a(-font) {Courier 10}
384 }
385 array set a $args
386
387 set v(alignment)         $a(-alignment)
388 set v(labColor)          $a(-labelcolor)
389 set v(bdColor)           $a(-boundarycolor)
390 set v(bgColor)           $a(-backgroundcolor)
391 set v(labext)            .[string trim $a(-extension) .]
392 set v(font)              $a(-font)
393 set v(format)            $a(-format)
394 set v(labdir)            $a(-labeldirectory)
395 set v(encoding)          $a(-fileencoding)
396 set v(menuNcols)         [lindex $a(-labelmenu) 0]
397 set v(menuNrows)         [lindex $a(-labelmenu) 1]
398 set v(labelMenuEvent)    $a(-labelmenuevent)
399 set v(adjustLeftEvent)   $a(-adjustleftevent)
400 set v(adjustRightEvent)  $a(-adjustrightevent)
401 set v(playLabelEvent)    $a(-playlabelevent)
402 set v(locked)            $a(-locked)
403 set v(quickenter)        $a(-quickenter)
404 set v(quicktol)          $a(-quickentertolerance)
405 set v(extBounds)         $a(-extendboundaries)
406 set v(linkBounds)        $a(-linkboundaries)
407 set v(highlight)         $a(-playhighlight)
408 set v(changed)           0
409 set v(t1,start)          0.0
410 set v(t1,end)            0.0
411 set v(nLabels)           0
412 set v(fileName)          ""
413 set v(lastPos)           0
414 set v(map)               {}
415 set v(lastmoved)         -1
416 set v(drawTranscription) 1
417 set v(headerFmt) WaveSurfer
418 set v(header) ""
419 list {
420  set v(lastTag) ""
421  set v(hidden) ""
422 } 
423 event add <<LabelMenuEvent>>   <$v(labelMenuEvent)>
424 event add <<AdjustLeftEvent>>  <$v(adjustLeftEvent)>
425 event add <<AdjustRightEvent>> <$v(adjustRightEvent)>
426 event add <<PlayLabelEvent>>   <$v(playLabelEvent)>
427
428 for {set i 0} {$i < $v(menuNrows)} {incr i } {
429  for {set j 0} {$j < $v(menuNcols)} {incr j } {
430   set v($i$j) [lindex $a(-labelmenu) \
431     [expr {2 + $v(menuNcols) * $i + $j}]]
432  }
433 }
434
435 set c [$pane canvas]
436list {
437 foreach tag {text bg bound} {
438  util::canvasbind $c $tag <<LabelMenuEvent>> \
439    [namespace code [list labelsMenu $w $pane %X %Y %x %y]]
440 }
441}
442 util::canvasbind $c bound <B1-Motion> \
443   [namespace code [list MoveBoundary $w $pane %x]]
444 util::canvasbind $c bound <ButtonPress-1> ""
445
446 bind $c <ButtonPress-2> \
447     [namespace code [list handleEvents PlayLabel %x %y]]
448
449 $c bind bound <Enter> [list $c configure \
450   -cursor sb_h_double_arrow]
451 $c bind bound <Leave> [list $c configure -cursor {}]
452 $c bind text  <Enter> [list $c configure -cursor xterm]
453 $c bind text  <Leave> [list $c configure -cursor {}]
454
455 util::canvasbind $c text <B1-Motion> [namespace code \
456   [list textB1Move $w $pane %W %x %y]]
457 util::canvasbind $c text <ButtonRelease-1> ""
458 util::canvasbind $c text <ButtonPress-1> [namespace code \
459   [list textClick $w $pane %W %x %y]]
460
461 util::canvasbind $c bg <ButtonPress-1> [namespace code \
462   [list boxClick $w $pane %W %x %y]]
463 bind $c <Any-Key>   [namespace code [list handleAnyKey $w $pane %W %x %y %A]]
464 bind $c <BackSpace> [namespace code [list handleBackspace $w $pane %W]]
465 bind $c <Return> {
466  %W insert current insert ""
467  %W focus {}
468 }
469
470 bind $c <Enter> [namespace code [list handleEnterLeave $w $pane 1]]
471 bind $c <Leave> [namespace code [list handleEnterLeave $w $pane 0]]
472
473 bind [winfo toplevel $c] <<AdjustRightEvent>> \
474   [namespace code [list handleEvents AdjustLabel %x %y right]]
475 bind [winfo toplevel $c] <<AdjustLeftEvent>> \
476   [namespace code [list handleEvents AdjustLabel %x %y left]]
477
478 util::canvasbind $c text <<AdjustRightEvent>> ""
479 util::canvasbind $c text <<AdjustLeftEvent>> ""
480
481 bind $c <<PlayLabelEvent>> \
482   [namespace code [list handleEvents PlayLabel %x %y]]
483 bind [winfo toplevel $c] <<PlayLabelEvent>> \
484   [namespace code [list handleEvents PlayLabel %x %y]]
485
486 bind $c <<Delete>> "[namespace code [list handleDelete $w $pane %W]];break"
487 bind $c <space> "[namespace code [list handleSpace $w $pane %W]];break"
488 bind $c <Shift-Control-space> "[namespace code [list FindNextLabel $w $pane]];break"
489 $c bind text <Key-Right> [namespace code [list handleKeyRight $w $pane %W]]
490 $c bind text <Key-Left>  [namespace code [list handleKeyLeft $w $pane %W]]
491 
492 if {[$w getInfo fileName] != ""} {
493  openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
494#  redraw $w $pane
495 }
496 
497 if {$::tcl_version > 8.2} {
498  if $v(locked) {
499   $c configure -state disabled
500  } else {
501   $c configure -state normal
502  }
503 }
504 # If the label file is longer than any current displayed pane, update them all
505 if {[info exists v(t1,end)]} {
506  if {$v(t1,end) > [$pane cget -maxtime]} {
507   $w _redraw
508  }
509 }
510}
511
512proc trans::handleEvents {proc args} {
513 if {![info exists ::trpane]} {
514  return
515 }
516 if {[namespace which -variable \
517          [namespace current]::${::trpane}::var] == ""} return
518 upvar [namespace current]::${::trpane}::var v
519
520 if {[info exists v(cursorInPane)]} {
521  if {$v(cursorInPane)} {
522   eval $proc $::trw $::trpane $args
523  }
524 }
525}
526
527proc trans::handleEnterLeave {w pane arg} {
528 upvar [namespace current]::${pane}::var v
529
530 set v(cursorInPane) $arg
531}
532
533proc trans::activateInput {w pane state} {
534 variable Info
535 upvar [namespace current]::${pane}::var v
536
537 if {[info exists Info($w,active)]} {
538  if {$state == 1} {
539   set Info($w,active) $pane
540   [$pane yaxis] configure -relief solid
541   [$pane canvas] configure -relief solid
542   if {$v(extBounds)} {
543    drawExtendedBoundaries $w $pane
544   }
545  }
546  foreach p [$w _getPanes] {
547   if {$state == 0 || [string compare $p $pane]} {
548    if {[info exists v(drawTranscription)]} {
549     if {$v(drawTranscription)} {
550      [$p yaxis] configure -relief flat
551      [$p canvas] configure -relief flat
552     }
553    }
554   }
555  }
556 }
557}
558
559proc trans::state {w state} {
560 variable Info
561
562 if {[info exists Info($w,active)]} {
563  if {$Info($w,active) != ""} {
564   activateInput $w $Info($w,active) $state
565   set c [$Info($w,active) canvas]
566   if {$state} {
567    boxClick $w $Info($w,active) $c 0 0
568   }
569  }
570 }
571}
572
573proc trans::labelsMenu {w pane X Y x y} {
574 upvar [namespace current]::${pane}::var v
575 set m $w.popup
576 if {[winfo exists $m]} {destroy $m}
577 menu $m -tearoff 0
578 $m add command -label "Play Label" \
579   -command [namespace code [list PlayLabel $w $pane $x $y]]
580 $m add command -label "Insert Label" \
581   -command [namespace code [list InsertLabel $w $pane $x $y]]
582 $m add command -label "Select Label" \
583   -command [namespace code [list SelectLabel $w $pane $x $y]]
584 $m add command -label "Align Label" \
585   -command [namespace code [list AlignLabel $w $pane $x $y]]
586 $m add command -label "Browse..." \
587   -command [namespace code [list browse $w $pane]]
588 $m add command -label "Convert..." \
589   -command [namespace code [list convert $w $pane]]
590 $m add separator
591 $m add command -label "Delete Label" \
592   -command [namespace code [list DeleteLabel $w $pane $x $y]]
593
594 for {set j 0} {$j < $v(menuNcols)} {incr j } {
595  for {set i 0} {$i < $v(menuNrows)} {incr i } {
596   if {$i==0} {set cb 1} else {set cb 0}
597   $m add command -label [subst $v($i$j)] -columnbreak $cb \
598    -command [namespace code [list InsertLabel $w $pane $x $y \
599                               [subst $v($i$j)]]] \
600     -font $v(font)
601  }
602 }
603
604 if {[string match macintosh $::tcl_platform(platform)]} {
605  tk_popup $w.popup $X $Y 0
606 } else {
607  tk_popup $w.popup $X $Y
608 }
609}
610
611proc trans::textClick {w pane W x y} {
612 upvar [namespace current]::${pane}::var v
613 set ::trpane $pane
614 set ::trw $w
615 set c [$pane canvas]
616 focus $W
617 $W focus current
618 $W icursor current @[$W canvasx $x],[$W canvasy $y]
619 $W select clear
620 $W select from current @[$W canvasx $x],[$W canvasy $y]
621 set tagno [lindex [$c gettags current] 0]
622 activateInput $w $pane 1
623
624 set i [lsearch -exact $v(map) $tagno]
625 if {$i == -1} return
626 set start [GetStartByIndex $w $pane $i]
627 set end $v(t1,$tagno,end)
628 set len [expr $end - $start]
629 $w messageProc \
630    "$v(t1,$tagno,label) ($tagno) start: $start end: $end length: $len"
631}
632
633proc trans::textB1Move {w pane W x y} {
634 # clear widget selection before selecting any text
635 foreach {start end} [$w cget -selection] break
636 $w configure -selection [list $start $start]
637
638 $W select to current @[$W canvasx $x],[$W canvasy $y]
639}
640
641proc trans::boxClick {w pane W x y} {
642 upvar [namespace current]::${pane}::var v
643 set ::trpane $pane
644 set ::trw $w
645 set c [$pane canvas]
646 focus $W
647 $W focus hidden
648 set cx [$c canvasx $x]
649 set t [$pane getTime $cx]
650 $w configure -selection [list $t $t]
651 activateInput $w $pane 1
652 set v(clicked) 1
653}
654
655proc trans::handleAnyKey {w pane W x y A} {
656 upvar [namespace current]::${pane}::var v
657 if {[string length $A] == 0} return
658 if {[string is print $A] == 0} return
659 set c [$pane canvas]
660 if {[$W focus] != $v(hidden)} {
661  set tag [$W focus]
662  catch {$W dchars $tag sel.first sel.last}
663  $W insert $tag insert $A
664  SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
665    [$c itemcget $tag -text]
666 } else {
667  if {$v(quickenter) == 0} return
668  set dx [expr {abs($v(lastPos) - $x)}]
669  if {$v(quicktol) > $dx && $v(clicked) == 0} {
670   set tagno $v(lastTag)
671   append v(t1,$tagno,label) $A
672   $c itemconf lab$v(lastTag) -text $v(t1,$tagno,label)
673  } else {
674   set v(lastTag) [InsertLabel $w $pane $x $y $A]
675   if {$v(lastTag) == ""} return
676   set v(lastPos) $x
677   set v(clicked) 0
678  }
679 }
680 changed $w $pane
681}
682
683proc trans::handleDelete {w pane W} {
684 set c [$pane canvas]
685 if {[$W focus] != {}} {
686  set tag [$W focus]
687  if {![catch {$W dchars $tag sel.first sel.last}]} {
688   return
689  }
690  $W dchars $tag insert
691  SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
692      [$c itemcget $tag -text]
693  changed $w $pane
694 }
695}
696
697proc trans::handleBackspace {w pane W} {
698 set c [$pane canvas]
699 if {[$W focus] != {}} {
700  set tag [$W focus]
701  if {![catch {$W dchars $tag sel.first sel.last}]} {
702   return
703  }
704  set ind [expr {[$W index $tag insert]-1}]
705  if {$ind >= 0} {
706   $W icursor $tag $ind
707   $W dchars $tag insert
708   SetLabelText $w $pane [lindex [$c gettags $tag] 0] \
709     [$c itemcget $tag -text]
710   changed $w $pane
711  }
712 }
713}
714
715proc trans::handleSpace {w pane W} {
716 set c [$pane canvas]
717 if {[$W focus] != {}} {
718  $W select clear
719  $W insert [$W focus] insert _
720  SetLabelText $w $pane [lindex [$c gettags [$W focus]] 0] \
721    [$c itemcget [$W focus] -text]
722 }
723}
724
725proc trans::handleKeyRight {w pane W} {
726 upvar [namespace current]::${pane}::var v
727 set c [$pane canvas]
728 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
729 if {[$W focus] != {}} {
730  $W select clear
731  set __index [$W index [$W focus] insert]
732  $W icursor [$W focus] [expr {$__index + 1}]
733  if {$__index == [$W index [$W focus] insert]} {
734   set ti [lindex [$c gettags [$W focus]] 0]
735   set i [lsearch -exact $v(map) $ti]
736   set __focus [lindex $v(map) [expr {$i+1}]]
737   $W focus lab$__focus
738   $W icursor lab$__focus 0
739   while {$width * [lindex [$c xview] 1]-10 < \
740     [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 1] < 1} {
741    $w xscroll scroll 1 unit
742   }
743  }
744 }
745}
746
747proc trans::handleKeyLeft {w pane W} {
748 upvar [namespace current]::${pane}::var v
749 set c [$pane canvas]
750 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
751 if {[$W focus] != {}} {
752  $W select clear
753  set __index [$W index [$W focus] insert]
754  $W icursor [$W focus] [expr {[$W index [$W focus] insert] - 1}]
755  if {$__index == [$W index [$W focus] insert]} {
756   set ti [lindex [$c gettags [$W focus]] 0]
757   set i [lsearch -exact $v(map) $ti]
758   set __focus [lindex $v(map) [expr {$i-1}]]
759   $W focus lab$__focus
760   $W icursor lab$__focus end
761   while {$width * [lindex [$c xview] 0] +10 > \
762     [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 0] > 0} {
763    $w xscroll scroll -1 unit
764   }
765  }
766 }
767}
768
769proc trans::openFile {w soundFileName} {
770 variable Info
771 
772 foreach pane [$w _getPanes] {
773  upvar [namespace current]::${pane}::var v
774  if {$v(drawTranscription)} {
775   openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
776  }
777 }
778 return 0
779}
780
781proc trans::saveFile {w soundFileName} {
782 foreach pane [$w _getPanes] {
783  upvar [namespace current]::${pane}::var v
784  if {$v(drawTranscription) && $v(changed)} {
785   saveTranscriptionFile $w $pane
786  }
787 }
788 return 0
789}
790
791proc trans::openTranscriptionFile {w pane fn type} {
792 variable Info
793 upvar [namespace current]::${pane}::var v
794 
795 if {[info exists v(drawTranscription)]} {
796  if {$v(drawTranscription) == 0} return
797 }
798 set fileName ""
799 if {[string match soundfile $type]} {
800  set path [file normalize [file dirname $fn]]
801  set pathlist [file split $path]
802  set rootname [file tail [file rootname $fn]]
803  set name $rootname.[string trim $v(labext) .]
804 
805  # Try to locate the corresponding label file
806
807  if {$v(labdir) != ""} {
808   # Try the following directories in order
809   # 1. try to locate file in specified label file directory
810   # 2. try 'sound file path'/../'specified dir'
811   # 3. look in current directory
812   # 4. look in same directory as sound file
813   
814   if {[file readable [file join $v(labdir) $name]]} {
815    set fileName [file join $v(labdir) $name]
816   } elseif {[file readable [eval file join [lreplace $pathlist end end $v(labdir)] $name]]} {
817    set fileName [eval file join [lreplace $pathlist end end $v(labdir)] $name]
818   }
819  }
820  if {$fileName == ""} {
821   if {[file readable $name]} {
822    set fileName $name
823   } elseif {[file readable [file join $path $name]]} {
824    set fileName [file join $path $name]
825   } else {
826    set fileName $name
827   }
828  }
829 } else {
830  set fileName $fn
831 }
832 
833 # This filename should be correct, remember it
834 
835 set v(fileName) $fileName
836 set v(nLabels) 0
837 set v(map)     {}
838 set v(labext) [file extension $fileName]
839
840 foreach {format loadProc saveProc} $Info(formats) {
841  if {[string compare $format $v(format)] == 0} {
842   set res [[namespace parent]::$loadProc $w $pane]
843   if {$res != ""} {
844    $w messageProc $res
845    set v(changed) 0
846    return
847   }
848  }
849 }
850}
851
852proc trans::saveTranscriptionFile {w pane} {
853 variable Info
854 upvar [namespace current]::${pane}::var v
855
856 set fn $v(fileName)
857 set strip_fn [file tail [file rootname $fn]]
858 if {$strip_fn == ""} {
859  set strip_fn [file tail [file rootname [$w getInfo fileName]]]
860 }
861 set path [file dirname $fn]
862 set v(fileName) [file join $path $strip_fn.[string trim $v(labext) .]]
863 set fn $v(fileName)
864 catch {file copy $fn $fn~}
865
866 foreach {format loadProc saveProc} $Info(formats) {
867  if {[string compare $format $v(format)] == 0} {
868   set res [[namespace parent]::$saveProc $w $pane]
869   if {$res != ""} {
870    $w messageProc $res
871    return
872   }
873  }
874 }
875 set v(changed) 0
876
877 return 0
878}
879
880proc trans::needSave {w pane} {
881 upvar [namespace current]::${pane}::var v
882
883 if {[info exists v(drawTranscription)]} {
884  if {$v(drawTranscription)} {
885   if {$v(changed)} {
886    return 1
887   }
888  }
889 }
890 return 0
891}
892
893proc trans::redraw {w pane} {
894 upvar [namespace current]::${pane}::var v
895 
896 if {!$v(drawTranscription)} return
897
898 set c [$pane canvas]
899 $c delete tran
900 foreach otherpane [$w _getPanes] {
901  upvar wsurf::analysis::${otherpane}::var ov
902  upvar wsurf::dataplot::${otherpane}::var dv
903  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
904   set othercanvas [$otherpane canvas]
905   $othercanvas delete tran$pane
906  }
907 }
908 _redraw $w $pane $c 0 0
909 #  boxClick $w $pane $c 0 0
910}
911
912proc trans::_redraw {w pane c x y} {
913 upvar [namespace current]::${pane}::var v
914
915 set progressproc [$w cget -progressproc]
916 if {$progressproc != "" && $v(nLabels) > 0} {
917#  $progressproc "Creating labels" 0.0
918 }
919 set height [$pane cget -height]
920 set v(height) $height
921 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
922 set ascent [font metrics $v(font) -ascent]
923 set v(ascent) $ascent
924 $c configure -bg $v(bgColor)
925
926 [$pane yaxis] delete ext
927 set vc [$pane yaxis]
928 set yw [winfo width $vc]
929 if {$::tcl_version > 8.2 && [string match disabled [$c cget -state]]} {
930  [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \
931    -text L:$v(labext) \
932    -font $v(font) -tags ext \
933    -fill $v(labColor)
934 } else {
935  [$pane yaxis] create text [expr {$yw/2}] [expr {$height/2}] \
936    -text $v(labext) \
937    -font $v(font) -tags ext \
938    -fill $v(labColor)
939 }
940 if {$v(nLabels) == 0} {
941  set slen [[$w cget -sound] length -unit seconds]
942  set endx [$pane getCanvasX $slen]
943  $c create rectangle [expr {$x+0}] $y \
944    [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \
945    -tags [list gEnd obj bg tran] -fill $v(bgColor)
946  set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \
947    -text "" -tags [list hidden tran]]
948  return 0
949 } else {
950  set start 0
951  set end   0
952  set label ""
953
954  for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} {
955   set ind [lindex $v(map) $i]
956   if {$i == 0} {
957    set start $v(t1,start)
958   } else {
959    set ind2 [lindex $v(map) [expr {$i - 1}]]
960    set start $v(t1,$ind2,end)
961   }
962   set end $v(t1,$ind,end)
963   set label $v(t1,$ind,label)
964   set lx [$pane getCanvasX $start]
965   set rx [$pane getCanvasX $end]
966
967   if {$lx >= 0 && $lx <= $width} {
968    #DrawLabel $w $pane $c $ind $i $x $y $lx $rx $label
969    set tx [ComputeTextPosition $w $pane $lx $rx]
970    $c create rectangle [expr {$x+$lx}] $y \
971      [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \
972      -tags [list g$ind obj bg tran] -fill $v(bgColor)
973    $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\
974      -font $v(font) -anchor $v(alignment)\
975      -tags [list $ind obj text lab$ind tran] \
976      -fill $v(labColor)
977    $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \
978      -tags [list b$ind obj bound tran topmost] -fill $v(bdColor)
979   }
980   if {$progressproc != "" && $i % 100 == 99} {
981#    $progressproc "Creating labels" [expr double($v(nLabels)-$i)/$v(nLabels)]
982   }
983  }
984  set start $v(t1,start)
985  set sx [$pane getCanvasX $start]
986  $c create rectangle [expr {$x+0}] $y \
987    [expr {$x+$sx}] [expr {$y+$height-4}] -outline "" \
988    -tags [list gStart obj bg tran] -fill $v(bgColor)
989  $c create line [expr {$x+$sx}] $y [expr {$x+$sx}] [expr {$y+$height}] \
990    -tags [list bStart obj bound tran topmost] -fill $v(bdColor)
991 
992  set slen [[$w cget -sound] length -unit seconds]
993  set endx [$pane getCanvasX $slen]
994  $c create rectangle [expr {$x+$rx}] $y \
995    [expr {$x+$endx}] [expr {$y+$height-4}] -outline "" \
996    -tags [list gEnd obj bg tran] -fill $v(bgColor)
997  set prev [lindex $v(map) end]
998  $c lower gEnd g$prev
999 }
1000 set v(hidden) [$c create text [expr {$x-100}] [expr {$y+10}] \
1001   -text "" -tags [list hidden tran]]
1002
1003 if {$v(extBounds)} {
1004  drawExtendedBoundaries $w $pane
1005 }
1006
1007 if {$progressproc != ""} {
1008#  $progressproc "Creating labels" 1.0
1009 }
1010
1011 return $height
1012}
1013
1014proc trans::drawExtendedBoundaries {w pane} {
1015 upvar [namespace current]::${pane}::var v
1016
1017 foreach otherpane [$w _getPanes] {
1018  upvar wsurf::analysis::${otherpane}::var ov
1019  upvar wsurf::dataplot::${otherpane}::var dv
1020  if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
1021   set othercanvas [$otherpane canvas]
1022   $othercanvas delete tran$pane
1023  }
1024 }
1025
1026 set height [$pane cget -height]
1027 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
1028
1029 if {$v(nLabels) > 0} {
1030  set start 0
1031  set end   0
1032  set label ""
1033
1034  for {set i [expr $v(nLabels)-1]} {$i >= 0} {incr i -1} {
1035   set ind [lindex $v(map) $i]
1036   if {$i == 0} {
1037    set start $v(t1,start)
1038   } else {
1039    set ind2 [lindex $v(map) [expr {$i - 1}]]
1040    set start $v(t1,$ind2,end)
1041   }
1042   set end $v(t1,$ind,end)
1043   set label $v(t1,$ind,label)
1044   set lx [$pane getCanvasX $start]
1045   set rx [$pane getCanvasX $end]
1046
1047   if {$lx >= 0 && $lx <= $width} {
1048    foreach otherpane [$w _getPanes] {
1049     upvar wsurf::analysis::${otherpane}::var av
1050     upvar wsurf::dataplot::${otherpane}::var dv
1051     if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
1052      set othercanvas [$otherpane canvas]
1053      set height [$otherpane cget -height]
1054      $othercanvas create line $rx 0 $rx \
1055        $height -tags [list b$ind$pane obj bound tran$pane] \
1056          -fill $v(bdColor)
1057     }
1058    }
1059   }
1060  }
1061 }
1062}
1063
1064proc trans::DrawLabel {w pane c tagno i x y lx rx label} {
1065 upvar [namespace current]::${pane}::var v
1066 #  set ascent [font metrics $v(font) -ascent]
1067 #  set height [$pane cget -height]
1068 set ascent $v(ascent)
1069 set height $v(height)
1070
1071 set tx [ComputeTextPosition $w $pane $lx $rx]
1072 $c create rectangle [expr {$x+$lx}] $y \
1073   [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \
1074   -tags [list g$tagno obj bg tran] -fill $v(bgColor)
1075 $c create text [expr {$x+$tx}] [expr {$y+$ascent}] -text $label\
1076   -font $v(font) -anchor $v(alignment)\
1077   -tags [list $tagno obj text lab$tagno tran] \
1078   -fill $v(labColor)
1079 $c create line [expr {$x+$rx}] $y [expr {$x+$rx}] [expr {$y+$height}] \
1080   -tags [list b$tagno obj bound tran topmost] -fill $v(bdColor)
1081 
1082 if {$i > 0} {
1083  set prev [lindex $v(map) [expr {$i-1}]]
1084  $c lower g$tagno   g$prev
1085  $c lower lab$tagno g$prev
1086  $c lower b$tagno   g$prev
1087 } else {
1088  $c lower g$tagno   gStart
1089  $c lower lab$tagno gStart
1090  $c lower b$tagno   gStart
1091 }
1092
1093 if {$v(extBounds)} {
1094  foreach otherpane [$w _getPanes] {
1095   upvar wsurf::analysis::${otherpane}::var av
1096   upvar wsurf::dataplot::${otherpane}::var dv
1097   if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
1098    set othercanvas [$otherpane canvas]
1099    set height [$otherpane cget -height]
1100    $othercanvas create line $rx 0 $rx \
1101     $height -tags [list b$tagno obj bound tran$pane] -fill $v(bdColor)
1102   }
1103  }
1104 }
1105}
1106
1107proc trans::isLabel {tags} {
1108 expr [string compare [lindex $tags 2] bg] == 0 || \
1109   [string compare [lindex $tags 2] text] == 0
1110}
1111
1112proc trans::GetStartByIndex {w pane i} {
1113 upvar [namespace current]::${pane}::var v
1114 if {$i <= 0 || $i == "Start"} {
1115  return $v(t1,start)
1116 } else {
1117  set ind [lindex $v(map) [expr $i-1]]
1118  return $v(t1,$ind,end)
1119 }
1120}
1121
1122proc trans::PlaceLabel {w pane tagno coords start end} {
1123 upvar [namespace current]::${pane}::var v
1124 set c [$pane canvas]
1125 if {$tagno != "Start"} {
1126  # Place background and boundary
1127  $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3]
1128  $c coords g$tagno $start [lindex $coords 1] $end [expr [lindex $coords 3]-4]
1129 
1130  # Place label text
1131  set tx [ComputeTextPosition $w $pane $start $end]
1132  $c coords lab$tagno $tx [lindex [$c coords lab$tagno] 1]
1133 } else {
1134  $c coords b$tagno $end [lindex $coords 1] $end [lindex $coords 3]
1135  $c coords g$tagno 0 [lindex $coords 1] $end [expr [lindex $coords 3]-4]
1136 }
1137
1138 if {$v(extBounds)} {
1139  foreach otherpane [$w _getPanes] {
1140   upvar wsurf::analysis::${otherpane}::var av
1141   upvar wsurf::dataplot::${otherpane}::var dv
1142   if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
1143    set othercanvas [$otherpane canvas]
1144    set height [$otherpane cget -height]
1145    $othercanvas coords b$tagno$pane $end 0 $end $height
1146   }
1147  }
1148 }
1149}
1150
1151proc trans::getBounds {w pane} {
1152 upvar [namespace current]::${pane}::var v
1153
1154 if {$v(drawTranscription)} {
1155  list 0 0 $v(t1,end) 0
1156 } else {
1157  list
1158 }
1159}
1160
1161proc trans::MoveBoundary {w pane x} {
1162 upvar [namespace current]::${pane}::var v
1163 
1164 set c [$pane canvas]
1165 set s [$w cget -sound]
1166 set coords [$c coords current]
1167 set xc [$c canvasx $x]
1168 if {$xc < 0} { set xc 0 }
1169 set tagno [string trim [lindex [$c gettags current] 0] b]
1170 set i [lsearch -exact $v(map) $tagno]
1171 
1172 # Logic which prevents a boundary to be moved past its neighbor
1173 set h [lindex $v(map) [expr {$i-1}]]
1174 set j [lindex $v(map) [expr {$i+1}]]
1175 set px 0
1176 set nx [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
1177 set pb [$c find withtag b$h]
1178 set nb [$c find withtag b$j]
1179 if {$pb != ""} { set px [lindex [$c coords $pb] 0]}
1180 if {$nb != ""} { set nx [lindex [$c coords $nb] 0]}
1181 if {$xc <= $px} { set xc [expr {$px + 1}] }
1182 if {$nx <= $xc} { set xc [expr {$nx - 1}] }
1183 
1184 set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
1185
1186 # Update time
1187 if {$i == -1} {
1188  set v(t1,start) [$pane getTime $xc]
1189 } else {
1190  set this [lindex $v(map) $i]
1191  set oldTime $v(t1,$this,end)
1192  set v(t1,$this,end) [$pane getTime $xc]
1193 }
1194
1195 # Place this label
1196 PlaceLabel $w $pane $tagno $coords $start $xc
1197
1198 # Place next label
1199 PlaceNextLabel $w $pane $i $xc
1200
1201 if {$v(linkBounds)} {
1202  foreach otherpane [$w _getPanes] {
1203   upvar [namespace current]::${otherpane}::var ov
1204   if {$otherpane != $pane && $ov(drawTranscription) && \
1205           [info exists oldTime]} {
1206    foreach tag $ov(map) {
1207     if {$ov(t1,$tag,end) == $oldTime} {
1208      set ov(t1,$tag,end) [$pane getTime $xc]
1209      PlaceLabel $w $otherpane $tag $coords $start $xc
1210      break
1211     }
1212    }
1213   }
1214  }
1215 }
1216
1217 if {$v(lastmoved) != $i} {
1218  changed $w $pane
1219  if {$tagno == "Start"} {
1220   #   wsurf::PrepareUndo "set [namespace current]::var(t1,start) \[list $v(t1,start)\]" ""
1221  } else {
1222   #   wsurf::PrepareUndo "set [namespace current]::var(t1,$tagno,end) \[list $v(t1,$tagno,end)\]" ""
1223  }
1224  set v(lastmoved) $i
1225 }
1226 vtcanvas::motionEvent $pane $x 0
1227}
1228
1229proc trans::SetLabelText {w pane tagno label} {
1230 upvar [namespace current]::${pane}::var v
1231
1232 $w messageProc [format "Transcription - %s" $label]
1233 set v(t1,$tagno,label) $label
1234}
1235
1236proc trans::InsertLabel {w pane x y {label ""}} {
1237 upvar [namespace current]::${pane}::var v
1238 
1239 set s [$w cget -sound]
1240 set c [$pane canvas]
1241 set cx [$c canvasx $x]
1242 set t [$pane getTime $cx]
1243 
1244 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
1245 if {[isLabel $tags]} {
1246  set tagno [string trim [lindex $tags 0] g]
1247  if {$tagno == "End"} {
1248   #      set i $v(nLabels)
1249   set i 0
1250   foreach ind $v(map) {
1251    if {$t < $v(t1,$ind,end)} break
1252    incr i
1253   }
1254  } else {
1255   set i [lsearch -exact $v(map) $tagno]
1256  }
1257 } else {
1258  set i 0
1259  foreach ind $v(map) {
1260   if {$t < $v(t1,$ind,end)} break
1261   incr i
1262  }
1263 }
1264
1265 # Create label with a randomly chosen tag number
1266 set n [clock clicks]
1267 set v(t1,$n,end) $t
1268 set v(t1,$n,label) $label
1269 set v(t1,$n,rest)  ""
1270 set v(map) [linsert $v(map) $i $n]
1271 incr v(nLabels)
1272
1273 # Update start time if new label was inserted first
1274 if {$i < 0} {
1275  set v(t1,start) 0
1276  set co [$c coords bStart]
1277  $c coords bStart 0 [lindex $co 1] 0 [lindex $co 3]
1278  set co [$c coords gStart]
1279  $c coords gStart 0 [lindex $co 1] 0 [lindex $co 3]
1280  set start 0
1281 } else {
1282  set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
1283 }
1284
1285 # Draw inserted label
1286 DrawLabel $w $pane $c $n $i 0 0 $start $cx $label
1287
1288 # Place next label
1289 if {$i < 0} { incr i }
1290 PlaceNextLabel $w $pane $i $cx
1291
1292 # Display cursor if label is empty
1293 if {$label==""} {
1294  focus [$pane canvas]
1295  [$pane canvas] focus lab$n
1296  [$pane canvas] icursor lab$n @[$c canvasx $x],[$c canvasy $y]
1297 }
1298
1299 changed $w $pane
1300 return $n
1301}
1302
1303proc trans::DeleteLabel {w pane x y} {
1304 upvar [namespace current]::${pane}::var v
1305 set c [$pane canvas]
1306 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
1307
1308 if {[isLabel $tags] || [string compare [lindex $tags 2] bound] == 0} {
1309  set tagno [string trim [lindex $tags 0] gb]
1310  set i [lsearch -exact $v(map) $tagno]
1311  if {$i == -1} return
1312
1313  # Delete everything related to this label
1314  unset v(t1,$tagno,label)
1315  unset v(t1,$tagno,end)
1316  unset v(t1,$tagno,rest)
1317  set v(map) [lreplace $v(map) $i $i]
1318  incr v(nLabels) -1
1319  $c delete b$tagno lab$tagno g$tagno
1320  if {$v(extBounds)} {
1321   foreach otherpane [$w _getPanes] {
1322    upvar wsurf::analysis::${otherpane}::var av
1323    upvar wsurf::dataplot::${otherpane}::var dv
1324    if {$av(drawWaveform) || $av(drawSpectrogram) || $dv(drawDataPlot)} {
1325     set othercanvas [$otherpane canvas]
1326     $othercanvas delete b$tagno$pane
1327    }
1328   }
1329  }
1330
1331  # Place previous label box
1332  set prev [lindex $v(map) [expr {$i-1}]]
1333  if {$prev != ""} {
1334   set end [lindex [$c coords g$prev] 2]
1335  } else {
1336   set end [$pane getCanvasX $v(t1,start)]
1337   set prev 0
1338  }
1339  set iprev [lsearch -exact $v(map) $prev]
1340  PlaceNextLabel $w $pane $iprev $end
1341
1342  changed $w $pane
1343 }
1344}
1345
1346proc trans::AdjustLabel {w pane x y boundary} {
1347 upvar [namespace current]::${pane}::var v
1348 
1349 set c [$pane canvas]
1350 set xc [$c canvasx $x]
1351 set t [$pane getTime $xc]
1352 set tags [$c gettags [$c find closest $xc [$c canvasy $y]]]
1353 
1354 if {[isLabel $tags]} {
1355  set tagno [string trim [lindex $tags 0] g]
1356  set i [lsearch -exact $v(map) $tagno]
1357 } else {
1358  set i 0
1359  foreach ind $v(map) {
1360   if {$t < $v(t1,$ind,end)} break
1361   incr i
1362  }
1363  set tagno [lsearch -exact $v(map) $i]
1364 }
1365
1366 if {$i == $v(nLabels)} return
1367 
1368 if {$tagno != "End" && [string match left $boundary]} {
1369  incr i -1
1370  set tagno [lindex $v(map) $i]
1371 }
1372 if {$tagno == "End"} return
1373 if {$tagno != ""} {
1374  set v(t1,$tagno,end) $t
1375 }
1376 
1377 if {$i < 0} {
1378  set v(t1,start) $t
1379  set co [$c coords bStart]
1380  set sx [$pane getCanvasX $t]
1381  $c coords bStart $sx [lindex $co 1] $sx [lindex $co 3]
1382  $c coords gStart 0 [lindex $co 1] $sx [lindex $co 3]
1383 }
1384 set start [$pane getCanvasX [GetStartByIndex $w $pane $i]]
1385 
1386 # Place this label
1387 set co [$c coords b$tagno]
1388 PlaceLabel $w $pane $tagno $co $start $xc
1389 
1390 # Place next label
1391 PlaceNextLabel $w $pane $i $xc
1392 
1393 changed $w $pane
1394 
1395 $w messageProc [format "Transcription - %s" [$w formatTime $t]]
1396}
1397
1398proc trans::PlayLabel {w pane x y} {
1399 upvar [namespace current]::${pane}::var v
1400 set c [$pane canvas]
1401 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
1402
1403 if {[isLabel $tags]} {
1404  set tagno [string trim [lindex $tags 0] g]
1405  set i [lsearch -exact $v(map) $tagno]
1406  if {$i == -1} return
1407 } else {
1408  set i 0
1409  set cx [$c canvasx $x]
1410  set t [$pane getTime $cx]
1411  foreach ind $v(map) {
1412   if {$t < $v(t1,$ind,end)} break
1413   incr i
1414  }
1415 }
1416 set start [GetStartByIndex $w $pane $i]
1417 set this [lindex $v(map) $i]
1418 if {$this == ""} return
1419 set end $v(t1,$this,end)
1420 
1421 $w play $start $end
1422}
1423
1424proc trans::SelectLabel {w pane x y} {
1425 upvar [namespace current]::${pane}::var v
1426 set c [$pane canvas]
1427 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
1428 
1429 if {[isLabel $tags]} {
1430  set tagno [string trim [lindex $tags 0] g]
1431  set i [lsearch -exact $v(map) $tagno]
1432  if {$i == -1} return
1433 
1434  set start [GetStartByIndex $w $pane $i]
1435  set end $v(t1,$tagno,end)
1436 
1437  $w configure -selection [list $start $end]
1438 }
1439}
1440
1441proc trans::AlignLabel {w pane x y} {
1442 upvar [namespace current]::${pane}::var v
1443 set c [$pane canvas]
1444 set tags [$c gettags [$c find closest [$c canvasx $x] [$c canvasy $y]]]
1445 
1446 if {[isLabel $tags]} {
1447  set tagno [string trim [lindex $tags 0] g]
1448  set i [lsearch -exact $v(map) $tagno]
1449  if {$i == -1} return
1450 
1451  # Get current selection
1452  foreach {start end} [$w cget -selection] break
1453  if {$start == $end} return
1454 
1455  # Validate that selection and label overlap, otherwise generate warning msg
1456
1457  set ostart [GetStartByIndex $w $pane $i]
1458  set oend $v(t1,$tagno,end)
1459 
1460  if {$start >= $oend || $end <= $ostart} {
1461   tk_messageBox -message "Label and selection must overlap!"
1462   return
1463  }
1464 
1465  # Update boundaries according to current selection
1466  if {$i == 0} {
1467   set v(t1,start) $start
1468  } else {
1469   set ind [lindex $v(map) [expr $i-1]]
1470   set v(t1,$ind,end) $start
1471  }
1472 
1473  set v(t1,$tagno,end) $end
1474 
1475  $w _redrawPane $pane
1476 }
1477}
1478
1479proc trans::FindNextLabel {w pane} {
1480 upvar [namespace current]::${pane}::var v
1481 foreach {start end} [$w cget -selection] break
1482 set i 0
1483 foreach ind $v(map) {
1484  if {$end < $v(t1,$ind,end)} break
1485  incr i
1486 }
1487 set tagno [lsearch -exact $v(map) $i]
1488 if {$tagno == -1} return
1489 set start [GetStartByIndex $w $pane $i]
1490 set end $v(t1,$tagno,end)
1491 
1492 $w configure -selection [list $start $end]
1493 set s [$w cget -sound]
1494 set length [$s length -unit seconds]
1495 $w xscroll moveto [expr {($start-1.0)/$length}]
1496 $w play $start $end
1497 set delay [expr 500 + int(1000 * ($end - $start))]
1498 after $delay [namespace code [list FindNextLabel $w $pane]]
1499}
1500
1501proc trans::ComputeTextPosition {w pane start end} {
1502 upvar [namespace current]::${pane}::var v
1503 if {$v(alignment) == "c"} {
1504  return [expr {($start+$end)/2}]
1505 } elseif {$v(alignment) == "w"} {
1506  return [expr {$start + 2}]
1507 } else {
1508  return [expr {$end - 2}]
1509 }
1510}
1511
1512proc trans::PlaceNextLabel {w pane index pos} {
1513 upvar [namespace current]::${pane}::var v
1514 set c [$pane canvas]
1515 incr index
1516 set next [lindex $v(map) $index]
1517
1518 if {$next == ""} {
1519  set next End
1520  set co [$c coords g$next]
1521  $c coords g$next $pos [lindex $co 1] [lindex $co 2] [lindex $co 3]
1522 } else {
1523  set co [$c coords b$next]
1524  $c coords g$next $pos [lindex $co 1] [lindex $co 2] [expr [lindex $co 3]-4]
1525  #    $c itemconf g$next -fill yellow
1526  set xc [ComputeTextPosition $w $pane $pos [lindex $co 2]]
1527  $c coords lab$next $xc [lindex [$c coords lab$next] 1]
1528 }
1529}
1530
1531proc trans::print {w pane c x y} {
1532 upvar [namespace current]::${pane}::var v
1533 
1534 upvar wsurf::analysis::${pane}::var ov
1535 upvar wsurf::dataplot::${pane}::var dv
1536 if {$ov(drawWaveform) || $ov(drawSpectrogram) || $dv(drawDataPlot)} {
1537  foreach otherpane [$w _getPanes] {
1538   upvar wsurf::trans::${otherpane}::var tv
1539   if {[info exists tv(extBounds)] && $tv(extBounds)} {
1540    set drawExtBounds 1
1541    break;
1542   }
1543  }
1544 }
1545 
1546 if {[info exists drawExtBounds]} {
1547  set height [$pane cget -height]
1548  set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
1549  set yAxisCanvas [$pane yaxis]
1550  set yAxisWidth [winfo width $yAxisCanvas]
1551
1552  if {$tv(nLabels) > 0} {
1553   set start 0
1554   set end   0
1555   set label ""
1556   
1557   for {set i [expr $tv(nLabels)-1]} {$i >= 0} {incr i -1} {
1558    set ind [lindex $tv(map) $i]
1559    if {$i == 0} {
1560     set start $tv(t1,start)
1561    } else {
1562     set ind2 [lindex $tv(map) [expr {$i - 1}]]
1563     set start $tv(t1,$ind2,end)
1564    }
1565    set end $tv(t1,$ind,end)
1566    set label $tv(t1,$ind,label)
1567    set lx [$pane getCanvasX $start]
1568    set rx [$pane getCanvasX $end]
1569   
1570    if {$lx >= 0 && $lx <= $width} {
1571     $c create line [expr {$rx+$yAxisWidth}] $y \
1572         [expr {$rx+$yAxisWidth}] [expr {$y+$height}] \
1573         -tags [list b$ind$pane obj bound tran$pane print tmpPrint] \
1574         -fill $tv(bdColor)
1575    }
1576   }
1577  }
1578 }
1579 
1580 
1581 if {!$v(drawTranscription)} return
1582
1583 $c raise bound
1584
1585 set yAxisCanvas [$pane yaxis]
1586 set yAxisWidth [winfo width $yAxisCanvas]
1587 set h [$pane cget -height]
1588 set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}]
1589
1590 $c create rectangle $yAxisWidth $y \
1591   [expr {$x+$width+$yAxisWidth}] [expr {$y+$h}] \
1592   -tags print -outline black
1593 _redraw $w $pane $c $yAxisWidth $y
1594}
1595
1596proc trans::cursorMoved {w pane time value} {
1597 upvar [namespace current]::${pane}::var v
1598
1599 if {$v(drawTranscription)} {
1600  $w messageProc \
1601    [format "%s: %s | $v(labelMenuEvent): Label menu" $v(fileName) [$w formatTime $time]]
1602 }
1603}
1604
1605proc trans::soundChanged {w flag} {
1606 set s [$w cget -sound]
1607 foreach pane [$w _getPanes] {
1608  upvar [namespace current]::${pane}::var v
1609  if {$v(drawTranscription)} {
1610    $w _redrawPane $pane
1611  }
1612 }
1613}
1614
1615proc trans::propertyPane {w pane} {
1616 if {$pane==""} return
1617 upvar [namespace current]::${pane}::var v
1618
1619 if {$v(drawTranscription)} {
1620  list Trans1 [namespace code drawPage1] \
1621    Trans2 [namespace code drawPage2]
1622 }
1623}
1624
1625proc trans::applyProperties {w pane} {
1626 if {[string match *wavebar $pane]} return
1627 variable Info
1628 upvar [namespace current]::${pane}::var v
1629 
1630 if {[info exists v(drawTranscription)]} {
1631  if {$v(drawTranscription)} {
1632   foreach var {format alignment labext labdir encoding \
1633     labColor bdColor bgColor \
1634     font menuNrows menuNcols labelMenuEvent adjustLeftEvent \
1635     adjustRightEvent playLabelEvent locked quickenter quicktol \
1636     extBounds linkBounds highlight} {
1637    if {[string compare $v(t,$var) $v($var)] !=0} {
1638     if [string match labelMenuEvent $var] {
1639      event delete <<LabelMenuEvent>> <$v($var)>
1640      event add <<LabelMenuEvent>> <$v(t,$var)>
1641     }
1642     if [string match adjustLeftEvent $var] {
1643      event delete <<AdjustLeftEvent>> <$v($var)>
1644      event add <<AdjustLeftEvent>> <$v(t,$var)>
1645     }
1646     if [string match adjustRightEvent $var] {
1647      event delete <<AdjustRightEvent>> <$v($var)>
1648      event add <<AdjustRightEvent>> <$v(t,$var)>
1649     }
1650     if [string match playLabelEvent $var] {
1651      event delete <<PlayLabelEvent>> <$v($var)>
1652      event add <<PlayLabelEvent>> <$v(t,$var)>
1653     }
1654     if {$::tcl_version > 8.2 && [string match locked $var] == 1} {
1655      set c [$pane canvas]
1656      if $v(t,$var) {
1657       $c configure -state disabled
1658      } else {
1659       $c configure -state normal
1660      }
1661     }
1662     if {[string match format $var] || \
1663       [string match labext $var] || \
1664       [string match encoding $var] || \
1665       [string match labdir $var]} {
1666      if {$v(changed)} {
1667       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]]} {
1668        return
1669       }
1670      }
1671      set v($var) $v(t,$var)
1672      openTranscriptionFile $w $pane [$w getInfo fileName] soundfile
1673      set doRedraw 1
1674     }
1675     set v($var) $v(t,$var)
1676     if {[string match labColor $var] || \
1677         [string match bdColor $var] || \
1678         [string match font $var] || \
1679         [string match extBounds $var] || \
1680         [string match alignment $var] || \
1681         [string match bgColor $var]} {
1682      set doRedraw 1
1683     }
1684     if {[string match format $var]} {
1685      set formatChanged 1
1686     }
1687    }
1688   }
1689   if {[info exists doRedraw]} {
1690    $w _redrawPane $pane
1691   }
1692   if {[info exists formatChanged]} {
1693    wsurf::_remeberPropertyPage $w $pane
1694    wsurf::_drawPropertyPages $w $pane
1695   }
1696   for {set i 0} {$i < $v(menuNrows)} {incr i } {
1697    for {set j 0} {$j < $v(menuNcols)} {incr j } {
1698     set v($i$j) $v(t,$i$j)
1699    }
1700   }
1701  }
1702 }
1703}
1704
1705proc trans::drawPage1 {w pane path} {
1706 variable Info
1707 upvar [namespace current]::${pane}::var v
1708
1709 foreach f [winfo children $path] {
1710  destroy $f   
1711 }
1712
1713 foreach var {format alignment labext labdir encoding \
1714   labColor bdColor bgColor \
1715   font locked quickenter quicktol extBounds linkBounds} {
1716  set v(t,$var) $v($var)
1717 }
1718
1719 pack [frame $path.f1] -anchor w
1720 label $path.f1.l -text "Label file format:" -width 25 -anchor w
1721 foreach {format loadProc saveProc} $Info(formats) {
1722  lappend tmp $format
1723 }
1724 eval tk_optionMenu $path.f1.om [namespace current]::${pane}::var(t,format) \
1725   $tmp
1726 pack $path.f1.l $path.f1.om -side left -padx 3
1727
1728 pack [frame $path.f2] -anchor w
1729 label $path.f2.l -text "Label alignment:" -width 25 -anchor w
1730 tk_optionMenu $path.f2.om [namespace current]::${pane}::var(t,alignment) \
1731   left center right
1732 $path.f2.om.menu entryconfigure 0 -value w
1733 $path.f2.om.menu entryconfigure 1 -value c
1734 $path.f2.om.menu entryconfigure 2 -value e
1735 pack $path.f2.l $path.f2.om -side left -padx 3
1736
1737 stringPropItem $path.f3 "Label filename extension:" 25 16 "" \
1738   [namespace current]::${pane}::var(t,labext)
1739
1740 pack [frame $path.f4] -anchor w
1741 label $path.f4.l -text "Label file path:" -width 25 -anchor w
1742 entry $path.f4.e -textvar [namespace current]::${pane}::var(t,labdir) -wi 16
1743 pack $path.f4.l $path.f4.e -side left -padx 3
1744 if {[info command tk_chooseDirectory] != ""} {
1745  button $path.f4.b -text Choose... \
1746    -command [namespace code [list chooseDirectory $w $pane]]
1747  pack $path.f4.b -side left -padx 3
1748 }
1749
1750 stringPropItem $path.f5 "Label file encoding:" 25 16 "" \
1751   [namespace current]::${pane}::var(t,encoding)
1752
1753 colorPropItem $path.f6 "Label color:" 25 \
1754   [namespace current]::${pane}::var(t,labColor)
1755
1756 colorPropItem $path.f7 "Boundary color:" 25 \
1757   [namespace current]::${pane}::var(t,bdColor)
1758
1759 colorPropItem $path.f8 "Background color:" 25 \
1760   [namespace current]::${pane}::var(t,bgColor)
1761
1762 stringPropItem $path.f9 "Font:" 25 16 "" \
1763   [namespace current]::${pane}::var(t,font)
1764
1765 if {$::tcl_version > 8.2} {
1766  booleanPropItem $path.f10 "Lock transcription" "" \
1767    [namespace current]::${pane}::var(t,locked)
1768 }
1769
1770 booleanPropItem $path.f11 "Quick transcribe" "" \
1771   [namespace current]::${pane}::var(t,quickenter)
1772
1773 stringPropItem $path.f12 "Max cursor movement for current label:" 34 4 \
1774   pixels [namespace current]::${pane}::var(t,quicktol)
1775
1776 booleanPropItem $path.f13 "Extend boundaries into waveform and spectrogram panes" "" \
1777   [namespace current]::${pane}::var(t,extBounds)
1778
1779 booleanPropItem $path.f14 "Move coinciding boundaries in other transcription panes" "" \
1780   [namespace current]::${pane}::var(t,linkBounds)
1781}
1782
1783proc trans::confPage {w pane path} {
1784 upvar [namespace current]::${pane}::var v
1785
1786 for {set i 0} {$i < $v(t,menuNrows)} {incr i } {
1787  if {![winfo exists $path.fl$i]} {
1788   pack [frame $path.fl$i] -anchor w
1789  }
1790  for {set j 0} {$j < $v(t,menuNcols)} {incr j } {
1791   if {![winfo exists $path.fl$i.e$j]} {
1792    pack [entry $path.fl$i.e$j -width 6 \
1793      -textvar [namespace current]::${pane}::var(t,$i$j)] -side left
1794   }
1795   $path.fl$i.e$j configure -font $v(t,font)
1796  }
1797  while {[winfo exists $path.fl$i.e$j] == 1} {
1798   destroy $path.fl$i.e$j
1799   incr j
1800  }
1801 }
1802 while {[winfo exists $path.fl$i] == 1} {
1803  destroy $path.fl$i
1804  incr i
1805 }
1806}
1807
1808proc trans::chooseDirectory {w pane} {
1809 upvar [namespace current]::${pane}::var v
1810 set dir $v(t,labdir)
1811 if {$dir == ""} {
1812  set dir .
1813 }
1814 set res [tk_chooseDirectory -initialdir $dir -mustexist yes]
1815 if {$res != ""} {
1816  set v(t,labdir) $res
1817 }
1818}
1819
1820proc trans::drawPage2 {w pane path} {
1821 upvar [namespace current]::${pane}::var v
1822
1823 foreach f [winfo children $path] {
1824  destroy $f   
1825 }
1826
1827 foreach var {adjustLeftEvent adjustRightEvent playLabelEvent labelMenuEvent \
1828   menuNrows menuNcols highlight} {
1829  set v(t,$var) $v($var)
1830 }
1831 for {set i 0} {$i < $v(menuNrows)} {incr i } {
1832  for {set j 0} {$j < $v(menuNcols)} {incr j } {
1833   set v(t,$i$j) $v($i$j)
1834  }
1835 }
1836
1837 booleanPropItem $path.f0 "Highlight labels during playback" "" \
1838   [namespace current]::${pane}::var(t,highlight)
1839
1840 stringPropItem $path.f1 "Adjust left boundary event:" 28 25 "" \
1841   [namespace current]::${pane}::var(t,adjustLeftEvent)
1842
1843 stringPropItem $path.f2 "Adjust right boundary event:" 28 25 "" \
1844   [namespace current]::${pane}::var(t,adjustRightEvent)
1845
1846 stringPropItem $path.f3 "Play label event:" 28 25 "" \
1847   [namespace current]::${pane}::var(t,playLabelEvent)
1848
1849 stringPropItem $path.f4 "Label menu event:" 28 25 "" \
1850   [namespace current]::${pane}::var(t,labelMenuEvent)
1851
1852 pack [frame $path.f5] -anchor w
1853 pack [label $path.f5.l -text "Label menu pane:" -width 25 -anchor w] -padx 3
1854 pack [frame $path.f6] -anchor w
1855 pack [label $path.f6.lc -text "Columns:" -anchor w] -side left -padx 3
1856 pack [entry $path.f6.ec -width 2 -textvar \
1857   [namespace current]::${pane}::var(t,menuNcols)] -side left
1858 pack [label $path.f6.lr -text "Rows:" -anchor w] -side left
1859 pack [entry $path.f6.er -width 2 -textvar \
1860   [namespace current]::${pane}::var(t,menuNrows)] -side left
1861 pack [button $path.f6.b -text Update \
1862   -command [namespace code [list confPage $w $pane $path]]] -side left \
1863   -padx 3
1864 bind $path.f6.ec <Key-Return> [namespace code [list confPage $w $pane $path]]
1865 bind $path.f6.er <Key-Return> [namespace code [list confPage $w $pane $path]]
1866
1867 for {set i 0} {$i < $v(t,menuNrows)} {incr i } {
1868  pack [frame $path.fl$i] -anchor w
1869  for {set j 0} {$j < $v(t,menuNcols)} {incr j } {
1870   pack [entry $path.fl$i.e$j -font $v(t,font) \
1871     -textvar [namespace current]::${pane}::var(t,$i$j) -wi 6] \
1872     -side left
1873  }
1874 }
1875}
1876
1877proc trans::getConfiguration {w pane} {
1878 upvar [namespace current]::${pane}::var v
1879
1880 set result {}
1881 if {$pane==""} {return {}}
1882 if {$v(drawTranscription)} {
1883 
1884  lappend labmenu $v(menuNcols) $v(menuNrows)
1885  for {set i 0} {$i < $v(menuNrows)} {incr i } {
1886   for {set j 0} {$j < $v(menuNcols)} {incr j } {
1887    if {[info exists v($i$j)]} {
1888     lappend labmenu $v($i$j)
1889    } else {
1890     lappend labmenu \"\"
1891    }
1892   }
1893  }
1894
1895  append result "\$widget trans::addTranscription \$pane\
1896    -alignment $v(alignment)\
1897    -format \"$v(format)\"\
1898    -extension \"$v(labext)\"\
1899    -labelcolor $v(labColor)\
1900    -boundarycolor $v(bdColor)\
1901    -backgroundcolor $v(bgColor)\
1902    -labeldirectory \"$v(labdir)\"\
1903    -fileencoding \"$v(encoding)\"\
1904    -labelmenuevent $v(labelMenuEvent)\
1905    -adjustleftevent $v(adjustLeftEvent)\
1906    -adjustrightevent $v(adjustRightEvent)\
1907    -playlabelevent $v(playLabelEvent)\
1908    -locked $v(locked)\
1909    -quickenter $v(quickenter)\
1910    -quickentertolerance $v(quicktol)\
1911    -extendboundaries $v(extBounds)\
1912    -linkboundaries $v(linkBounds)\
1913    -playhighlight $v(highlight)\
1914    -font \{$v(font)\}"
1915  append result " -labelmenu \{\n"
1916  append result "[lrange $labmenu 0 1]\n"
1917  for {set i 0} {$i < $v(menuNrows)} {incr i } {
1918   append result "[lrange $labmenu [expr 2+$i*$v(menuNcols)] [expr 1+($i+1)*$v(menuNcols)]]\n"
1919  }
1920  append result "\}"
1921  append result "\n"
1922 }
1923 return $result
1924}
1925
1926proc trans::cut {w t0 t1} {
1927 set dt [expr {$t1-$t0}]
1928 foreach pane [$w _getPanes] {
1929  upvar [namespace current]::${pane}::var v
1930  if $v(drawTranscription) {
1931   if {[llength $v(map)] == 0} continue
1932   set c [$pane canvas]
1933
1934   set i 0
1935   foreach ind $v(map) {
1936    if {$t0 < $v(t1,$ind,end)} break
1937    incr i
1938   }   
1939
1940   # Adjust start time
1941   if {$t0 < $v(t1,start)} {
1942    if {$t1 < $v(t1,start)} {
1943     # Current selection is to the left of start time
1944     set v(t1,start) [expr {$v(t1,start)-$dt}]
1945    } else {
1946     # Left boundary of current selection is to the left of start time
1947     set v(t1,start) $t0
1948    }
1949   }
1950
1951   # Left boundary is new end time for first label
1952   if {$t0 < $v(t1,$ind,end) && \
1953     $t1 > $v(t1,$ind,end)} {
1954    set v(t1,$ind,end) $t0
1955    incr i
1956    set ind [lindex $v(map) $i]
1957   }
1958   set j $i
1959
1960   # Delete labels within the selection
1961   while {$ind != "" && $t1 > $v(t1,$ind,end)} {
1962    #       unset v(t1,$ind,label)
1963    #       unset v(t1,$ind,end)
1964    #       unset v(t1,$ind,rest)
1965    incr i
1966    set ind [lindex $v(map) $i]
1967   }
1968   if {$j <= [expr $i - 1] && $j < [llength $v(map)]} {
1969    set v(map) [lreplace $v(map) $j [expr $i - 1]]
1970    set v(nLabels) [llength $v(map)]
1971   }
1972   
1973   # Move all remaining labels $dt to the left
1974   set ind [lindex $v(map) $j]
1975   while {$ind != "" && $t1 < $v(t1,$ind,end)} {
1976    set v(t1,$ind,end) [expr {$v(t1,$ind,end)-$dt}]
1977    incr j
1978    set ind [lindex $v(map) $j]
1979   }
1980   changed $w $pane
1981   $w _redrawPane $pane
1982  }
1983 }
1984}
1985
1986proc trans::copy {w t0 t1} {
1987 foreach pane [$w _getPanes] {
1988  upvar [namespace current]::${pane}::var v
1989  if $v(drawTranscription) {
1990   set c [$pane canvas]
1991   if {[$c focus] != {}} {
1992    set tag [$c focus]
1993    if {[catch {set s [$c index $tag sel.first]}]} return
1994    set e [$c index $tag sel.last]
1995    clipboard append [string range [$c itemcget $tag -text] $s $e]
1996   }
1997  }
1998 }
1999}
2000
2001proc trans::paste {w t length} {
2002 foreach pane [$w _getPanes] {
2003  upvar [namespace current]::${pane}::var v
2004  if $v(drawTranscription) {
2005   set c [$pane canvas]
2006   if {[focus] == $c && [$c focus] != $v(hidden)} {
2007    catch {set cbText [selection get -selection CLIPBOARD]}
2008    if {[info exists cbText] == 0} { return 0 }
2009    $c insert [$c focus] insert [selection get -selection CLIPBOARD]
2010    SetLabelText $w $pane [lindex [$c gettags [$c focus]] 0] \
2011        [$c itemcget [$c focus] -text]
2012    return 1
2013   }
2014  }
2015 }
2016 return 0
2017 list {
2018 foreach pane [$w _getPanes] {
2019  upvar [namespace current]::${pane}::var v
2020  if $v(drawTranscription) {
2021   if {[llength $v(map)] == 0} return
2022   set i 0
2023   foreach ind $v(map) {
2024    if {$t < $v(t1,$ind,end)} break
2025    incr i
2026   }
2027
2028   # Adjust start time
2029   if {$t < $v(t1,start)} {
2030    set v(t1,start) [expr {$v(t1,start)+$length}]
2031   }
2032
2033   # Move all remaining labels $length to the left
2034   while {$ind != ""} {
2035    set v(t1,$ind,end) [expr {$v(t1,$ind,end)+$length}]
2036    incr i
2037    set ind [lindex $v(map) $i]
2038   }
2039
2040   $w _redrawPane $pane
2041  }
2042 }}
2043}
2044
2045proc trans::find {w pane} {
2046 upvar [namespace current]::${pane}::var v
2047
2048 set p $v(browseTL)
2049 set v(nMatch) 0
2050 $p.f2.list delete 0 end
2051 set i 0
2052 if {$v(matchCase)} {
2053  set nocase ""
2054 } else {
2055  set nocase -nocase
2056 }
2057 foreach ind $v(map) {
2058  if {[eval regexp $nocase $v(pattern) \{$v(t1,$ind,label)\}]} {
2059   if {$i == 0} {
2060    set start $v(t1,start)
2061   } else {
2062    set prev [lindex $v(map) [expr $i-1]]
2063    set start $v(t1,$prev,end)
2064   }
2065   if {[string match *\"* \{$v(t1,$ind,label)\}]} {
2066    set tmp "\{$v(t1,$ind,label):\} $start $v(t1,$ind,end)"
2067   } else {
2068    set tmp "$v(t1,$ind,label): $start $v(t1,$ind,end)"
2069   }
2070   $p.f2.list insert end $tmp
2071   incr v(nMatch)
2072  }
2073  incr i
2074 }
2075}
2076
2077proc trans::select {w pane} {
2078 upvar [namespace current]::${pane}::var v
2079
2080 set p $v(browseTL)
2081
2082 set cursel [$p.f2.list curselection]
2083 if {$cursel == ""} return
2084 set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1]
2085 set end   [lindex [$p.f2.list get [lindex $cursel end]] end]
2086 $w configure -selection [list $start $end]
2087 set s [$w cget -sound]
2088 set length [$s length -unit seconds]
2089 $w xscroll moveto [expr {$start/$length}]
2090}
2091
2092proc trans::findPlay {w pane} {
2093 upvar [namespace current]::${pane}::var v
2094
2095 set p $v(browseTL)
2096 set cursel [$p.f2.list curselection]
2097 if {$cursel != ""} {
2098  set start [lindex [$p.f2.list get [lindex $cursel 0]] end-1]
2099  set end   [lindex [$p.f2.list get [lindex $cursel end]] end]
2100  $w play $start $end
2101 }
2102}
2103
2104proc trans::browse {w pane} {
2105 upvar [namespace current]::${pane}::var v
2106
2107 regsub -all {\.} $pane _ tmp
2108 set v(browseTL) .browse$tmp
2109 catch {destroy .browse$tmp}
2110 set p [toplevel .browse$tmp]
2111 wm title $p "Browse Labels"
2112
2113 pack [frame $p.f]
2114 pack [entry $p.f.e -textvar [namespace current]::${pane}::var(pattern)]\
2115   -side left
2116 pack [button $p.f.l -text Find \
2117   -command [namespace code [list find $w $pane]]] -side left
2118
2119 pack [ label $p.l -text "Results:"]
2120 pack [ frame $p.f2] -fill both -expand true
2121 pack [ scrollbar $p.f2.scroll -command "$p.f2.list yview"] -side right \
2122   -fill y
2123 listbox $p.f2.list -yscroll "$p.f2.scroll set" -setgrid 1 \
2124   -selectmode extended -height 6 -width 40
2125 pack $p.f2.list -side left -expand true -fill both
2126
2127 pack [checkbutton $p.cb -text "Match case" -anchor w \
2128   -variable [namespace current]::${pane}::var(matchCase)]
2129
2130 pack [ frame $p.f3] -pady 10 -fill x -expand true
2131 pack [ button $p.f3.b1 -bitmap snackPlay \
2132   -command [namespace code [list findPlay $w $pane]]] \
2133   -side left
2134 pack [ button $p.f3.b2 -bitmap snackStop -command "$w stop"] -side left
2135 pack [ button $p.f3.b3 -text Close -command "destroy $p"] -side right
2136
2137 bind $p.f.e <Return> [namespace code [list find $w $pane]]
2138 bind $p.f2.list <ButtonRelease-1> [namespace code [list select $w $pane]]
2139 if {$v(pattern) != ""} {
2140  find $w $pane
2141 }
2142 bind $p.f2.list <Double-Button-1> [namespace code [list findPlay $w $pane]]
2143 focus $p.f.e
2144}
2145
2146proc trans::convert {w pane} {
2147 upvar [namespace current]::${pane}::var v
2148 variable Info
2149 regsub -all {\.} $pane _ tmp
2150 set v(convertTL) .convert$tmp
2151 catch {destroy .convert$tmp}
2152 set p [toplevel .convert$tmp]
2153 wm title $p "Convert Transcription File format"
2154
2155 pack [ label $p.l1 -text "Current transcription file format: $v(format)"]
2156
2157 set v(t,format) $v(format)
2158 pack [frame $p.f1] -anchor w
2159 label $p.f1.l -text "New transcription file format:" -anchor w
2160 foreach {format loadProc saveProc} $Info(formats) {
2161  lappend fmtlist $format
2162 }
2163 eval tk_optionMenu $p.f1.om [namespace current]::${pane}::var(t,format) \
2164   $fmtlist
2165 pack $p.f1.l $p.f1.om -side left -padx 3
2166
2167 pack [frame $p.f]
2168 pack [ button $p.f.b1 -text OK -command [namespace code [list doConvert $w $pane]]\n[list destroy $p]] -side left -padx 3
2169 pack [ button $p.f.b2 -text Close -command "destroy $p"] -side left -padx 3
2170}
2171
2172proc trans::doConvert {w pane} {
2173 upvar [namespace current]::${pane}::var v
2174 set v(format) $v(t,format)
2175}
2176
2177proc trans::play {w} {
2178 foreach pane [$w _getPanes] {
2179  upvar [namespace current]::${pane}::var v
2180  if {$v(drawTranscription) && $v(highlight)} {
2181   set v(playIndex) 0
2182  }
2183 }
2184 after 200 [namespace code [list _updatePlay $w]]
2185}
2186
2187proc trans::stop {w} {
2188 foreach pane [$w _getPanes] {
2189  upvar [namespace current]::${pane}::var v
2190  set c [$pane canvas]
2191  if {$v(drawTranscription)} {
2192   after cancel [namespace code [list FindNextLabel $w $pane]]
2193  }
2194 }
2195}
2196
2197proc trans::_updatePlay {w} {
2198 if {[winfo exists $w] == 0} {
2199  return
2200 }
2201 if {[$w getInfo isPlaying] == 0} {
2202  foreach pane [$w _getPanes] {
2203   upvar [namespace current]::${pane}::var v
2204   set c [$pane canvas]
2205   if {$v(drawTranscription)} {
2206    if {$v(highlight) && [info exists v(playIndex)]} {
2207     set ind [lindex $v(map) $v(playIndex)]
2208     if {$ind != ""} {
2209      $c itemconf g$ind -fill $v(bgColor)
2210     }
2211    }
2212   }
2213  }
2214  return
2215 }
2216 set s [$w cget -sound]
2217 foreach pane [$w _getPanes] {
2218  upvar [namespace current]::${pane}::var v
2219  if {$v(drawTranscription) && $v(highlight)} {
2220   set cursorpos [$pane cget -cursorpos]
2221   set c [$pane canvas]
2222   set ind [lindex $v(map) $v(playIndex)]
2223   if {$ind != ""} {
2224    $c itemconf g$ind -fill $v(bgColor)
2225    while (1) {
2226     set ind [lindex $v(map) $v(playIndex)]
2227     if {$ind == ""} return
2228     if {$cursorpos < $v(t1,$ind,end)} break
2229     incr v(playIndex)
2230    }
2231    $c itemconf g$ind -fill [$w cget -cursorcolor]
2232   }
2233  }
2234 }
2235 if {[$w getInfo isPlaying]} {
2236  after 50 [namespace code [list _updatePlay $w]]
2237 }
2238}
2239
2240# -----------------------------------------------------------------------------
2241# !!! experimental
2242
2243proc trans::regCallback {name callback script} {
2244 variable Info
2245# puts [info level 0]
2246 if {$callback != "-transcription::transcriptionchangedproc"} {
2247  error "unknown callback \"$callback\""
2248 } else {
2249  set Info(Callback,$name,transChangedProc) $script
2250 }
2251}
2252
2253proc trans::changed {w pane} {
2254# puts [info level 0]([info level -1])
2255 variable Info
2256 upvar [namespace current]::${pane}::var v
2257 set v(changed) 1
2258 foreach key [array names Info Callback,*,transChangedProc] {
2259  puts "invoking callback $key"
2260  $Info($key) $w $pane
2261 }
2262}
2263
2264
2265
2266
2267
2268
2269proc trans::SplitSoundFile {w pane} {
2270 upvar [namespace current]::${pane}::var v
2271 set s [$w cget -sound]
2272
2273 foreach ind $v(map) {
2274  set start [expr {int([GetStartByIndex $w $pane $ind] * [$s cget -rate])}]
2275  set end   [expr {int($v(t1,$ind,end) * [$s cget -rate])}]
2276  $s write $v(t1,$ind,label).wav -start $start -end $end
2277 }
2278}
Note: See TracBrowser for help on using the repository browser.