pax_global_header00006660000000000000000000000064132532600020014503gustar00rootroot0000000000000052 comment=8d247abaa66874dad6997e4eb6b66e47688ac9b6 wavesurfer-1.8.8p5/000077500000000000000000000000001325326000200141575ustar00rootroot00000000000000wavesurfer-1.8.8p5/LICENSE.txt000066400000000000000000000026231325326000200160050ustar00rootroot00000000000000 Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander The following terms apply to all files associated with the software unless explicitly disclaimed in individual files. The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply. IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. wavesurfer-1.8.8p5/README.txt000077500000000000000000000025711325326000200156650ustar00rootroot00000000000000 WaveSurfer 1.8.8 - October 2010 ------------------------------- changes since last version: + drag-and-drop support! (osx and windows) + scroll wheel support re-added and improved (mysteriously missing in 1.8.7) + mac osx 10.5 crash (bug 3078589) fixed + mac osx yellow-spectrograms bug fixed (new snack binary) + re-added license info file (LICENSE.txt) (bug 3079342) + new startup option --show-console (useful for tracking startup problems in wrapped apps) + default configuration can now be set from within the choose-configuration dialogue + GUI tidying-up - more tile widgets, removed several hard-wired color specifications + modified snack::getOpenFile to allow for raw files on all platforms (fixing bug 3082068) patchlevel 2 (2010-12-06): + applied Mac OSX menu-patch (3087446) + fixed Windows 7 bug (3111969) + fixed osx transcription bug (3115693) patchlevel 3 (2011-01-30): + fixed bug 3136110 (close dialogue for empty sound) + fixed window resize-issue on OSX patchlevel 4 (2011-12-30): + fixed bugs 3297829 (waveform scaling),3181986 (config dialog error) + applied patch 3466895 (selection edit error) patchlevel 5 (2016-11-23, +update 2017-01-25): + fixed Mac OS X 10.12 (Sierra) compatibility issue + new Tcl 8.6.6 runtime) + fixed "namespace inscope"-bug for properties and preferences dialogs + new Linux Tcl 8.6.6 runtime (better compatibility with new Ubuntu releases) wavesurfer-1.8.8p5/demos/000077500000000000000000000000001325326000200152665ustar00rootroot00000000000000wavesurfer-1.8.8p5/demos/README-Python.txt000066400000000000000000000023241325326000200202440ustar00rootroot00000000000000Included Python examples wsapp1.py is a minimal example on how to build a Python application using the wsurf widget. wsplugapp.py is a minimal example of a Python application using the wsurf widget and wsurf plugins written in Python. Make sure that both the wsurf and Snack packages can be found by Python and Tkinter. On Unix this is done by setting the environment variable TCLLIBPATH. setenv TCLLIBPATH "/tmp/wavesurfer- /tmp/snack/unix" Windows/Mac users should install the wsurf package in the same way the Snack package is to be installed on their system. Now do cd demos/ python wsapp1.py Installing the wsurf package It might be practical to install the wsurf package on your system in order to develop and use custom applications like these. Simply copy the wsurf directory to the directory containing the snack library directory (assuming you have installed Snack according to the installation instructions included with that package). Something like: /usr/local/lib/snack/ /usr/local/lib/wsurf/ Properly installing wsurf in this manner will make the code line that sets "auto_path", in the examples, superfluous. wavesurfer-1.8.8p5/demos/README.txt000066400000000000000000000036261325326000200167730ustar00rootroot00000000000000Included Tcl/Tk examples wsapp1.tcl is a minimal example on how to build an application using the wsurf widget. wsapp2.tcl extends the previous example with code that makes the wsurf widget link to a sound file instead of loading it into memory. Useful for large sound files. wsapp3.tcl shows how to create a wsurf widget with a couple of panes. The code for adding these panes has been copied from a configuration file. wsapp4.tcl is a slightly larger example that creates a wsurf widget and a listbox where the user can browse files and segments. These can be loaded from a text file containing lines with the format "filename start-in-seconds end-in-seconds". wsapp5.tcl shows how to create a wsurf widget and add an empty pane to it. This can be used to draw custom graphics. wsapp6.tcl shows how to do ganging, i.e., how to create links between widgets. All zoom/scroll/selection operations on one widget will be reflected by the other widget. wsapp7.tcl is tool that can load two versions of a sound file and allow the user to switch between the sounds during playback. wsapp8.tcl is an extension of wsapp5.tcl that shows how to track cursor-movement, selection and scroll operations. embed.tcl is a minimal example on how a custom application can pop-up a WaveSurfer-window. speecon.tcl is a tool used to verify and correct the Swedish part of the SPEECON database. Installing the wsurf package It might be practical to install the wsurf package on your system in order to develop and use custom applications like these. Simply copy the wsurf1.8 directory to the directory containing the snack2.2 library directory (assuming you have installed Snack 2.2 according to the installation instructions included with that package). Something like: /usr/local/lib/snack2.2/ /usr/local/lib/wsurf1.8/ Properly installing wsurf in this manner will make the code line that sets "auto_path", in the examples, superfluous. wavesurfer-1.8.8p5/demos/Wsurf.py000066400000000000000000000164231325326000200167540ustar00rootroot00000000000000""" A Python wrapper for WaveSurfer Author: Kazuaki Maeda Updated 8/18/2004 """ from Tkinter import * class BaseWsurf: """a mixin class for Wsurf""" def SetDefaultPrefs(self): self.tk.call('wsurf::SetDefaultPrefs') def SetPreference(self, pref, val): self.tk.call('wsurf::SetPreference', pref, val) def GetPreference(self, pref): return self.tk.call('wsurf::GetPreference', pref) def AddEvent(self, name, binding): self.tk.call('wsurf::AddEvent', name, binding) def GetStandardConfigurations(self): return self.tk.call('wsurf::GetStandardConfigurations') def GetLocalConfigurations(self): return self.tk.call('wsurf::GetLocalConfigurations') def GetConfigurations(self): return self.tk.call('wsurf::GetConfigurations') def ChooseConfigurationDialog(self): return self.tk.call('wsurf::ChooseConfigurationDialog') def CreateUniqueTitle(self, title): return self.tk.call('wsurf::CreateUniqueTitle', title) def GetWidgetPath(self, name): return self.tk.call('wsurf::GetWidgetPath', name) def GetCurrent(self): return self.tk.call('wsurf::GetCurrent') def MakeCurrent(self): return self.tk.call('wsurf::MakeCurrent', self._w) def NeedSave(self): return self.tk.call('wsurf::NeedSave') def GetPreferences(self): return self.tk.call('wsurf::GetPreferences') def GetPreferencePages(self): return self.tk.call('wsurf::PreferencePages') def AddPreferencePage(self, title, pageProc, applyProc, getProc, defProc): return self.tk.call('wsurf::AddPreferencePage', title, pageProc, applyProc, getProc, defProc) def PrepareUndo(self, undoCmd, redoCmd): return self.tk.call('wsurf::PrepareUndo', undoCmd, redoCmd) def Initialize(self, *args): apply(self.tk.call, ('::wsurf::Initialize',)+args) class Wsurf(Widget, BaseWsurf): """ Class definition for Wsurf widget """ def __init__(self, master=None, cnf={}, **kw): """Construct a Wsurf widget. Valid resource names: state, icons, messageproc, progressproc, slaves, isslave, collapser, sound, configuration, playmapfilter, title """ Widget.__init__(self, master, 'wsurf', cnf, kw) def xzoom(self, frac1, frac2): self.tk.call(self._w, 'xzoom', frac1, frac2) def zoomToSelection(self): self.tk.call(self._w, 'zoomToSelection'); def create(self,*args): apply(self.tk.call, (self._w, 'create')+args) def xscroll(self,*args): apply(self.tk.call, (self._w, 'xscroll')+args) def xscroll_moveto(self, *args): apply(self.tk.call, (self._w, 'xscroll', 'moveto')+args) def updateBounds(self): self.tk.call(self._w, 'updateBounds') def formatTime(self,t): return self.tk.call(self._w, 'formatTime', t) def popupMenu(self,X,Y,x,y,pane=''): self.tk.call(self._w, 'popupMenu', X, Y, x, y, pane) def loadConfiguration(self,configFile): self.tk.call(self._w, 'loadConfiguration', configFile) def addPane(self, cnf={}, **kw): return Pane(self, cnf, kw) def deletePane(self, pane): self.tk.call(self._w, 'deletePane', pane) def loadConfiguration(self): self.tk.call(self._w, 'loadConfiguration') def saveConfiguration(self): self.tk.call(self._w, 'saveConfiguration') def applyConfiguration(self,conf): self.tk.call(self._w, 'applyConfiguration', conf) def play(self, start=-1, end=-1): self.tk.call(self._w, 'play', start, end) def playall(self): self.tk.call(self._w, 'playall') def playcont(self): self.tk.call(self._w, 'playcont') def playvisib(self): self.tk.call(self._w, 'playvisib') def playPopupMenu(self,X,Y): self.tk.call(self._w, 'playPopupMenu', X, Y) def playDone(self): self.tk.call(self._w, 'playDone') def pause(self): self.tk.call(self._w, 'pause') def record(self): self.tk.call(self._w, 'record') def stop(self): self.tk.call(self._w, 'stop') def printDialog(self): self.tk.call(self._w, 'printDialog') def print_print(self): self.tk.call(self._w, 'print', 'print') def print_preview(self): self.tk.call(self._w, 'print', 'preview') def print_save(self): self.tk.call(self._w, 'print', 'save') def needSave(self): self.tk.call(self._w, 'needSave') def closeWidget(self): self.tk.call(self._w, 'closeWidget') def messageProc(self, message, sender='anonymous'): self.tk.call(self._w, 'messageProc', message, sender) def openFile(self, fileName, guessRate=16000, guessEnc="lin16", guessChan=1, guessByteOrder='little', guessSkip=0, fileformat=""): self.tk.call(self._w, 'openFile', fileName, guessRate, guessEnc, guessChan, guessByteOrder, guessSkip, fileformat) def saveFile(self, fileName): self.tk.call(self._w, 'saveFile', fileName) def new(self): self.tk.call(self._w, 'new') def undo(self): self.tk.call(self._w, 'undo') def cut(self, soundObj): self.tk.call(self._w, 'cut', soundObj) def copy(self,soundObj): self.tk.call(self._w, 'copy', soundObj) def paste(self,soundObj): self.tk.call(self._w, 'paste', soundObj) def getSound(self): return self.tk.call(self._w, 'getSound') def findPane(self,path): return self.tk.call(self._w, 'findPane', path) def getInfo(self,property): return self.tk.call(self._w, 'getInfo', property) def dump(self, pattern='*', subpattern='*'): self.tk.call(self._w, 'dump', pattern, subpattern) ## a few convenience methods def analysis_addWaveform(self, pane, cnf={}, **kw): return self.tk.call((self._w, 'analysis::addWaveform', pane) + self._options(cnf, kw)) def timeaxis_addTimeAxis(self, pane, cnf={}, **kw): return self.tk.call((self._w, 'timeaxis::addTimeAxis', pane) + self._options(cnf, kw)) def analysis_widgetCreated(self, pane): return self.tk.call(self._w, 'analysis::widgetCreated', pane) def analysis_widgetDeleted(self, pane): return self.tk.call(self._w, 'analysis::widgetDeleted', pane) def analysis_createSpectrogram(self, pane): return self.tk.call(self._w, 'analysis::createSpecrogram', pane) def analysis_createWaveform(self, pane): return self.tk.call(self._w, 'analysis::createWavefrom', pane) def analysis_createPitch(self, pane): return self.tk.call(self._w, 'analysis::createPitch', pane) def _getPanes(self): return self.tk.splitlist(self.tk.call(self._w, '_getPanes')) getPanes = _getPanes class Pane(BaseWidget): """Class definition for panes used in Wsurf """ def __init__(self, masterWsurf, cnf={}, kw={}): pane = masterWsurf.tk.call((masterWsurf._w, 'addPane') + self._options(cnf, kw)) self._w = pane self.widgetName = 'Pane' self.master = masterWsurf self.tk = masterWsurf.tk name = None if cnf.has_key('name'): name = cnf['name'] del cnf['name'] if not name: name = `id(self)` self._name = name self.children = {} if self.master.children.has_key(self._name): self.master.children[self._name].destroy() self.master.children[self._name] = self def __del__(self): self.master.deletePane(self) def destroy(self): self.master.deletePane(self) wavesurfer-1.8.8p5/demos/WsurfPlugin.py000066400000000000000000000322661325326000200201360ustar00rootroot00000000000000"""Python API to WaveSurfer plugins. (c) 2003 Geoffrey WILFART geoffrey.wilfart@tcts.fpms.ac.be """ import Tkinter import Wsurf import types class WsurfPlugin: def __init__(self): """Build a dummy WaveSurfer plugin. Provide the interface for WaveSurfer plugins. Real plugins should override this class and define necessary methods. """ self.name = "dummy" # the master should be the Wsurf widget this plugin instance # is attached to. First set to None, its actual value is given at # registration time (call to register function) self.master = None # description is a string explaining what the plugin is for self.description = "" # url is the url where this plugin can be found self.url = "http://tcts.fpms.ac.be" # dependencies is the list of the plugin dependencies (other plugins) self.dependencies = [] def register(self, wsurf): """Register the plugin into a WaveSurfer instance. This method provides a way to automatically export all members and methods matching the current WaveSurfer plugin API. This allows one plugin to be usable no matter which version of WaveSufer is used. Subclasses may override this method to register only some methods of the API. """ # For some strange reason, [eval list $l] returns an error when # l is like: # % set l { # -elem1 elem1 # -elem2 elem2 # } # % eval list $l # invalid command name "-elem2" # # We need to fallback to Tcl interpreter handling of lists # as a workaround self.master = wsurf self.tk = wsurf.tk wsurf.tk.eval('set wsurfPluginOptions [list]') wsurf.tk.eval('foreach {opt name} $wsurf::Info(ValidPluginOptions) ' + '{lappend wsurfPluginOptions $opt $name}') tmp_opts = wsurf.tk.eval('eval list $wsurfPluginOptions').split() options = {} for i in range(len(tmp_opts)/2): options[tmp_opts[2*i]] = tmp_opts[2*i+1] reg_string = '' # Declare namespace wsurf.tk.eval('namespace eval wsurf::%s {}' % self.name) for (opt, name) in options.items(): try: # Try to get the corresponding attribute val = getattr(self, name) if callable(val): val = wsurf._register(val) # Give a nicer name to functions and make them # available to Tcl wsurf.tk.eval('set wsurf::%s::%s [list %s]' % \ (self.name, name, val)) reg_string += ' %s $wsurf::%s::%s' % (opt, self.name, name) else: reg_string += ' %s %s' % (opt, name) except AttributeError: # The option is not defined for this plugin pass # Now we just need to register for cmd in 'RegisterPlugin', 'ExecuteRegisterPlugin': wsurf.tk.eval('wsurf::%s %s %s' % (cmd, self.name, reg_string)) class TkObject: def __init__(self, master, name): """Init a TkObject. The TkObject is a Python wrapper around a real object already known by the Tcl/Tk interpreter. The object is specified by its (Tcl) name. """ self.master = master # Take the str of name, since new version of Tkinter defines names as # unhashable class instances - and I need to hash. self.name = str(name) def __getattr__(self, attr): """Get attributes. This method is provided to convert automatically calls of the form self.method() into a string that can be evaluated by the Tcl/Tk interpreter. """ if attr[:2] == '__': raise AttributeError return lambda *args, **kws: \ str(self.master.tk.call((self.name, attr) + \ self.convert((args, kws)))) def convert(self, obj): """Convert object. As in the Tkinter module, dictionaries are converted into -key value strings - used for configuration. Other sequence types are expanded and themselves converted. TkObject instances are replaced by their names, functions (callable objects) are registered, and all other objects are replaced by their string representation. """ if type(obj) == types.DictType: d = {} for key in obj.keys(): d.update({key: self.convert(obj[key])}) res = d elif type(obj) in (types.ListType, types.TupleType): c = () for item in obj: if type(item) == types.DictType: c += self.master._options(self.convert(item)) elif type(item) in (types.ListType, types.TupleType): c += self.convert(item) else: c += (self.convert(item),) res = c elif isinstance(obj, TkObject): res = obj.name elif callable(obj): res = self.master._register(obj) else: res = str(obj) return res class SamplePlugin(WsurfPlugin): def __init__(self): """Build a sample plugin. This sample plugin basically does something similar to (but simpler than) analysis.plug. It is provided as an example of a real Python plugin for WaveSurfer, and illustrates how to handle parameters in the functions and how to manipulate those parameters from Python. """ self.name = "sample_plugin" self.Info = {} self.vars = {} def addMenuEntriesProc(self, w, pane, m, hook, x, y): """Add menu entries""" # self.master is known at registration time if hook == 'create': menu = TkObject(self.master, '%s.%s' % (m, hook)) menu.add('command', label="Waveform (sample)", command=lambda self=self, w=w, pane=pane: \ self.createWaveform(w,pane)) def paneCreatedProc(self, w, pane): self.vars[pane] = {'drawWaveform': 0, 'channel': 'all'} self.Info['debug'] = self.tk.eval('eval list $::wsurf::Info(debug)') def paneDeletedProc(self, w, pane): del self.vars[pane] def createWaveform(self, w, pane): _w = TkObject(self.master, w) _pane = TkObject(self.master, \ _w.addPane(before=pane, height=200, scrolled=0, \ scrollheight=200, unit="")) self.addWaveform(_w, _pane) def addWaveform(self, w, pane, **kws): # Use a dictionary for args. a = {'channel': 'all', 'fill': 'black', 'limit': '-1', 'predraw': '0', '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'} a.update(kws) v = self.vars[pane.name] v['channel'] = a['channel'] v['wavecolor'] = a['fill'] v['limit'] = a['limit'] v['preDraw'] = a['predraw'] v['sfftlen'] = a['sectfftlength'] v['swintype'] = a['sectwintype'] v['satype'] = a['sectanalysistype'] v['slpcorder'] = a['sectlpcorder'] v['spreemph'] = a['sectpreemphasis'] v['sref'] = a['sectreference'] v['srange'] = a['sectrange'] v['sall'] = a['sectdoall'] v['sexphead'] = a['sectexportheader'] v['subsample'] = a['subsample'] v['trimstart'] = a['trimstart'] v['rtpps'] = a['scrollspeed'] c = TkObject(self.master, pane.canvas()) s = TkObject(self.master, w.cget('-sound')) v['topfr'] = float(s.cget('-rate'))/2 try: if (int(a['channel']) in range(10) and \ int(a['channel']) > int(s.cget('-channels'))): chan = 'all' else: chan = a['channel'] except: chan = a['channel'] if (int(w.getInfo('isLinked2File'))): filename = w.getInfo('filename') c.create('waveform', 0, 0, anchor='w', sound=s, channel=chan, tags='[list waveform analysis]', fill=a['fill'], end=0, limit=v['limit'], trimstart=v['trimstart'], shapefile=w._shapeFilename(filename), debug=self.Info['debug']) else: c.create('waveform', 0, 0, anchor='w', sound=s, channel=chan, tags='[list waveform analysis]', fill=a['fill'], end=0, limit=v['limit'], trimstart=v['trimstart'], debug=self.Info['debug']) if (int(s.cget('-channels')) > 1): v['max'] = s.max(channel=v['channel']) v['min'] = s.min(channel=v['channel']) else: v['max'] = s.max() v['min'] = s.min() v['drawWaveform'] = 1 def redrawProc(self, w, pane): wsurf = TkObject(self.master, w) if wsurf.getInfo('isRecording') == '1': return _pane = TkObject(self.master, pane) c = TkObject(self.master, _pane.canvas()) s = TkObject(self.master, wsurf.getSound()) v = self.vars[pane] try: if (int(v['channel']) in range(10) and \ int(v['channel']) >= int(s.cget('channels'))): chan = 'all' else: chan = v['channel'] except: chan = v['channel'] if (int(v['drawWaveform'])): wh = int(_pane.cget('-scrollheight')) mid = float(wh)/2 maxtime = float(_pane.cget('-maxtime')) rate = float(s.cget('-rate')) pps = float(_pane.cget('-pixelspersecond')) cvx = float(c.canvasx(0.0)) if int(v['preDraw']) == 0: (fracLeft, fracRight) = map(lambda x: float(x), c.xview().split()) start = int(fracLeft * maxtime * rate + 1) end = int(fracRight * maxtime * rate + 1) len = end-start if (int(v['subsample']) and len > 1000000): sub = 30 elif (int(v['subsample']) and len > 100000): sub = 10 else: sub = 1 fi = cvx/pps * rate corr = (fi - int(fi))*pps / rate xpos = cvx-corr c.coords('waveform', xpos, mid) c.itemconfig('waveform', fill=v['wavecolor'], channel=chan, height=wh, pixelspersecond=pps, limit=v['limit'], trimstart=v['trimstart'], subsample=v['subsample'], start=start, end=end) else: c.coords('waveform', 0, mid) c.itemconfig('waveform', fill=v['wavecolor'], channel=chan, height=wh, pixelspersecond=pps, limit=v['limit'], start=0, end=-1) yc = TkObject(self.master, _pane.yaxis()) yc.delete('axis') yc.create('text', 0, 0, text=v['max'], font=_pane.cget('-yaxisfont'), anchor='nw', tags='[list axis max]', fill=_pane.cget('-yaxiscolor')) yc.create('text', 0, _pane.cget('-height'), text=v['min'], font=_pane.cget('-yaxisfont'), anchor='sw', tags='[list axis min]', fill=_pane.cget('-yaxiscolor')) def getBoundsProc(self, w, pane): _w = TkObject(self.master, w) _pane = TkObject(self.master, pane) v = self.vars[pane] s = TkObject(self.master, _w.cget('-sound')) if (int(v['drawWaveform'])): _max = max(int(s.max()), -int(s.min())) _min = min(int(s.min()), -int(s.max())) return 'list 0 %d %s %d' % (_min, s.length(units='seconds'), _max) else: return 'list' def scrollProc(self, w, pane, frac1, frac2): _w = TkObject(self.master, w) _pane = TkObject(self.master, pane) s = TkObject(self.master, _w.cget('-sound')) c = TkObject(self.master, _pane.canvas()) v = self.vars[pane] if (int(v['drawWaveform'])): wh = int(_pane.cget('-scrollheight')) mid = float(wh)/2 maxtime = float(_pane.cget('-maxtime')) rate = float(s.cget('-rate')) pps = float(_pane.cget('-pixelspersecond')) cvx = float(c.canvasx(0.0)) if int(v['preDraw']) == 0: start = int(float(frac1)*maxtime*rate+1) end = int(float(frac2)*maxtime*rate+1) len = end-start if (int(v['subsample']) and len > 1000000): sub = 30 elif (int(v['subsample']) and len > 100000): sub = 10 else: sub = 1 fi = cvx/pps * rate corr = (fi - int(fi))*pps / rate xpos = cvx-corr c.coords('waveform', xpos, mid) c.itemconfig('waveform', subsample=v['subsample'], start=start, end=end) wavesurfer-1.8.8p5/demos/embed.tcl000066400000000000000000000273301325326000200170530ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" # An example of how to embed WaveSurfer in a sound tool built using Snack. # See the last procedure. package require snack 2.2 set v(debug) 0 snack::sound snd -debug $v(debug) set v(rate) 16000 set v(width) 600 set v(height) 150 set v(pps) 10 set v(start) 0 set v(end) [snd length] set v(pausex) -1 set v(x0) 0 set v(fileName) "" set v(skip) 0 set v(rate) 16000 set v(sfmt) LIN16 set v(chan) 1 set v(byteOrder) "" wm protocol . WM_DELETE_WINDOW exit pack [set s [scrollbar .scroll -orient horiz -command Scroll]] -fill x $s set 0 1 #bind $s Redisplay pack [set c [canvas .c -width $v(width) -height $v(height) -highlightthi 0]] -expand yes -fill both $c create waveform 0 0 -sound snd -height $v(height) -width $v(width) -tag [list obj wave] -progress snack::progressCallback -debug $v(debug) if [string match macintosh $::tcl_platform(platform)] { $c create rect -1 -1 -1 -1 -tags mark -width 2 -outline red } else { $c create rect -1 -1 -1 -1 -tags mark -fill yellow -stipple gray25 \ -width 2 -outline red } $c create line -1 -1 -1 -1 -fill red -tags playmark bind $c { Button1Press %x } bind $c { Button1Release } bind $c Reconfigured bind $c ClearMark pack [frame .f] -side bottom -before $c -fill x pack [button .f.pl -bitmap snackPlay -command {Play 0}] -side left pack [button .f.pa -bitmap snackPause -command Pause] -side left pack [button .f.st -bitmap snackStop -command Stop] -side left snack::createIcons pack [button .f.op -image snackOpen -command LoadSound] -side left pack [button .f.zi -image snackZoomIn -command ZoomIn] -side left pack [button .f.zo -image snackZoomOut -command ZoomOut] -side left pack [button .f.ws -text OpenWS -command OpenWaveSurferWindow] -side left pack [radiobutton .f.rs -text Spectrogram -command DrawSpectrogram -val 1] -side left pack [radiobutton .f.rw -text Waveform -command DrawWaveform -val ""] -side left pack [label .f.l -textvar v(time)] -side left proc ZoomIn {} { global v c s set co [$c coords mark] set start [expr int($v(start) + double($v(rate)) * [lindex $co 0] / $v(pps))] set end [expr int($v(start) + double($v(rate)) * [lindex $co 2] / $v(pps))] if {$start == $end || [snd length] == 0} return # Update scrollbar $s set [expr double($start)/[snd length]] [expr double($end)/[snd length]] set v(pps) [expr $v(width) / (double($end - $start) / $v(rate))] set v(start) $start set v(end) $end ClearMark Redisplay } proc ZoomOut {} { global v c s set n 2.0 set delta [expr int($v(rate) * $v(width) / $v(pps))] set start [expr int($v(start)-($n-1)/2*$delta)] set end [expr int($v(start)+$delta+($n-1)/2*$delta)] if {$start < 0} { set start 0 } if {$end > [snd length]} { set end [snd length] } if {$start == $end} return # Update scrollbar $s set [expr double($start)/[snd length]] [expr double($end)/[snd length]] set v(pps) [expr $v(width) / (double($end - $start) / $v(rate))] set v(start) $start set v(end) $end ClearMark Redisplay } proc Scroll args { global v s set delta [expr int($v(rate) * $v(width) / $v(pps))] if {[lindex $args 0] == "moveto"} { set v(start) [expr int([snd length] * [lindex $args 1])] } elseif {[lindex $args 0] == "scroll"} { if {[lindex $args 1] > 0} { set v(start) [expr $v(start)+$delta] } else { set v(start) [expr $v(start)-$delta] } } if {$v(start) < 0} { set v(start) 0 } if {[expr $v(start)+$delta] > [snd length]} { set v(start) [expr [snd length]-$delta] } set v(end) [expr $v(start)+$delta] # Update scrollbar $s set [expr double($v(start))/[snd length]] [expr double($v(end))/[snd length]] ClearMark Redisplay } proc Redisplay {} { global v c # Display section [$start, $end] of the sound $c itemconf obj -start $v(start) -end $v(end) } proc Button1Press {x} { global c set xc [$c canvasx $x] $c raise mark $c coords mark $xc 0 $xc [expr [winfo height $c]-2] bind $c { Button1Motion %x } } proc Button1Motion {x} { global c set xc [$c canvasx $x] if {$xc < 0} { set xc 0 } if {$xc > [winfo width $c]} { set xc [winfo width $c] } set co [$c coords mark] $c coords mark [lindex $co 0] 0 $xc [expr [winfo height $c]-2] ShowTime } proc Button1Release {} { global c bind $c {} ShowTime } proc DrawSpectrogram {} { global v c $c delete obj set colors {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \ #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00} $c create spectrogram 0 0 -sound snd -height [winfo height $c] \ -width [winfo width $c] -start $v(start) -end $v(end) \ -colormap $colors -tag obj -debug $v(debug) $c lower obj } proc DrawWaveform {} { global v c $c delete obj if {$v(fileName) == ""} { $c create waveform 0 0 -sound snd -height [winfo height $c] \ -debug $v(debug) -width [winfo width $c] -tag [list obj wave] } else { snack::deleteInvalidShapeFile [file tail $v(fileName)] $c create waveform 0 0 -sound snd -height [winfo height $c] \ -debug $v(debug) \ -width [winfo width $c] -start $v(start) -end $v(end) \ -tag [list obj wave] -progress snack::progressCallback snack::makeShapeFileDeleteable [file tail $v(fileName)] } $c lower obj } proc LoadSound {} { global v c s set fileName [snack::getOpenFile] if {$fileName == ""} return $c itemconf wave -sound "" set tmps [snack::sound] set ffmt [$tmps read $fileName -end 1 -guessproperties 1] if {$ffmt == "RAW"} { set v(rate) [$tmps cget -rate] set v(sfmt) [$tmps cget -encoding] set v(chan) [$tmps cget -channels] set v(byteOrder) [$tmps cget -byteorder] if {[InterpretRawDialog] == "cancel"} { $tmps destroy return } } $tmps destroy snd config -file $fileName -skip $v(skip) \ -rate $v(rate) -encoding $v(sfmt) -channels $v(chan) \ -byteorder $v(byteOrder) set v(rate) [snd cget -rate] set v(start) 0 set v(end) [snd length] set v(pps) [expr $v(width) / (double($v(end) - $v(start)) / $v(rate))] set v(fileName) $fileName # Update scrollbar $s set 0.0 1.0 wm title . [file tail $fileName] snack::deleteInvalidShapeFile [file tail $fileName] $c itemconf wave -sound snd -start $v(start) -end $v(end) \ -shapefile [file rootname [file tail $fileName]].shape snack::makeShapeFileDeleteable [file tail $fileName] Redisplay ShowTime } proc InterpretRawDialog {} { global v set w .rawDialog toplevel $w -class Dialog frame $w.q pack $w.q -expand 1 -fill both -side top pack [frame $w.q.f1] -side left -anchor nw -padx 3m -pady 2m pack [frame $w.q.f2] -side left -anchor nw -padx 3m -pady 2m pack [frame $w.q.f3] -side left -anchor nw -padx 3m -pady 2m pack [frame $w.q.f4] -side left -anchor nw -padx 3m -pady 2m pack [label $w.q.f1.l -text "Sample Rate"] foreach e [snack::audio rates] { pack [radiobutton $w.q.f1.r$e -text $e -val $e -var ::v(rate)]\ -anchor w } pack [label $w.q.f2.l -text "Sample Encoding"] foreach e [snack::audio encodings] { pack [radiobutton $w.q.f2.r$e -text $e -val $e -var ::v(sfmt)]\ -anchor w } pack [label $w.q.f3.l -text Channels] pack [radiobutton $w.q.f3.r1 -text Mono -val 1 -var ::v(chan)] -anchor w pack [radiobutton $w.q.f3.r2 -text Stereo -val 2 -var ::v(chan)] -anchor w pack [radiobutton $w.q.f3.r4 -text 4 -val 4 -var ::v(chan)] -anchor w pack [entry $w.q.f3.e -textvariable ::v(chan) -width 3] -anchor w pack [label $w.q.f4.l -text "Byte Order"] pack [radiobutton $w.q.f4.ri -text "Little Endian\n(Intel)" \ -value littleEndian -var ::v(byteOrder)] -anchor w pack [radiobutton $w.q.f4.rm -text "Big Endian\n(Motorola)" \ -value bigEndian -var ::v(byteOrder)] -anchor w pack [label $w.q.f4.l2 -text "\nRead Offset (bytes)"] pack [entry $w.q.f4.e -textvar v(skip) -wi 6] snack::makeDialogBox $w -title "Interpret Raw File As" -type okcancel } proc ClearMark {} { global c $c coords mark -1 -1 -1 -1 ShowTime } proc Reconfigured {} { global v c if {$v(end) == $v(start)} return set co [$c coords mark] if {[lindex $co 0] != -1} { set start [expr int($v(start) + double($v(rate))*[lindex $co 0] / $v(pps))] set end [expr int($v(start) + double($v(rate))*[lindex $co 2] / $v(pps))] set x0temp [expr int($v(start) + double($v(rate))*$v(x0) / $v(pps))] } set newHeight [winfo height $c] set newWidth [winfo width $c] $c itemconf obj -height $newHeight -width $newWidth set v(pps) [expr $newWidth / (double($v(end) - $v(start)) / $v(rate))] set v(width) $newWidth set v(height) $newHeight if {[lindex $co 0] != -1} { set left [expr double($start - $v(start))/$v(rate)*$v(pps)] set right [expr double($end - $v(start))/$v(rate)*$v(pps)] set v(x0) [expr double($x0temp - $v(start))/$v(rate)*$v(pps)] $c coords mark $left 0 $right [expr [winfo height $c]-2] } } proc Play x { global v c s snd stop set c0 [lindex [$c coords mark] 0] set c2 [lindex [$c coords mark] 2] if {$x == 0} { set x $c0 if {$c0 == -1} { set l $v(start) set r $v(end) } elseif {$c0 == $c2} { set l [expr int($v(start) + double($v(rate)) * $c0 / $v(pps))] set r $v(end) } else { set l [expr int($v(start) + double($v(rate)) * $c0 / $v(pps))] set r [expr int($v(start) + double($v(rate)) * $c2 / $v(pps))] } } else { if {$c0 == $c2} { set l [expr int($v(start) + double($v(rate)) * $x / $v(pps))] set r $v(end) } else { set l [expr int($v(start) + double($v(rate)) * $x / $v(pps))] set r [expr int($v(start) + double($v(rate)) * $c2 / $v(pps))] } } snd play -start $l -end $r after 0 PutPlayMarker $x } proc Pause {} { global v if [snack::audio active] { set v(pausex) [expr $v(x0) + $v(pps) * [snack::audio elapsedTime]] snd stop } elseif {$v(pausex) != -1} { Play $v(pausex) } } proc Stop {} { global v snd stop set v(pausex) -1 } proc PutPlayMarker args { global v c if ![snack::audio active] { $c coords playmark -1 -1 -1 -1 ShowTime return } if {$args != ""} { set v(x0) [lindex $args 0] } set x [expr $v(x0) + $v(pps) * [snack::audio elapsedTime]] set co [$c coords mark] if {[lindex $co 0] != [lindex $co 2] && $x > [lindex $co 2]} { $c coords playmark -1 -1 -1 -1 ShowTime return } $c coords playmark $x 0 $x $v(height) after 50 PutPlayMarker set time [expr int($v(start) + double($v(rate)) * $x / $v(pps))] set v(time) "Time: [SampleIndex2Time $time]" } proc ShowTime {} { global v c set co [$c coords mark] set start [expr int($v(start) + double($v(rate)) * [lindex $co 0] / $v(pps))] set end [expr int($v(start) + double($v(rate)) * [lindex $co 2] / $v(pps))] if {[lindex $co 0] < 0.0} { set v(time) "Length: [SampleIndex2Time [snd length -unit samples]]" return } set v(t1) [SampleIndex2Time $start] set v(t2) [SampleIndex2Time $end] if {$end == $start} { set v(time) "Time: $v(t1)" return } set v(time) "\[$v(t1)-$v(t2)\]" } proc SampleIndex2Time index { global v set sec [expr int($index / $v(rate))] set dec [format "%.2d" [expr int(100*((double($index) / $v(rate))-$sec))]] return [clock format $sec -format "%M:%S.$dec"] } LoadSound proc OpenWaveSurferWindow {} { catch {destroy .ws} toplevel .ws wm title .ws "WaveSurfer window" set ::auto_path [concat [file dirname [pwd]parent] $::auto_path] package require -exact wsurf 1.8 set w [wsurf .ws.ws -sound snd -collapser 0 -icons {play pause stop}] pack $w -expand 0 -fill both } wavesurfer-1.8.8p5/demos/speecon.tcl000066400000000000000000000240231325326000200174270ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" # This tool was developed to verify and correct the Swedish part # of the SPEECON database # http://www.speecon.com/ # Lots of magic stuff going on here don't worry unless you have to # # wrapit.tcl will insert code here to set the elements of the wrap() array catch {package require Tk} if {[info exists wrap]} { # package dirs have to be listed explicitly for wrapping # a line setting wrapdir is added by the wrapping script set dir $wrap(dir) set auto_path "[file join $dir snack] [file join $dir wsurf] $auto_path" } else { set auto_path [concat [list [file dirname [info script]]] \ [file dirname [pwd]parent] $auto_path] } package require surfutil # re-define load to work with free-wrap if {[info exists wrap] && [info command _load]==""} { rename load _load proc load {filename args} { set f [open $filename] fconfigure $f -encoding binary -translation binary set data [read $f] close $f set fname2 [file join [util::tmpdir] [file rootname [file tail $filename]].[pid]] set f [open $fname2 w] fconfigure $f -encoding binary -translation binary puts -nonewline $f $data close $f eval _load $fname2 $args } } # End of magic package require wsurf 1.8 if {[info exists wrap]} { rename load "" rename _load load } ::wsurf::Initialize # Create and pack one wsurf widget and add a waveform pane set w [wsurf .ws -collapser 0 -icons {play pause stop} -playpositionproc playpos] pack $w -expand 0 -fill both set pane [$w addPane -maxheight 2048 -minheight 10 -height 120] $w analysis::addWaveform $pane lappend ::wsurf::Info(Prefs,rawFormats) .SE0 16000 LIN16 1 littleEndian 0 .SE1 16000 LIN16 1 littleEndian 0 .SE2 16000 LIN16 1 littleEndian 0 .SE3 16000 LIN16 1 littleEndian 0 set info "" pack [frame .if] pack [label .if.l -textvariable ::info] -side left pack [button .if.b -command ShowInfo -text "Show all"] -side left pack [frame .f] -expand 1 -fill both pack [scrollbar .f.sb -orient vert -command [list .f.t yview]] \ -side right -fill y pack [text .f.t -width 60 -height 3 -font "helvetica 18" -wrap word -yscrollcommand [list .f.sb set] -exportselection 0] -side right -expand 1 -fill both pack [frame .bf] pack [button .bf.b11 -text {[sta]} -command [list Ins {[sta]}] -width 5] -side left pack [button .bf.b12 -text {[int]} -command [list Ins {[int]}] -width 5] -side left pack [button .bf.b13 -text {[fil]} -command [list Ins {[fil]}] -width 5] -side left pack [button .bf.b14 -text {[spk]} -command [list Ins {[spk]}] -width 5] -side left pack [button .bf.b1 -text < -command Prev -width 5] -side left pack [button .bf.b2 -text Pause -command [list $w pause] -width 5] -side left pack [button .bf.b3 -text Play -command [list $w play] -width 5] -side left pack [button .bf.b4 -text Replay -command Replay -width 6] -side left pack [button .bf.b5 -text > -command Next -width 5] -side left pack [button .bf.b6 -text Decap -command Decap -width 5] -side left bind . [list $w play] bind . Replay bind . [list $w pause] bind . Prev bind . Next bind . Decap bind . [list Ins {[sta]}] bind . [list Ins {[int]}] bind . [list Ins {[fil]}] bind . [list Ins {[spk]}] pack [frame .f2] listbox .f2.lb -yscrollcommand [list .f2.sb set] -width 20 -height 7 bind .f2.lb <> Select scrollbar .f2.sb -orient vertical -command [list .f2.lb yview] pack .f2.sb -side right -expand 1 -fill y pack .f2.lb -side right -expand 1 -fill both proc Ins {sym} { .f.t insert insert " $sym " } proc Decap {} { set str [string trim [.f.t get 0.0 end]] set str [string tolower $str 0 1] .f.t delete 0.0 end .f.t insert 0.0 $str .f.t mark set insert 0.0 } proc Select {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save if {[.f2.lb curselection] != ""} { set ::index [.f2.lb curselection] Load } } proc Prev {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save incr ::index -1 Load } proc Next {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save incr ::index Load } proc playpos {m pos} { set ::playpos $pos } proc Replay {} { set ::playpos [expr $::playpos - 2.0] $::w play $::playpos -1 } proc Load {} { set labelfile [lindex $::files $::index] if {$labelfile == ""} { if {$::index < 0} { set ::index 0 } if {$::index >= [llength $::files]} { set ::index [expr [llength $::files]-1] } return } set f [open $labelfile] fconfigure $f -encoding binary set ::data [string trim [read $f]] close $f set ::text _junk set ::lineno 0 foreach line [split $::data \n] { regsub -all {\.|!|;} $line " " line # regexp {LBO:\s[\d\,]*\s([\*\~\[\]\w\s\-\.\:\@]*)} $line dummy ::text if {[regexp {SEX:\s(.*)} $line dummy tmp]} { set ::info $tmp } if {[regexp {AGE:\s(.*)} $line dummy tmp]} { append ::info ", $tmp" } if {[regexp {ACC:\s(.*)} $line dummy tmp]} { append ::info ", $tmp" } if {[regexp {SCC:\s(.*)} $line dummy tmp]} { append ::info ", $tmp" } regexp {LBO:\s[\d\,]*\s(.*)} $line dummy ::text if {[string compare $::text _junk] != 0} { if {[string match {*\?\?*} $line]} { set prompt 1 } regsub -all {\?|,} $::text "" ::text break } incr ::lineno } .f.t delete 0.0 end if {[string compare $::text _junk] == 0} { set ::text "" } regsub -all {_} $::text " " ::text2 regsub -all {noise rec} $::text2 "noise_rec" ::text2 regsub -all {silence word} $::text2 "silence_word" text .f.t insert 0.0 $text .f.t mark set insert 0.0 if {[info exists prompt]} { focus .f.t .f.t tag add sel 0.0 end } set sndfile [glob -nocomplain [file root $labelfile].??$::mic] $::w openFile $sndfile $::w configure -selection [list 0.0 0.0] update $::w xzoom 0.0 1.0 $::w play .f2.lb selection clear 0 end .f2.lb selection set $::index .f2.lb see $::index } proc UpdateSound {} { set labelfile [lindex $::files $::index] set sndfile [glob -nocomplain [file root $labelfile].??$::mic] $::w openFile $sndfile } proc ShowInfo {} { catch {destroy .info} toplevel .info pack [text .info.t -height 40] .info.t insert 0.0 $::data } proc Save {} { set labelfile [lindex $::files $::index] if {$labelfile == ""} return if {[file exists [file root $labelfile].BAK] == 0} { file rename $labelfile [file root $labelfile].BAK } set f [open $labelfile w] fconfigure $f -translation crlf -encoding binary set i 0 foreach line [split $::data \n] { if {$i == $::lineno} { regsub {LBO:\s([\d\,]*)\s.*} $line {LBO: \1 } out set text [string trim [.f.t get 0.0 end]] regsub -all {\.|!|\?|;} $text " " text regsub -all {\s+} $text " " text puts $f $out$text } else { puts $f $line } incr i } close $f } proc SelectVerif {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save .f.t delete 0.0 end for {set i 0} {$i < [.tl.f2.lb size]} {incr i} { .tl.f2.lb itemconf $i -background "" } set i [.tl.f2.lb curselection] .tl.f2.lb itemconf $i -background white if {$i != ""} { update NewSession [.tl.f2.lb get $i] set ::listboxIndex $i } } proc NextVerif {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save .f.t delete 0.0 end for {set i 0} {$i < [.tl.f2.lb size]} {incr i} { .tl.f2.lb itemconf $i -background "" } incr ::listboxIndex .tl.f2.lb itemconf $::listboxIndex -background white if {$::listboxIndex != ""} { update NewSession [.tl.f2.lb get $::listboxIndex] .tl.f2.lb see $::listboxIndex } } proc OpenVerif {} { set ::listboxIndex 0 set file [tk_getOpenFile -title "Open error file"] # set file ~/junk.txt set fd [open $file] set lines [read -nonewline $fd] close $fd foreach row [split $lines \n] { scan $row "%s %s" filename junk .tl.f2.lb insert end $filename } } proc Verification {} { catch {destroy .tl} toplevel .tl list { .bf.b1 configure -state disabled .bf.b5 configure -state disabled bind . "" bind . "" } pack [frame .tl.f2] -expand 1 -fill both listbox .tl.f2.lb -yscrollcommand [list .tl.f2.sb set] -width 80 -height 17 bind .tl.f2.lb <> SelectVerif scrollbar .tl.f2.sb -orient vertical -command [list .tl.f2.lb yview] pack .tl.f2.sb -side right -expand 1 -fill y pack .tl.f2.lb -side right -expand 1 -fill both pack [frame .tl.f3] pack [button .tl.f3.b1 -text Open... -command OpenVerif] -side left pack [button .tl.f3.b2 -text Next -command NextVerif] -side left #OpenVerif } proc NewSession {path} { if {[string match *.SEO $path]} { list { # slow set fileroot [file root [file tail $path]] set path [file dirname $path] set i [lsearch [lsort [glob -nocomplain $path/*.??0]] *$fileroot.SE0] set ::index [expr $i-1] } set i 0 set ::index -1 wm title . "Speaker: [file tail $path]" .f2.lb delete 0 end .f2.lb insert end $path .f2.lb selection set $i set ::files $path set ::text "" Next return } else { set i 0 set ::index -1 } wm title . "Speaker: [file tail $path]" .f2.lb delete 0 end set ::files [lsort [glob -nocomplain $path/*.??O]] foreach filename $::files { .f2.lb insert end [file root [file tail $filename]] } .f2.lb selection set $i set ::text "" Next } pack [frame .cf] pack [button .cf.b -text "Choose speaker..." -command Choose] \ -side left pack [label .cf.l -text Mic] -side left set mic 0 tk_optionMenu .cf.om mic 0 1 2 3 for {set n 0} {$n < 4} {incr n} { .cf.om.menu entryconfigure $n -command UpdateSound } pack .cf.om -side left pack [button .cf.b2 -text Verification -command Verification] -side left proc Choose {} { if {[string compare $::text [string trim [.f.t get 0.0 end]]]} Save if {[llength [file split $::path]] > 1} { set pathlist [file split $::path] set pathlist [lrange $pathlist 0 [expr [llength $pathlist]-2]] set initpath [eval file join $pathlist] } else { set initpath "" } set ::path [tk_chooseDirectory -title "Choose Speaker Directory" -initialdir $initpath] NewSession $::path } set files "" set index -1 set text "" set path "" if {$argv != ""} { set path $argv NewSession $path } update focus .f.t .f.t mark set insert end wm withdraw . update wm deiconify . wavesurfer-1.8.8p5/demos/wsapp1.py000066400000000000000000000013631325326000200170560ustar00rootroot00000000000000""" Minimal example of a python application using the wsurf widget. """ from Tkinter import * from Wsurf import * root=Tk() root.tk.eval('package require -exact wsurf 1.8') def load(): file = root.tk.eval('snack::getOpenFile') ws.openFile(file) # Some random commands def stuff(): ws.xscroll('moveto',0.01) ws.configure(selection='1.00 3.00') ws.configure(title='Test') ws.play(1.00,3.00) print ws.cget('selection') # Pack a wsurf widget ws=Wsurf(root,title='ABC',configuration='') ws.pack(expand='yes',fill='both') # Create minimal user interface f0 = Frame(root) f0.pack(pady=5) Button(f0, image='snackOpen', command=load).pack(side='left') Button(f0, text='Foo', command=stuff).pack(side='left') root.mainloop() wavesurfer-1.8.8p5/demos/wsapp1.tcl000066400000000000000000000012041325326000200172020ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of a custom application using the wsurf widget. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 # Create and pack one wsurf widget set w [wsurf .ws -collapser 0 -icons {play pause stop record}] pack $w -expand 0 -fill both # Try to load the first sound file given on the command line $w openFile [lindex $argv 0] wavesurfer-1.8.8p5/demos/wsapp2.tcl000066400000000000000000000020641325326000200172100ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of a custom application using the wsurf widget. # # This example shows how to make the wsurf widget link to a file # on disk instead of loading all sound data into memory. # The first time a sound file is accessed a .shape file is created # which contains coarse waveform information. This make accessing this # file much faster in the future. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 # Initialize wsurf package (this will set default preferences) ::wsurf::Initialize # Link to disk file wsurf::SetPreference linkFile 1 # Create and pack one wsurf widget set w [wsurf .ws -collapser 0 -progressproc snack::progressCallback] pack $w -expand 0 -fill both # Prompt the user for a sound file and open it $w openFile [snack::getOpenFile] wavesurfer-1.8.8p5/demos/wsapp3.tcl000066400000000000000000000024621325326000200172130ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of a custom application using the wsurf widget. # # This example shows how to create a wsurf widget and how to add one # waveform pane and a time axis pane. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 # Initialize wsurf package (this will set default preferences) ::wsurf::Initialize # Make widget scroll during playback wsurf::SetPreference autoScroll Page # Create and pack one wsurf widget set widget [wsurf .ws -collapser 0 -icons [list beg play playloop pause stop record zoomin zoomout]] pack $widget -expand 0 -fill both # Add a couple of panes and some content from the standard plug-ins # These lines have been copied from the standard Waveform configuration, # ../wsurf1.8/configurations/Waveform.conf set pane [$widget addPane -maxheight 2048 -minheight 10] $widget analysis::addWaveform $pane set pane [$widget addPane -maxheight 20 -minheight 20] $widget timeaxis::addTimeAxis $pane # Prompt the user for a sound file and open it $widget openFile [snack::getOpenFile] wavesurfer-1.8.8p5/demos/wsapp4.tcl000066400000000000000000000041571325326000200172170ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 ::wsurf::Initialize # Create and pack one wsurf widget using a Waveform configuration set ind [lsearch [::wsurf::GetConfigurations] *Waveform*] set conf [lindex [::wsurf::GetConfigurations] $ind] set w [wsurf .ws -collapser 0 -icons {play pause stop} -configuration $conf] pack $w -expand 0 -fill both # Create a simple user interface (one listbox and one button) pack [frame .f] listbox .f.lb -yscrollcommand [list .f.sb set] -width 90 bind .f.lb <> Select scrollbar .f.sb -orient vertical -command [list .f.lb yview] pack .f.sb -side right -expand 1 -fill y pack .f.lb -side right -expand 1 -fill both pack [button .b -text Open -command Open] # Create binding for spacebar to play selection bind . [list $w play] # This procedure is called whenever a selection in the listbox is made proc Select {} { # Get filename from selection and load the sound set index [.f.lb curselection] set filename [lindex [.f.lb get $index] 0] if {![file readable $filename]} { tk_messageBox -message "No such file: $filename" return } $::w openFile $filename # Get start and end values and set the wsurf widgets's selection set start [lindex [.f.lb get $index] 1] set end [lindex [.f.lb get $index] 2] $::w configure -selection [list $start $end] $::w xzoom 0.0 1.0 } # Open a new text file containing filenames and segment times proc Open {} { .f.lb delete 0 end set filename [tk_getOpenFile] set f [open $filename] set text [read $f] foreach line [split $text \n] { regsub -all {\t} $line " " tmp .f.lb insert end $tmp } close $f } # Insert a couple of example lines to start off with .f.lb insert end "ex1.wav 0.1 0.2" .f.lb insert end "ex1.wav 0.3 0.5" .f.lb insert end "ex2.wav 0.2 0.4" .f.lb insert end "ex2.wav 0.5 0.6" wavesurfer-1.8.8p5/demos/wsapp5.tcl000066400000000000000000000046501325326000200172160ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of a custom application using the wsurf widget. # # This example shows how to create a wsurf widget and how to add a # waveform pane, a time axis pane, and an empty visualization pane, # where custom graphics can be put. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 # Initialize wsurf package (this will set default preferences) ::wsurf::Initialize # Make widget scroll during playback set scroll Scroll wsurf::SetPreference autoScroll $scroll # Create and pack one wsurf widget set widget [wsurf .ws -collapser 0 -icons [list beg play pause stop zoomin zoomout zoomall zoomsel]] pack $widget -expand 0 -fill both # Add a couple of panes and some content from the standard plug-ins # These lines have been copied from the standard Waveform configuration, # ../wsurf1.8/configurations/Waveform.conf set pane [$widget addPane -maxheight 2048 -minheight 10] $widget analysis::addWaveform $pane set pane [$widget addPane -maxheight 20 -minheight 20] $widget timeaxis::addTimeAxis $pane # Create a pane for custom drawing, keep track of its name in $myPane set myPane [$widget addPane -height 100] # Procedure that draws something in our pane (only) proc Redraw {w pane} { if {$pane == $::myPane} { set c [$pane canvas] set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] set height [$pane cget -scrollheight] $c delete all $c create line 0 0 $width $height } } # Register the "Redraw" procedure with the wsurf library. # Every time the user zooms in or out with the wavebar "Redraw" # will be called in order to update the contents of our pane. wsurf::RegisterPlugin wsapp5 wsurf::ExecuteRegisterPlugin wsapp5 -redrawproc Redraw # Prompt the user for a sound file, open it and draw something simple proc Load {} { $::widget openFile [snack::getOpenFile] } # Create some buttons at the bottom of the window snack::createIcons pack [button .a -image snackOpen -command Load] -side left foreach type [list None Page Scroll] { pack [radiobutton .r$type -text $type -value $type -variable scroll \ -command [list wsurf::SetPreference autoScroll $type]] -side left } wavesurfer-1.8.8p5/demos/wsapp6.tcl000066400000000000000000000025331325326000200172150ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of how to link two wsurf widgets. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 ::wsurf::Initialize wsurf::SetPreference yaxisWidth 0 # Create and pack two wsurf widgets using Waveform configurations set ind [lsearch [::wsurf::GetConfigurations] *Waveform*] set conf [lindex [::wsurf::GetConfigurations] $ind] set w1 [wsurf .w1 -collapser 0 -configuration $conf -icons [list play pause stop zoomin zoomout]] grid forget $w1.workspace.wavebar.c0 pack $w1 -expand 0 -fill both set w2 [wsurf .w2 -collapser 0 -configuration $conf -icons [list play pause stop zoomin zoomout]] pack $w2 -expand 0 -fill both # Make the widgets control each other $w1 configure -slaves $w2 $w2 configure -slaves $w1 # Create some buttons at the bottom of the window snack::createIcons pack [label .a -text Top:] -side left pack [button .b -image snackOpen \ -command {$w1 openFile [snack::getOpenFile]}] -side left pack [label .c -text Bottom:] -side left pack [button .d -image snackOpen \ -command {$w2 openFile [snack::getOpenFile]}] -side left wavesurfer-1.8.8p5/demos/wsapp7.tcl000066400000000000000000000040221325326000200172110ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # This examples allows two versions of a sound file to be loaded. # The play button at the bottom of the GUI will start playback on # both files simultaneously, but the second one will be muted. # The 'Select' buttons can now be used to switch # between the sound files while playback is proceeding. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 ::wsurf::Initialize # Create and pack two wsurf widgets using Waveform configurations set ind [lsearch [::wsurf::GetConfigurations] *Waveform*] set conf [lindex [::wsurf::GetConfigurations] $ind] set w1 [wsurf .w1 -collapser 0 -configuration $conf -icons [list play pause stop]] pack $w1 -expand 0 -fill both set w2 [wsurf .w2 -collapser 0 -configuration $conf -icons [list play pause stop]] pack $w2 -expand 0 -fill both # Make the widgets control each other $w1 configure -slaves $w2 $w2 configure -slaves $w1 # Create some buttons at the bottom of the window snack::createIcons pack [label .a -text Top:] -side left pack [button .b -image snackOpen \ -command {$w1 openFile [snack::getOpenFile]}] -side left pack [label .c -text Bottom:] -side left pack [button .d -image snackOpen \ -command {$w2 openFile [snack::getOpenFile]}] -side left pack [button .e -bitmap snackPlay -command SyncPlay] -side left pack [label .f -text "Fade to:"] -side left pack [button .g -text "top" -command [list SwapPlay 1]] -side left pack [button .h -text "bottom" -command [list SwapPlay 2]] -side left proc SyncPlay {} { $::w1 play set ::wsurf::Info(ActiveSound) "" $::w2 play } proc SwapPlay {selectWidget} { if {$selectWidget == 1} { $::w1 configure -playmapfilter 1 $::w2 configure -playmapfilter 0 } else { $::w1 configure -playmapfilter 0 $::w2 configure -playmapfilter 1 } } SwapPlay 1 wavesurfer-1.8.8p5/demos/wsapp8.tcl000066400000000000000000000051141325326000200172150ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish8.4 "$0" "$@" catch {package require Tk} # Minimal example of a custom application using the wsurf widget. # # This example shows how to create a wsurf widget and how to add a # waveform pane, a time axis pane, and an empty visualization pane, # where custom graphics can be put. # Search for wsurf package one level above this script's directory # This is for easy testing purposes when wsurf has not been installed set auto_path [concat [file join [file dirname [info script]] ..] $auto_path] package require -exact wsurf 1.8 # Initialize wsurf package (this will set default preferences) ::wsurf::Initialize # Make widget scroll during playback set scroll Page wsurf::SetPreference autoScroll $scroll # Create and pack one wsurf widget set widget [wsurf .ws -collapser 0] pack $widget -expand 0 -fill both # Add a couple of panes and some content from the standard plug-ins # These lines have been copied from the standard Waveform configuration, # ../wsurf1.8/configurations/Waveform.conf set pane [$widget addPane -maxheight 2048 -minheight 10 -state disabled] $widget analysis::addWaveform $pane set pane [$widget addPane -maxheight 20 -minheight 20] $widget timeaxis::addTimeAxis $pane # Create a pane for custom drawing, keep track of its name in $myPane set myPane [$widget addPane -height 100] # Procedure that draws something in our pane (only) proc Redraw {w pane} { if {$pane == $::myPane} { set c [$pane canvas] set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] set height [$pane cget -scrollheight] $c delete all $c create line 0 0 $width $height } } proc Scroll {w pane a b} { puts "Scroll $a $b" } proc Cursor {w pane a b} { puts "Cursor $a $b" } proc Selection {w pane a b} { puts "Selection $a $b" } # Register a few procedures with the wsurf library. # Every time the user scrolls, makes a selection or moves the cursor # a corresponding procedure will be called. wsurf::RegisterPlugin wsapp8 wsurf::ExecuteRegisterPlugin wsapp8 \ -redrawproc Redraw \ -scrollproc Scroll \ -cursormovedproc Cursor \ -setselectionproc Selection # Prompt the user for a sound file, open it and draw something simple proc Load {} { $::widget openFile [snack::getOpenFile] } # Create some buttons at the bottom of the window snack::createIcons pack [button .a -image snackOpen -command Load] -side left pack [checkbutton .b -text "Play scroll" -variable scroll \ -onvalue Page -offvalue None \ -command {wsurf::SetPreference autoScroll $scroll}] -side left wavesurfer-1.8.8p5/demos/wsplugapp.py000066400000000000000000000020571325326000200176660ustar00rootroot00000000000000""" Minimal example of a python application using the wsurf widget and wsurf plugins. The code is copied from wsapp1.py, with just the additional sample plugin """ from Tkinter import * from Wsurf import * from WsurfPlugin import SamplePlugin root=Tk() root.tk.eval('package require -exact wsurf 1.8') def load(): file = root.tk.eval('snack::getOpenFile') ws.openFile(file) # Some random commands def stuff(): ws.xscroll('moveto',0.01) ws.configure(selection='1.00 3.00') ws.configure(title='Test') ws.play(1.00,3.00) print ws.cget('selection') # Pack a wsurf widget #ws=Wsurf(root,title='ABC',configuration='/tmp/wavesurfer-1.0.3/wsurf1.0/configurations/Waveform.conf') ws=Wsurf(root,title='ABC',configuration='') ws.pack(expand='yes',fill='both') # Instantiate a plugin and register it. plugin=SamplePlugin() plugin.register(ws) # Create minimal user interface f0 = Frame(root) f0.pack(pady=5) Button(f0, image='snackOpen', command=load).pack(side='left') Button(f0, text='Foo', command=stuff).pack(side='left') root.mainloop() wavesurfer-1.8.8p5/doc/000077500000000000000000000000001325326000200147245ustar00rootroot00000000000000wavesurfer-1.8.8p5/doc/plugin-api.html000066400000000000000000000276571325326000200177000ustar00rootroot00000000000000

WaveSurfer Plug-in API

WaveSurfer plug-ins are implemented in Tcl/Tk as a collection of procedures. During startup, the application will search certain system and user directories for plug-in scripts, and source them into the interpreter. The plugin script file must contain a call to the following procedure: wsurf::RegisterPlugin name ?option value? ... name is the name of the plug-in. Many of the options are used to associate event callbacks to procedures in the plug-in implementation. Note that the plug-in does not need to implement all callbacks, only the ones that are relevant to its functionality. It is advisable for all plug-ins to exist in their own namespace, with the same name as the plugin.

Most callbacks are invoked with the current widget as the first argument, and in the cases where the event refers to a pane, the pane window name will be the second argument.

Options to RegisterPlugin

-description

Specifies a textual description of the plugin's functionality. It will be displayed in plug-ins page of the preferences dialog.

-url

Specify a home page URL for the plugin. It will be displayed in plug-ins page of the preferences dialog.

-addmenuentriesproc

Specifies a callback procedure to be invoked when a context sensitive popup menu is created for a pane. This will allow the plug-in to add entries to the menu at the time it is posted. Callback syntax:

callback widget pane menu subMenu x y

menu refers to the window name of the popup menu widget, subMenu is an identifier of a sub-menu, can be create or an empty string. x and y refers to the coordinates where the menu button was pressed.

-applypropertiesproc

Specifies a callback procedure to be invoked to apply the current values in the properties dialog. Callback syntax:

callback widget pane

-copyproc

Specifies a callback procedure to be invoked when a copy operation is performed in the widget. Callback syntax:

callback widget start end

start and <end> are given in seconds as floating point numbers.

-cursormovedproc

Specifies a callback procedure to be invoked when the cursor is moved. Callback syntax:

callback widget pane time value

time is the cursor position along the time axis, in seconds. value is the cursor position along the value axis, in the pane's local units, see getBoundsProc. Both are given as floating point numbers.

-cutproc

Specifies a callback procedure to be invoked when a cut operation is performed in the widget. Callback syntax:

callback widget start end

start and <end> are given in seconds as floating point numbers.

-getboundsproc

When the a pane is redrawn, this callback is invoked to query the plugin for the extents of its contents. Callback syntax:

callback widget pane

The return value of the callback should be a list containing the time and value bounds for the plugin contents, as four elements: tmin vmin tmax vmax, where tmin and tmax are the minimum and maximum time, and vmin and vmax are the minimum and maximum values.

-getconfigurationproc

Specifies a callback that invoked when the widget's current configuration is to be saved, to allow the plug-in to add its own configuration statements. Callback syntax:

callback widget pane

The callback is first invoked with pane as an empty string, which allows the plug-in to supply configuration statements for the entire widget, then it is invoked once for each pane in the widget. The return value of the callback should be a string containing new-line separated configuration statements for the plugin. Configuration statements are regular tcl-statements that will, when executed, recreate the current configuration of the widget. The configuration statements should refer to the current widget as $widget and to the pane as $<pane>. A typical configuration statement for myplugin might look something like:

$widget myplugin::addSomeFeature $pane -option1 value1 -option2 value2

-getoptproc

Specifies a callback procedure to be invoked the command line of the application is being parsed. This allows the plug-in to handle its own command line switches. Callback syntax:

callback arglistVar

arglistVar refers to a list variable name containing the command line, typically argv. The callback should remove all switches it wants to handle from arglistVar. This easiest done using the cmdline package in the Standard Tcl Library.

-openfileproc

Specifies a callback procedure to be invoked when a file is to be opened, to allow the plug-in to handle the file. Callback syntax:

callback widget fileName

The callback should return a boolean value to indicate whether or not it handles the file. If a plug-in returns true, the application will not try to handle the file internally.

-panecreatedproc

Specifies a callback procedure to be invoked when a new pane has been created in the widget. Callback syntax:

callback widget pane

-panedeletedproc

Specifies a callback procedure to be invoked when a pane is to be deleted in the widget. Callback syntax:

callback widget pane

-pasteproc

Specifies a callback procedure to be invoked when a paste operation is performed in the widget. Callback syntax:

callback widget start length

start and length are given in seconds as a floating point numbers.

-pauseproc

Specifies a callback procedure to be invoked when playback has been paused in the widget. Callback syntax:

callback widget

-playproc

Specifies a callback procedure to be invoked when playback has been started in the widget. Callback syntax:

callback widget

-printproc

Specifies a callback procedure to be invoked when the widget is to be printed, to allow the plug-in to redraw its contents onto a canvas for printing. Callback syntax:

callback widget pane tempCanvas x y

tempCanvas is a temporary canvas used during printing. The plug-in is expected to re-draw the pane contents in this canvas at coordinate offset x,y.

-propertiespageproc

Specifies a callback procedure to be invoked when the properties dialog is displayed. Callback syntax:

callback widget pane

The return value should be a list of the form {name displayproc name displayproc ...}. Each name/proc pair specifies one page in the properties dialog notebook widget. name is a text string that will be displayed on the notebook tab. displayproc should be a procedure that will be invoked to render the page. This procedure will be invoked as follows:

displayproc widget pane frame

Frame is the container frame of the notebook page, into which plugin widgets will be arranged.

-recordproc

Specifies a callback procedure to be invoked when recording has been started in the widget. Callback syntax:

callback widget

-redrawproc

Specifies a callback procedure to be invoked when the contents of a pane are redrawn. All plug-ins that display graphics must implement this callback. Callback syntax:

callback widget pane

-needsaveproc

Specifies a callback procedure which is used to check whether there is unsaved information present in the pane. Callback syntax:

callback widget pane

The return value should be a boolean, indicating whether or not there is unsaved information in the pane.

-savefileproc

Specifies a callback procedure to be invoked when a file is to be saved, to allow the plug-in to save the file. Callback syntax:

callback widget fileName

The callback should return a boolean value to indicate whether or not it saves the file. If a plug-in returns true, the application will not try to save the file internally.

-scrollproc

Specifies a callback procedure to be invoked when the widget is scrolled along the time axis. Callback syntax:

callback widget pane

-setselectionproc

Specifies a callback procedure to be invoked when the selection has changed.

callback widget pane t0 t1

t0 and t1 are the start and end times for the new selection, given in seconds as floating point numbers.

-soundchangedproc

Specifies a callback procedure to be invoked when the sound data has changed. This notifies a plug-in that the sound has been modified. Callback syntax:

callback widget flag

flag is a string describing the type of change.

-stopproc

Specifies a callback procedure to be invoked when playback has been stopped in the widget. Callback syntax:

callback widget

-undoproc

Specifies a callback procedure to be invoked when an undo operation is performed in the widget, to allow the plugin to restore its data to the state it had before the last change. Callback syntax:

callback widget

-widgetcreatedproc

Specifies a callback procedure to be invoked upon creation of a new widget. Callback syntax:

callback widget

-widgetdeletedproc

Specifies a callback procedure to be invoked when a widget is to be deleted. Callback syntax:

callback widget

POD ERRORS

Hey! The above document had some coding errors, which are explained below:

Around line 11:

=over without closing =back

wavesurfer-1.8.8p5/doc/widget.html000066400000000000000000000105031325326000200170740ustar00rootroot00000000000000

NAME

wsurf - Create and manipulate WaveSurfer widgets

SYNOPSIS

wsurf pathName ?options?

OPTIONS

-collapser

Specifies whether the collapser button should be display or not.

-configuration

This option is used to specify which configuration the widget should use initially. It takes a configuration filename as argument. The command wsurf::chooseConfigurationDialog can be used to display the standard selection dialog and return the users selection. Also, the emptry string "" can be used to specify that the standard configuration should be used.

-icons

Specifies a list with names of icons the title bar should display. Valid names are play, pause, stop, record, print, and close.

-messageproc

Specifies a callback to be called whenever the widget wants to report something to the user. Callback syntax:

callback message

message is the message string.

-playmapfilter

Specifies a playback transformation matrix.

-progressproc

Specifies a callback to be called whenever a time consuming operation is in progress. Callback syntax:

callback operation fraction

operation is a string describing the operation in progress and fraction is a number between 0.0 and 1.0 describing how much of operation that has been completed.

-sound

Specifies an existing Snack sound object to be used by the widget. If not given the widget will create one of its own.

-state

Specifies the initial state of the widget, either expanded or collapsed.

-slaves

This option is used to specify a list of slave widgets.

-title

Used to set the title displayed in the title bar.

DESCRIPTION

The wsurf command creates a new window (given by the pathName argument) and makes it into a wsurf widget. The wsurf command returns its pathName argument. At the time this command is invoked, there must not exist a window named pathName, but pathName's parent must exist.

WIDGET COMMAND

The wsurf command creates a new Tcl command whose name is pathName. This command may be used to invoke various operations on the widget. It has the following general form:

pathName option ?arg arg ...?

Option and the args determine the exact behavior of the command. The following commands are possible for wsurf widgets:

pathName cget option

pathName configure ?option? ?value option value ...?

pathName getInfo option

pathName closeWidget

pathName openFile filename

pathName saveFile filename

pathName printDialog

pathName undo

pathName cut

pathName copy

pathName paste

pathName play

pathName stop

pathName pause

To be continued...

wavesurfer-1.8.8p5/doc/wsurf.html000066400000000000000000000074151325326000200167670ustar00rootroot00000000000000

::wsurf::ApplyPreferences

This command should be invoked if the user hits "OK" or "Apply" in an applications preferences dialog to handle global widget preferences.

::wsurf::ChooseConfigurationDialog

This command is used to to display the "Choose configuration" dialog.

::wsurf::GetConfigurations

Returns a list with available configurations.

::wsurf::GetCurrent

Returns the name of the currently active wsurf widget.

::wsurf::getopt

This procedure is invoked to handle option parsing of the command line. This allows plug-ins to handle their own command line switches.

::wsurf::GetPreference

Returns the current value for specified preference. Syntax:

::wsurf::GetPreference preference

::wsurf::GetPreferences

Returns global widget preferences in text form.

::wsurf::GetPlugins

Returns a list with available plug-ins.

::wsurf::Initialize

This command initializes the wsurf library and should be called before creating the first widget. The command loads all plug-ins, creates default bindings, and sets default preferences. Syntax:

::wsurf::Initialize preference ?-plugindir dir? ?-configdir dir?

The options are used to specify additional directories to search for plug-ins and configurations.

::wsurf::MakeCurrent

Makes a wsurf widget current. Syntax:

::wsurf::MakeCurrent widget

::wsurf::PreferencePage

This command returns a list with global widget tab names and corresponding notebook page rendering procedures.

::wsurf::NeedSave

Returns 1 if there is an unsaved modification to a sound or to related data in a plug-in.

::wsurf::SetDefaultPrefs

Sets default values for global widget preferences.

::wsurf::SetPreference

Sets specified preference to given value. Syntax:

::wsurf::SetPreference preference value

wavesurfer-1.8.8p5/icons/000077500000000000000000000000001325326000200152725ustar00rootroot00000000000000wavesurfer-1.8.8p5/icons/icon48.xpm000066400000000000000000000210241325326000200171230ustar00rootroot00000000000000/* XPM */ static char * ws48_xpm[] = { "48 48 242 2", " c None", ". c #4A474B", "+ c #00001B", "@ c #555B89", "# c #121120", "$ c #2F2E46", "% c #090925", "& c #2C251B", "* c #5C5A56", "= c #979598", "- c #A3A6B5", "; c #3B364B", "> c #16130D", ", c #A9A7A6", "' c #C6C7C9", ") c #D9D7D8", "! c #E5E8F2", "~ c #7E7F8A", "{ c #241B14", "] c #857B78", "^ c #BBBAB9", "/ c #DBE3EE", "( c #EAF5FD", "_ c #AEB6C7", ": c #495166", "< c #777683", "[ c #69666A", "} c #1E1A18", "| c #85817E", "1 c #C4C2BB", "2 c #EEF0ED", "3 c #EDF3F3", "4 c #E4F3FE", "5 c #343D5B", "6 c #D5D6FA", "7 c #BAB7C2", "8 c #322D2C", "9 c #6B6558", "0 c #DAD0CF", "a c #B7C4DC", "b c #343858", "c c #8994AA", "d c #D5E1ED", "e c #9898A8", "f c #383534", "g c #B3AAA6", "h c #D1CDC8", "i c #F1F5F7", "j c #8588A6", "k c #DDEAF5", "l c #7D7878", "m c #DEE0DD", "n c #F2F8FC", "o c #ECF8FD", "p c #34425F", "q c #D4E5FD", "r c #DBEBFD", "s c #E3EAEC", "t c #221E1F", "u c #F2F1ED", "v c #DCEDFF", "w c #67748B", "x c #75839D", "y c #57637E", "z c #544E49", "A c #CCC4C2", "B c #E2ECFD", "C c #39446A", "D c #8B7D74", "E c #E3DEE5", "F c #505B79", "G c #68769A", "H c #E1EBF6", "I c #BDC2CB", "J c #20180B", "K c #A79A8C", "L c #CCC5BD", "M c #E9E9E8", "N c #3A4163", "O c #7177A7", "P c #333B64", "Q c #2C355A", "R c #DBDBDF", "S c #262320", "T c #C4BBAB", "U c #C9C0AF", "V c #E8E5DC", "W c #333B6C", "X c #737CAB", "Y c #344173", "Z c #C0C6EA", "` c #BCB6A9", " . c #766D67", ".. c #3A3017", "+. c #D6C9AD", "@. c #7B83A7", "#. c #A4AADA", "$. c #C6CCF8", "%. c #9C9C9D", "&. c #4C4538", "*. c #DED0B1", "=. c #CAB99E", "-. c #E3DFD4", ";. c #424A7C", ">. c #3B4373", ",. c #D6D9E2", "'. c #A69E9A", "). c #5C5334", "!. c #E7D7B4", "~. c #D9CBB7", "{. c #A7B6D8", "]. c #838BB2", "^. c #D6E9FC", "/. c #8C837C", "(. c #746B4E", "_. c #D2BC9D", ":. c #F5EBF3", "<. c #C9C9DB", "[. c #45527D", "}. c #59668C", "|. c #BCBCC3", "1. c #B19A92", "2. c #68614E", "3. c #C4B69D", "4. c #8C766B", "5. c #C6B6C3", "6. c #393F76", "7. c #BCC7F8", "8. c #D4DCFF", "9. c #868DC3", "0. c #4C5586", "a. c #5F6F90", "b. c #D7E4F4", "c. c #D0D3DE", "d. c #A39A94", "e. c #574B31", "f. c #C6B9A7", "g. c #4A4A6A", "h. c #353E72", "i. c #828BBE", "j. c #333C74", "k. c #988F8A", "l. c #170D08", "m. c #BBB6B7", "n. c #312E43", "o. c #DADFFF", "p. c #414577", "q. c #49517E", "r. c #434876", "s. c #626A99", "t. c #A9B9E6", "u. c #434D82", "v. c #596496", "w. c #3C457B", "x. c #B5C8EA", "y. c #AAA19C", "z. c #3A3329", "A. c #C4BEB4", "B. c #B5BFD7", "C. c #8893C9", "D. c #6975A4", "E. c #525C92", "F. c #59524B", "G. c #3C4874", "H. c #666EA6", "I. c #969DD4", "J. c #4B363F", "K. c #977970", "L. c #7786AF", "M. c #99A6CA", "N. c #2C356B", "O. c #968C96", "P. c #B49883", "Q. c #776C58", "R. c #B4CAE7", "S. c #3D4A7C", "T. c #767FB0", "U. c #CDE2FE", "V. c #563C47", "W. c #634336", "X. c #938569", "Y. c #C5E0FD", "Z. c #CCDEFF", "`. c #9BA9D6", " + c #493F5A", ".+ c #B1957C", "++ c #1B1202", "@+ c #C4DCFC", "#+ c #C5DAF4", "$+ c #6F5F62", "%+ c #A48E79", "&+ c #9A8676", "*+ c #485586", "=+ c #BDC6FC", "-+ c #C9D3E5", ";+ c #978376", ">+ c #151111", ",+ c #C6D5FF", "'+ c #2F3C6B", ")+ c #B9B5B5", "!+ c #858387", "~+ c #343C79", "{+ c #7B85B7", "]+ c #515791", "^+ c #5A729E", "/+ c #C7D2E9", "(+ c #C2CDE5", "_+ c #9DB7DB", ":+ c #929BC2", "<+ c #8CA2C8", "[+ c #A5AEE5", "}+ c #857D86", "|+ c #2C3567", "1+ c #B3B1C6", "2+ c #B8D5F5", "3+ c #8A94D1", "4+ c #B9D2EC", "5+ c #26284E", "6+ c #86838A", "7+ c #5B5758", "8+ c #B2CCF3", "9+ c #324977", "0+ c #4E6790", "a+ c #4C638D", "b+ c #9DBDE4", "c+ c #2D3B71", "d+ c #575666", "e+ c #241E20", "f+ c #AECBF0", "g+ c #253A65", "h+ c #AAC5EC", "i+ c #86899A", "j+ c #7F96C0", "k+ c #1E355F", "l+ c #A6C5E9", "m+ c #A4C3EB", "n+ c #A4BBDC", "o+ c #7C7886", "p+ c #9AA1B3", "q+ c #9DACC5", "r+ c #A7ABC4", "s+ c #262336", " + @ ", " # $ % ", " & * = - ; # ", " > * , ' ) ! ; ~ ", " { ] ^ ) / ( _ : < [ ", " } | 1 ) 2 3 4 4 5 6 7 8 ", " 9 ^ 0 2 3 ( 4 a b c d e ", " f g h 2 i ( 4 4 a b j k ' [ ", " l 1 m n o ( 4 4 4 p q r s , t ", " 8 g h u n o o 4 v w x y v k ' | ", " z A ) n n o ( ( 4 B C v v r / g 8 ", " D A E ; e ( w w 4 w F G v H / I | ", " J K L M n : N @ O P C Q x v v k R , S ", " & T U V i 4 B W X W Y Z v v v r / ` . ", " ..+.T V 3 4 @.Q #.W $.N y v v r / ' %.> ", " &.*.=.-.3 ( 4 r W ;.>.C r v v v k ,.'.* ", " ).!.=.~.u ( 4 4 B {.W ].P q ^.r ^.d g /. ", " (.!._.g :.<.y 4 B P [.}.@ q q q ^.d |.'.{ ", " (.!._.1.; P B Q P B @.P >.>.{.q q d h '.&. ", " 2.*.3.4.5.$.6.W 7.;.6.8.>.9.0.a.q b.c.d. . ", " e.*.f.0 e g.G #.>.h.i.W >.X j.7.q b.R d.k.l. ", " &.+.3.m.n.o.0.p.q.O r.W s.W s.Y P q ,.'.K & ", " &.T ` M B N >.t.p.u.p.@ v.r.w.w.x.5 R y.d.z. ", " z.f.A.2 H B.8.W j.C.>.D.W p.9.E.r.y ,.d.K F. ", " & ` 1 3 H q G.w.H.j.p.s.h.I.j.6.#.j J.K.K 9 ", " > ` 1 s H ^.q L.6.w.w.M.}.G.N.$.p.g.O.K.P.Q. ", " %.^ s k ^.^.R.7.S.T.v.G U.L.W j.6 V.W.P.X. ", " ] m.! r q U.U.}.G.E.W t.U.Y.Z.`.r. +K..+X.++ ", " * m./ Q L.U.U.U.U.>.v.Y Y @+Y.Z.#+<.$+%+&+++ ", " f m.- o.T.*+[.U.Y.D.7.N.=+u.@+@+#+-+g ;+&+++ ", " >+, -+N h.t.0.Y W ,+'+h.v.N.,+,+#+-+)+D ;+++ ", " !+~ y 8.~+Y {+u.]+j.`.j.u.u.^+#+/+7 D &+++ ", " F.^ (+G.j.=+N.w.v.h.i.N.]+u._+:+(+7 ] D { ", " & , -+Z.<+Y ~+I.h.@ u.N.[+~+Y {+(+7 }+D l. ", " !+_ #+@+@+G >.|+D.W D.j.j.=+q.5 1+}+] l. ", " z , -+2+2+#+2+0.0.h.;.w.3+w.'+Z 1+}+ .l. ", " >+e I 4+2+2+2+[.w.h.H.S.~+v.[+5+j 6+7+ ", " [ - (+4+2+2+8+Y C.h.Y C.E.u.j e 6+. ", " } %.a 4+8+8+9+0+a+8+b+c+~+`.j d+}+e+ ", " [ - R.f+f+_+g+`.h+h+h+t.N.Q i+[ ", " = B.R.f+j+k+<+l+m+l+n+{.e o+. ", " . p+a h+^+9+0+m+b+l+n+q+i+< & ", " !+r+l+t.9+m+b+b+_+{.c 6+7+ ", ">+O.{.^+9+D.b+_+_+q+i+l 8 ", ">+= #.Y t._+{.q+j ~ . ", " s+Q :+`.c i+< . ", "% n.s+i+!+[ f ", "g.+ "}; wavesurfer-1.8.8p5/msgs/000077500000000000000000000000001325326000200151305ustar00rootroot00000000000000wavesurfer-1.8.8p5/msgs/Mk.msg000066400000000000000000000230521325326000200162110ustar00rootroot00000000000000::msgcat::mcset ru_ru.koi8-r "Initializing..." "Се Иницијализира..." ::msgcat::mcset ru_ru.koi8-r "Components read:" "Читање на компонентите:" ::msgcat::mcset ru_ru.koi8-r "Can't open the file" "Датотеката не може да Ñе отвори" ::msgcat::mcset ru_ru.koi8-r "Close" "Затвори го" ::msgcat::mcset ru_ru.koi8-r "Exit" "Излез" ::msgcat::mcset ru_ru.koi8-r "Sample Rate" "Ðормална Стапка" ::msgcat::mcset ru_ru.koi8-r "Sample Encoding" "Ðормално Кодирање" ::msgcat::mcset ru_ru.koi8-r "Channels" "Канали" ::msgcat::mcset ru_ru.koi8-r "Mono" "Моно" ::msgcat::mcset ru_ru.koi8-r "Stereo" "Стерео" ::msgcat::mcset ru_ru.koi8-r "Associate extension" "Поврзани типови" ::msgcat::mcset ru_ru.koi8-r "with these values" " "Со овие вредноÑти" ::msgcat::mcset ru_ru.koi8-r "(click to cancel)" "(Кликни за откажување)" ::msgcat::mcset ru_ru.koi8-r "done." "Завршено." ::msgcat::mcset ru_ru.koi8-r "Interrupted" "Прекинато" ::msgcat::mcset ru_ru.koi8-r "Decibels" "Децибели" ::msgcat::mcset ru_ru.koi8-r "Amplify by:" "ЗаÑили го за:" ::msgcat::mcset ru_ru.koi8-r "Normalize" "Ðормализирај" ::msgcat::mcset ru_ru.koi8-r "Normalize to:" "Ðормализирај во:" ::msgcat::mcset ru_ru.koi8-r "Normalize all channels equally" "Ðормализирај ги Ñите канали подеднакво" ::msgcat::mcset ru_ru.koi8-r "Echo" "Ехо" ::msgcat::mcset ru_ru.koi8-r "In" "Внатре" ::msgcat::mcset ru_ru.koi8-r "Out" "Ðадвор" ::msgcat::mcset ru_ru.koi8-r "Read Offset (bytes)" "Читај урамнотежено (битови)" ::msgcat::mcset ru_ru.koi8-r "Byte Order" "Ред на Битови" ::msgcat::mcset ru_ru.koi8-r "Converting sample rate..." "Ковертирање во нормална Ñтапка... " ::msgcat::mcset ru_ru.koi8-r "Converting sample encoding format..." "Конвертирање во обичен формат..." ::msgcat::mcset ru_ru.koi8-r "Converting number of channels..." "Претворање на бројот на канали..." ::msgcat::mcset ru_ru.koi8-r "Computing pitch..." "ПроцеÑирање на интензитетот..." ::msgcat::mcset ru_ru.koi8-r "Reading sound..." "Вчитување на звукот..." ::msgcat::mcset ru_ru.koi8-r "Writing sound..." "Запишување на звукот..." ::msgcat::mcset ru_ru.koi8-r "Precomputing waveform..." "ПрепроцеÑирање на wave формата" ::msgcat::mcset ru_ru.koi8-r "Reversing sound..." "Враќање назад на звукот..." ::msgcat::mcset ru_ru.koi8-r "Filtering sound..." "Филтрирање на звукот..." ::msgcat::mcset ru_ru.koi8-r "Interpret Raw File As" "Интерпретирај Raw фајл како" ::msgcat::mcset ru_ru.koi8-r "You have unsaved changes." "Имате неÑнимени промени." ::msgcat::mcset ru_ru.koi8-r "Do you really want to exit?" "Дали Ñакате да излезете?" ::msgcat::mcset ru_ru.koi8-r "File type" "Тип на датотека" ::msgcat::mcset ru_ru.koi8-r "Associate" "Поврзи ги" ::msgcat::mcset ru_ru.koi8-r "Make default" "ПоÑтави го Default" ::msgcat::mcset ru_ru.koi8-r "Use DDE" "КориÑти DDE" ::msgcat::mcset ru_ru.koi8-r "Help" "Помош" ::msgcat::mcset ru_ru.koi8-r "About WaveSurfer" "п WaveSurfer" ::msgcat::mcset ru_ru.koi8-r "Manual" "УпатÑтво" ::msgcat::mcset ru_ru.koi8-r "Convert..." ::msgcat::mcset ru_ru.koi8-r "Amplify..." "ЗаÑили го..." ::msgcat::mcset ru_ru.koi8-r "Normalize..." "Ðормализирај го..." ::msgcat::mcset ru_ru.koi8-r "Echo..." "Ехо..." ::msgcat::mcset ru_ru.koi8-r "Mix Channels..." "Измешај ги каналите..." ::msgcat::mcset ru_ru.koi8-r "Invert" "Инвертирај" ::msgcat::mcset ru_ru.koi8-r "Reverse" "Пушти назад" ::msgcat::mcset ru_ru.koi8-r "Silence" "Тишина" ::msgcat::mcset ru_ru.koi8-r "Save" "Сними" ::msgcat::mcset ru_ru.koi8-r "Print..." "Печати..." ::msgcat::mcset ru_ru.koi8-r "Save As..." "Сними како..." ::msgcat::mcset ru_ru.koi8-r "Save Selection..." "Сними го Ñелектираното..." ::msgcat::mcset ru_ru.koi8-r "Undo" "Врати" ::msgcat::mcset ru_ru.koi8-r "Cut" "ИÑечи" ::msgcat::mcset ru_ru.koi8-r "Copy" "Копирај" ::msgcat::mcset ru_ru.koi8-r "Paste" "Залепи" ::msgcat::mcset ru_ru.koi8-r "Select All" "Селектирај Ñе" ::msgcat::mcset ru_ru.koi8-r "Play whole selection:" "Пушти ја Ñелекцијата:" ::msgcat::mcset ru_ru.koi8-r "Play whole sound:" "Пушти го целиот звук:" ::msgcat::mcset ru_ru.koi8-r "Play at cursor:" "Почни од КурÑерот:" ::msgcat::mcset ru_ru.koi8-r "Toggle play/pause:" "Пушти/Пауза:" ::msgcat::mcset ru_ru.koi8-r "Defined file extension types:" "Дефинирани типови на датотеки:" ::msgcat::mcset ru_ru.koi8-r "Associate file types..." "Вклчени типови на датотеки" ::msgcat::mcset ru_ru.koi8-r "Zero Cross Adjust" "ПодеÑи над нула" ::msgcat::mcset ru_ru.koi8-r "Zero Cross Adjust:" "ПодеÑи над нула:" ::msgcat::mcset ru_ru.koi8-r "Normalize cancelled" "Ðормализацијата е откажана" ::msgcat::mcset ru_ru.koi8-r "New channel" "Ðов канал" ::msgcat::mcset ru_ru.koi8-r "New..." "Ðов..." ::msgcat::mcset ru_ru.koi8-r "Open..." "Отвори..." ::msgcat::mcset ru_ru.koi8-r "Preferences..." "ПодеÑувања..." ::msgcat::mcset ru_ru.koi8-r "Show Console" "Прикажи ја Конзолата" ::msgcat::mcset ru_ru.koi8-r "Mixer..." "МикÑер..." ::msgcat::mcset ru_ru.koi8-r "Edit" "Уреди" ::msgcat::mcset ru_ru.koi8-r "File" "Датотека" ::msgcat::mcset ru_ru.koi8-r "Transform" "ТранÑформации" ::msgcat::mcset ru_ru.koi8-r "Apply Configuration..." "Примени ја Конфигурацијата.." ::msgcat::mcset ru_ru.koi8-r "Save Configuration..." "Сними ја Конфигурацијата" ::msgcat::mcset ru_ru.koi8-r "Properties..." "Параметри..." ::msgcat::mcset ru_ru.koi8-r "Properties:" "Параметри:" ::msgcat::mcset ru_ru.koi8-r "Zoom to Selection" "Зголеми ја Селекцијата" ::msgcat::mcset ru_ru.koi8-r "Delete Pane" "Избриши го платното " ::msgcat::mcset ru_ru.koi8-r "Create Pane" "Креирај платно " ::msgcat::mcset ru_ru.koi8-r "Input device:" "Внатрешна единица:" ::msgcat::mcset ru_ru.koi8-r "Output device:" "Ðадворешна единица:" ::msgcat::mcset ru_ru.koi8-r "Cancel" "Откажи" ::msgcat::mcset ru_ru.koi8-r "Apply" "Примени" ::msgcat::mcset ru_ru.koi8-r "Selection color:" "Селекција на бои:" ::msgcat::mcset ru_ru.koi8-r "Choose..." "Избери..." ::msgcat::mcset ru_ru.koi8-r "Selection frame color:" "Избери боја на рамката:" ::msgcat::mcset ru_ru.koi8-r "Y-axis color:" "Боја на Y-ОÑката:" ::msgcat::mcset ru_ru.koi8-r "Y-axis font:" "Фонт на Y-ОÑката:" ::msgcat::mcset ru_ru.koi8-r "Background color:" "Боја на позадината:" ::msgcat::mcset ru_ru.koi8-r "Pane height:" "ВиÑина на платното:" ::msgcat::mcset ru_ru.koi8-r "Pixels per second:" "ПикÑели во Ñекунда:" ::msgcat::mcset ru_ru.koi8-r "Choose configuration" "Избери конфигурација" ::msgcat::mcset ru_ru.koi8-r "pixels" "пикÑели" ::msgcat::mcset ru_ru.koi8-r "Pane scrolled" "Лизгачко Платно" ::msgcat::mcset ru_ru.koi8-r "Pane scroll height:" "Должина на лизгачкото платно:" ::msgcat::mcset ru_ru.koi8-r "Display selection length" "Прикажи ја должината на Ñелекцијата" ::msgcat::mcset ru_ru.koi8-r "Sound storage:" "Складирање на звукот:" ::msgcat::mcset ru_ru.koi8-r "keep on disk" "Зачувај на диÑк" ::msgcat::mcset ru_ru.koi8-r "load into memory" "Вчитај во меморија" ::msgcat::mcset ru_ru.koi8-r "Temporary directory:" "Привмремен директориум:" ::msgcat::mcset ru_ru.koi8-r "Print command:" "ИÑпечати ја командата:" ::msgcat::mcset ru_ru.koi8-r "Preview command:" "Прикажи ја командата:" ::msgcat::mcset ru_ru.koi8-r "Record time limit:" "Граница на времето за Ñнимање:" ::msgcat::mcset ru_ru.koi8-r "s" "У" ::msgcat::mcset ru_ru.koi8-r "Icons:" "Икони:" ::msgcat::mcset ru_ru.koi8-r "Do not query for configuration" "Ðе побарувај конфигурација " ::msgcat::mcset ru_ru.koi8-r "Max zoom-in:" "МакÑимален Зум-ин:" ::msgcat::mcset ru_ru.koi8-r "Automatic scroll during playback" "ÐвтоматÑко лиÑтање за време на плејбекот" ::msgcat::mcset ru_ru.koi8-r "Installed plug-ins:" "ИнÑталирани додатоци:" ::msgcat::mcset ru_ru.koi8-r "Description:" "ОпиÑ:" ::msgcat::mcset ru_ru.koi8-r "Save to PS-file:" "Сними го во PS-датотека:" ::msgcat::mcset ru_ru.koi8-r "Save" "Сними го" ::msgcat::mcset ru_ru.koi8-r "Printing..." "Се печати..." ::msgcat::mcset ru_ru.koi8-r "Do you really want to close?" "Дали навиÑтина Ñакате да го затворите?" wavesurfer-1.8.8p5/msgs/README.txt000066400000000000000000000016661325326000200166370ustar00rootroot00000000000000WaveSurfer supports multi-lingual user interfaces through the use of the msgcat Tcl package. The msgs directory contains the localization files containing text strings used in WaveSurfer. The current locale decides which .msg-file should be used in the application. The locale is set using the environment variable LANG. It is also possible to hard code this in surfutil.tcl, line 15 WaveSurfer defaults to English for undefined messages. It is also possible to put .msg-files in the directory ~/.wavesurfer/1.8/msgs/ Another option is to create a plug-in out of the .msg file. If the locale is xxx create a file "xxx.plug" containing this code namespace eval ::util { ::msgcat::mclocale xxx # code from xxx.msg here # } Please send us .msg-files you've created for inclusion in the source distribution. Note that the encoding features are not currently supported by the pre-compiled binary releases in order to keep the executables small. wavesurfer-1.8.8p5/msgs/pt.msg000066400000000000000000000150101325326000200162600ustar00rootroot00000000000000::msgcat::mcset pt "Initializing..." "Inicializando..." ::msgcat::mcset pt "Components read:" "Componentes lidos:" ::msgcat::mcset pt "Can't open the file" "Impossível abrir o arquivo" ::msgcat::mcset pt "Close" "Fechar" ::msgcat::mcset pt "Exit" "Sair" ::msgcat::mcset pt "Sample Rate" "Taxa de amostragem" ::msgcat::mcset pt "Sample Encoding" "Codificação de amostragem" ::msgcat::mcset pt "Channels" "Canais" ::msgcat::mcset pt "Mono" "Mono" ::msgcat::mcset pt "Stereo" "Estéreo" ::msgcat::mcset pt "Associate extension" "Extensões associadas" ::msgcat::mcset pt "with these values" "com estes valores" ::msgcat::mcset pt "(click to cancel)" "(clique para cancelar)" ::msgcat::mcset pt "done." "completado." ::msgcat::mcset pt "Interrupted" "Interrompido" ::msgcat::mcset pt "Decibels" "Decibéis" ::msgcat::mcset pt "Amplify by:" "Amplificar em:" ::msgcat::mcset pt "Normalize" "Normalizar" ::msgcat::mcset pt "Normalize to:" "Normalizar para:" ::msgcat::mcset pt "Normalize all channels equally" "Normalizar todos os canais igualmente" ::msgcat::mcset pt "Echo" "Eco" ::msgcat::mcset pt "In" "In" ::msgcat::mcset pt "Out" "Out" ::msgcat::mcset pt "Read Offset (bytes)" "Read offset (em bytes)" ::msgcat::mcset pt "Byte Order" "Ordem de bytes" ::msgcat::mcset pt "Converting sample rate..." "Converter taxa de amostragem para..." ::msgcat::mcset pt "Converting sample encoding format..." "Converter formato de encodificação de amostragem..." ::msgcat::mcset pt "Converting number of channels..." "Converter número de canais..." ::msgcat::mcset pt "Computing pitch..." "Computar o pitch..." ::msgcat::mcset pt "Reading sound..." "Lendo arquivo de som..." ::msgcat::mcset pt "Writing sound..." "Salvando arquivo de som..." ::msgcat::mcset pt "Precomputing waveform..." "Pre-computando onda sonora..." ::msgcat::mcset pt "Reversing sound..." "Revertendo o som..." ::msgcat::mcset pt "Filtering sound..." "Filtrando o som..." ::msgcat::mcset pt "Interpret Raw File As" "Interpretar arquivo Raw como" ::msgcat::mcset pt "You have unsaved changes." "Há mudanças não salvas" ::msgcat::mcset pt "Do you really want to exit?" "Você realmente deseja sair?" ::msgcat::mcset pt "File type" "Tipo de arquivo" ::msgcat::mcset pt "Associate" "Associar" ::msgcat::mcset pt "Make default" "Tornar padrão" ::msgcat::mcset pt "Use DDE" "Usar DDE" ::msgcat::mcset pt "Help" "Ajuda" ::msgcat::mcset pt "About WaveSurfer" "Sobre o WaveSurfer" ::msgcat::mcset pt "Manual" "Manual" ::msgcat::mcset pt "Convert..." "Converter..." ::msgcat::mcset pt "Amplify..." "Amplificar..." ::msgcat::mcset pt "Normalize..." "Normalizar..." ::msgcat::mcset pt "Echo..." "Eco" ::msgcat::mcset pt "Mix Channels..." "Mixar canais..." ::msgcat::mcset pt "Invert" "Inverter" ::msgcat::mcset pt "Reverse" "Reverter" ::msgcat::mcset pt "Silence" "Silenciar" ::msgcat::mcset pt "Silence..." "Silenciar..." ::msgcat::mcset pt "Save" "Salvar" ::msgcat::mcset pt "Print..." "Imprimir..." ::msgcat::mcset pt "Save As..." "Salvar como..." ::msgcat::mcset pt "Save Selection..." "Salvar seleção..." ::msgcat::mcset pt "Undo" "Desfazer" ::msgcat::mcset pt "Cut" "Recortar" ::msgcat::mcset pt "Copy" "Copiar" ::msgcat::mcset pt "Paste" "Colar" ::msgcat::mcset pt "Select All" "Selecionar tudo" ::msgcat::mcset pt "Play whole selection:" "Tocar a seleção inteira:" ::msgcat::mcset pt "Play whole sound:" "Tocar o som inteiro:" ::msgcat::mcset pt "Play at cursor:" "Tocar à posição do cursor:" ::msgcat::mcset pt "Toggle play/pause:" "Tocar/pausar:" ::msgcat::mcset pt "Defined file extension types:" "Tipos de extensões de arquivo definidas:" ::msgcat::mcset pt "Associate file types..." "Tipos de arquivo associados..." ::msgcat::mcset pt "Zero Cross Adjust" "Ajuste Zero Cross" ::msgcat::mcset pt "Zero Cross Adjust:" "Ajuste Zero Cross" ::msgcat::mcset pt "Normalize cancelled" "Normalização cancelada" ::msgcat::mcset pt "New channel" "Novo canal" ::msgcat::mcset pt "New..." "Novo..." ::msgcat::mcset pt "Open..." "Abrir..." ::msgcat::mcset pt "Preferences..." "Opções..." ::msgcat::mcset pt "Show Console" "Exibir console" ::msgcat::mcset pt "Mixer..." "Mixer..." ::msgcat::mcset pt "Edit" "Editar" ::msgcat::mcset pt "File" "Arquivo" ::msgcat::mcset pt "Transform" "Transformar" ::msgcat::mcset pt "Apply Configuration..." "Aplicar configuração..." ::msgcat::mcset pt "Save Configuration..." "Salvar configuração..." ::msgcat::mcset pt "Properties..." "Propriedades..." ::msgcat::mcset pt "Properties:" "Propriedades:" ::msgcat::mcset pt "Zoom to Selection" "Zoom para a seleção" ::msgcat::mcset pt "Delete Pane" "Remover painel" ::msgcat::mcset pt "Create Pane" "Criar painel" ::msgcat::mcset pt "Input device:" "Dispositivo de entrada (input):" ::msgcat::mcset pt "Output device:" "Dispostivo de saída (output):" ::msgcat::mcset pt "Cancel" "Cancelar" ::msgcat::mcset pt "Apply" "Aplicar" ::msgcat::mcset pt "Selection color:" "Seleção de cor:" ::msgcat::mcset pt "Choose..." "Escolher..." ::msgcat::mcset pt "Selection frame color:" "Cor da área de seleção:" ::msgcat::mcset pt "Y-axis color:" "Cor do eixo Y:" ::msgcat::mcset pt "Y-axis font:" "Fonte do eixo Y:" ::msgcat::mcset pt "Background color:" "Cor de fundo:" ::msgcat::mcset pt "Pane height:" "Altura do painel:" ::msgcat::mcset pt "Pixels per second:" "Pixeis por segundo:" ::msgcat::mcset pt "Choose configuration" "Escolher configuração" ::msgcat::mcset pt "pixels" "pixeis" ::msgcat::mcset pt "Pane scrolled" "Painel deslizante" ::msgcat::mcset pt "Pane scroll height:" "Altura do deslize do painel" ::msgcat::mcset pt "Display selection length" "Exibir comprimento da seleção" ::msgcat::mcset pt "Sound storage:" "Armazenagem de som:" ::msgcat::mcset pt "keep on disk" "manter no disco" ::msgcat::mcset pt "load into memory" "carregar na memória" ::msgcat::mcset pt "Temporary directory:" "Diretório temporário:" ::msgcat::mcset pt "Print command:" "Comando de impressão:" ::msgcat::mcset pt "Preview command:" "Comando de pré-visualização:" ::msgcat::mcset pt "Record time limit:" "Tempo limite de gravação:" ::msgcat::mcset pt "s" "s" ::msgcat::mcset pt "Icons:" "Ícones:" ::msgcat::mcset pt "Do not query for configuration" "Não exigir uma configuração " ::msgcat::mcset pt "Max zoom-in:" "Zoom-in máximo:" ::msgcat::mcset pt "Automatic scroll during playback" "Deslize automático durante a execução" ::msgcat::mcset pt "Installed plug-ins:" "Plug-ins instalados:" ::msgcat::mcset pt "Description:" "Descrição:" ::msgcat::mcset pt "Save to PS-file:" "Salvar para arquivo PS:" ::msgcat::mcset pt "Save" "Salvar" ::msgcat::mcset pt "Printing..." "Imprimir..." ::msgcat::mcset pt "Do you really want to close?" "Você realmente deseja sair?" wavesurfer-1.8.8p5/msgs/ru_ru.koi8-r.msg000066400000000000000000000166501325326000200201140ustar00rootroot00000000000000::msgcat::mcset ru_ru.koi8-r "Initializing..." "éÎÉÃÉÁÌÉÚÁÃÉÑ..." ::msgcat::mcset ru_ru.koi8-r "Components read:" "ðÒÏÞÉÔÁÎÏ ËÏÍÐÏÎÅÎÔ:" ::msgcat::mcset ru_ru.koi8-r "Can't open the file" "îÅ ÍÏÇÕ ÏÔËÒÙÔØ ÆÁÊÌ" ::msgcat::mcset ru_ru.koi8-r "Close" "úÁËÒÙÔØ" ::msgcat::mcset ru_ru.koi8-r "Exit" "÷ÙÈÏÄ" ::msgcat::mcset ru_ru.koi8-r "Sample Rate" "þÁÓÔÏÔÁ ÄÉÓËÒÅÔÉÚÁÃÉÉ" ::msgcat::mcset ru_ru.koi8-r "Sample Encoding" "ëÏÄÉÒÏ×ÁÎÉÅ ÏÔÓÞ£ÔÏ×" ::msgcat::mcset ru_ru.koi8-r "Channels" "ëÁÎÁÌÙ" ::msgcat::mcset ru_ru.koi8-r "Mono" "íÏÎÏ" ::msgcat::mcset ru_ru.koi8-r "Stereo" "óÔÅÒÅÏ" ::msgcat::mcset ru_ru.koi8-r "Associate extension" "áÓÓÏÃÉÉÒÏ×ÁÔØ ÒÁÓÛÉÒÅÎÉÅ" ::msgcat::mcset ru_ru.koi8-r "with these values" "Ó ÜÔÉÍÉ ÚÎÁÞÅÎÉÑÍÉ" ::msgcat::mcset ru_ru.koi8-r "(click to cancel)" "(ËÌÉËÎÉÔÅ ÄÌÑ ÏÔÍÅÎÙ)" ::msgcat::mcset ru_ru.koi8-r "done." "ÓÄÅÌÁÎÏ." ::msgcat::mcset ru_ru.koi8-r "Interrupted" "ðÒÅÒ×ÁÎÏ" ::msgcat::mcset ru_ru.koi8-r "Decibels" "äÅÃÉÂÅÌÙ" ::msgcat::mcset ru_ru.koi8-r "Amplify by:" "õÓÉÌÉÔØ ÎÁ" ::msgcat::mcset ru_ru.koi8-r "Normalize" "îÏÒÍÁÌÉÚÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Normalize to:" "îÏÒÍÁÌÉÚÏ×ÁÔØ Ë:" ::msgcat::mcset ru_ru.koi8-r "Normalize all channels equally" "îÏÒÍÁÌÉÚÉÒÏ×ÁÔØ ×ÓÅ ËÁÎÁÌÙ ÏÄÉÎÁËÏ×Ï" ::msgcat::mcset ru_ru.koi8-r "Echo" "üÈÏ" ::msgcat::mcset ru_ru.koi8-r "In" "÷ÈÏÄ" ::msgcat::mcset ru_ru.koi8-r "Out" "÷ÙÈÏÄ" ::msgcat::mcset ru_ru.koi8-r "Read Offset (bytes)" "Read ÓÍÅÝÅÎÉÅ (ÂÁÊÔÙ)" ::msgcat::mcset ru_ru.koi8-r "Byte Order" "ðÏÒÑÄÏË ÂÉÔÏ×" ::msgcat::mcset ru_ru.koi8-r "Converting sample rate..." "ðÒÅÏÂÒÁÚÏ×ÁÎÉÅ ÞÁÓÔÏÔÙ ÄÉÓËÒÅÔÉÚÁÃÉÉ" ::msgcat::mcset ru_ru.koi8-r "Converting sample encoding format..." "ðÒÅÏÂÒÁÚÏ×ÁÎÉÅ ÆÏÒÍÁÔÁ ËÏÄÉÒÏ×ÁÎÉÑ ÏÔÓÞ£ÔÏ×" ::msgcat::mcset ru_ru.koi8-r "Converting number of channels..." ::msgcat::mcset ru_ru.koi8-r "Computing pitch..." "÷ÙÞÉÓÌÅÎÉÅ pitch" ::msgcat::mcset ru_ru.koi8-r "Reading sound..." "þÔÅÎÉÅ Ú×ÕËÁ" ::msgcat::mcset ru_ru.koi8-r "Writing sound..." "úÁÐÉÓØ Ú×ÕËÁ" ::msgcat::mcset ru_ru.koi8-r "Precomputing waveform..." ::msgcat::mcset ru_ru.koi8-r "Reversing sound..." ::msgcat::mcset ru_ru.koi8-r "Filtering sound..." "æÉÌØÔÒÁÃÉÑ Ú×ÕËÁ" ::msgcat::mcset ru_ru.koi8-r "Interpret Raw File As" ::msgcat::mcset ru_ru.koi8-r "You have unsaved changes." "éÍÅÀÔÓÑ ÎÅÓÏÈÒÁΣÎÎÙÅ ÉÚÍÅÎÅÎÉÑ" ::msgcat::mcset ru_ru.koi8-r "Do you really want to exit?" "÷Ù ÄÅÊÓÔ×ÉÔÅÌØÎÏ ÈÏÔÉÔÅ ×ÙÊÔÉ?" ::msgcat::mcset ru_ru.koi8-r "File type" "ôÉÐ ÆÁÊÌÁ" ::msgcat::mcset ru_ru.koi8-r "Associate" "áÓÓÏÃÉÉÒÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Make default" "óÄÅÌÁÔØ ÉÓÐÏÌØÚÕÅÍÙÍ ÐÏ ÕÍÏÌÞÁÎÉÀ" ::msgcat::mcset ru_ru.koi8-r "Use DDE" "éÓÐÏÌØÚÏ×ÁÔØ DDE" ::msgcat::mcset ru_ru.koi8-r "Help" "ðÏÍÏÝØ" ::msgcat::mcset ru_ru.koi8-r "About WaveSurfer" "ï WaveSurfer" ::msgcat::mcset ru_ru.koi8-r "Manual" "òÕËÏ×ÏÄÓÔ×Ï" ::msgcat::mcset ru_ru.koi8-r "Convert..." ::msgcat::mcset ru_ru.koi8-r "Amplify..." "õÓÉÌÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Normalize..." "îÏÒÍÁÌÉÚÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Echo..." "üÈÏ" ::msgcat::mcset ru_ru.koi8-r "Mix Channels..." "óÍÅÛÁÔØ ËÁÎÁÌÙ" ::msgcat::mcset ru_ru.koi8-r "Invert" "éÎ×ÅÒÔÉÒÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Reverse" ::msgcat::mcset ru_ru.koi8-r "Silence" "ôÉÛÉÎÁ" ::msgcat::mcset ru_ru.koi8-r "Save" "óÏÈÒÁÎÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Print..." "ðÅÞÁÔÁÔØ..." ::msgcat::mcset ru_ru.koi8-r "Save As..." "óÏÈÒÁÎÉÔØ ËÁË..." ::msgcat::mcset ru_ru.koi8-r "Save Selection..." "óÏÈÒÁÎÉÔØ ×ÙÄÅÌÅÎÎÙÊ ÆÒÁÇÍÅÎÔ..." ::msgcat::mcset ru_ru.koi8-r "Undo" "ïÔÍÅÎÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Cut" "÷ÙÒÅÚÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Copy" "ëÏÐÉÒÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "Paste" "÷ÓÔÁ×ÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Select All" "÷ÙÄÅÌÉÔØ ×Ó£" ::msgcat::mcset ru_ru.koi8-r "Play whole selection:" "ðÒÏÉÇÒÁÔØ ×ÙÄÅÌÅÎÎÙÊ ÆÒÁÇÍÅÎÔ" ::msgcat::mcset ru_ru.koi8-r "Play whole sound:" "ðÒÏÉÇÒÁÔØ ×ÅÓØ Ú×ÕË" ::msgcat::mcset ru_ru.koi8-r "Play at cursor:" "éÇÒÁÔØ ÏÔ ËÕÒÓÏÒÁ" ::msgcat::mcset ru_ru.koi8-r "Toggle play/pause:" ::msgcat::mcset ru_ru.koi8-r "Defined file extension types:" "ïÐÒÅÄÅÌ£ÎÎÙÅ ÔÉÐÙ ÒÁÓÛÉÒÅÎÉÊ ÆÁÊÌÏ×:" ::msgcat::mcset ru_ru.koi8-r "Associate file types..." "áÓÓÏÃÉÉÒÏ×ÁÔØ ÔÉÐÙ ÆÁÊÌÏ×" ::msgcat::mcset ru_ru.koi8-r "Zero Cross Adjust" ::msgcat::mcset ru_ru.koi8-r "Zero Cross Adjust:" ::msgcat::mcset ru_ru.koi8-r "Normalize cancelled" "îÏÒÍÁÌÉÚÁÃÉÑ ÐÒÅÒ×ÁÎÁ" ::msgcat::mcset ru_ru.koi8-r "New channel" "îÏ×ÙÊ ËÁÎÁÌ" ::msgcat::mcset ru_ru.koi8-r "New..." "îÏ×ÙÊ..." ::msgcat::mcset ru_ru.koi8-r "Open..." "ïÔËÒÙÔØ..." ::msgcat::mcset ru_ru.koi8-r "Preferences..." "ðÒÅÄÐÏÞÔÅÎÉÑ..." ::msgcat::mcset ru_ru.koi8-r "Show Console" "ðÏËÁÚÁÔØ ËÏÎÓÏÌØ" ::msgcat::mcset ru_ru.koi8-r "Mixer..." ::msgcat::mcset ru_ru.koi8-r "Edit" "òÅÄÁËÔÉÒÏ×ÁÔØ" ::msgcat::mcset ru_ru.koi8-r "File" "æÁÊÌ" ::msgcat::mcset ru_ru.koi8-r "Transform" "ôÒÁÎÓÆÏÒÍÁÃÉÉ" ::msgcat::mcset ru_ru.koi8-r "Apply Configuration..." "ðÒÉÍÅÎÉÔØ ËÏÎÆÉÇÕÒÁÃÉÀ" ::msgcat::mcset ru_ru.koi8-r "Save Configuration..." "óÏÈÒÁÎÉÔØ ËÏÎÆÉÇÕÒÁÃÉÀ" ::msgcat::mcset ru_ru.koi8-r "Properties..." "èÁÒÁËÔÅÒÉÓÔÉËÉ..." ::msgcat::mcset ru_ru.koi8-r "Properties:" "èÁÒÁËÔÅÒÉÓÔÉËÉ:" ::msgcat::mcset ru_ru.koi8-r "Zoom to Selection" ::msgcat::mcset ru_ru.koi8-r "Delete Pane" "õÄÁÌÉÔØ ÐÏÄÏËÎÏ" ::msgcat::mcset ru_ru.koi8-r "Create Pane" "óÏÚÄÁÔØ ÐÏÄÏËÎÏ" ::msgcat::mcset ru_ru.koi8-r "Input device:" "õÓÔÒÏÊÓÔ×Ï ××ÏÄÁ:" ::msgcat::mcset ru_ru.koi8-r "Output device:" "õÓÔÒÏÊÓÔ×Ï ×Ù×ÏÄÁ:" ::msgcat::mcset ru_ru.koi8-r "Cancel" "ïÔÍÅÎÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Apply" "ðÒÉÍÅÎÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Selection color:" "ã×ÅÔ ×ÙÄÅÌÅÎÉÑ:" ::msgcat::mcset ru_ru.koi8-r "Choose..." "÷ÙÂÒÁÔØ..." ::msgcat::mcset ru_ru.koi8-r "Selection frame color:" "ã×ÅÔ selection frame:" ::msgcat::mcset ru_ru.koi8-r "Y-axis color:" "ã×ÅÔ ÏÓÉ Y:" ::msgcat::mcset ru_ru.koi8-r "Y-axis font:" "ûÒÉÆÔ ÏÓÉ Y:" ::msgcat::mcset ru_ru.koi8-r "Background color:" "ã×ÅÔ ÆÏÎÁ:" ::msgcat::mcset ru_ru.koi8-r "Pane height:" "÷ÙÓÏÔÁ ÐÏÄÏËÎÁ:" ::msgcat::mcset ru_ru.koi8-r "Pixels per second:" "ðÉËÓÅÌÅÊ × ÓÅËÕÎÄÕ:" ::msgcat::mcset ru_ru.koi8-r "Choose configuration" "÷ÙÂÅÒÉÔÅ ËÏÎÆÉÇÕÒÁÃÉÀ" ::msgcat::mcset ru_ru.koi8-r "pixels" "ÐÉËÓÅÌÅÊ" ::msgcat::mcset ru_ru.koi8-r "Pane scrolled" "ðÏÄÏËÎÏ ÓËÒÏÌÌÉÒÕÅÔÓÑ" ::msgcat::mcset ru_ru.koi8-r "Pane scroll height:" "÷ÙÓÏÔÁ ÐÏÌÑ ÓËÒÏÌÌÉÎÇÁ" ::msgcat::mcset ru_ru.koi8-r "Display selection length" "éÎÄÉÃÉÒÏ×ÁÔØ ÄÌÉÎÕ ×ÙÄÅÌÅÎÎÏÇÏ ÆÒÁÇÍÅÎÔÁ" ::msgcat::mcset ru_ru.koi8-r "Sound storage:" "èÒÁÎÅÎÉÅ Ú×ÕËÁ:" ::msgcat::mcset ru_ru.koi8-r "keep on disk" "ÏÓÔÁ×ÌÑÔØ ÎÁ ÄÉÓËÅ" ::msgcat::mcset ru_ru.koi8-r "load into memory" "ÚÁÇÒÕÖÁÔØ × ÐÁÍÑÔØ" ::msgcat::mcset ru_ru.koi8-r "Temporary directory:" "Temp-ËÁÔÁÌÏÇ" ::msgcat::mcset ru_ru.koi8-r "Print command:" "ëÏÍÁÎÄÁ ÐÅÞÁÔÉ:" ::msgcat::mcset ru_ru.koi8-r "Preview command:" "ëÏÍÁÎÄÁ preview:" ::msgcat::mcset ru_ru.koi8-r "Record time limit:" "ìÉÍÉÔ ×ÒÅÍÅÎÉ ÚÁÐÉÓÉ:" ::msgcat::mcset ru_ru.koi8-r "s" "Ó" ::msgcat::mcset ru_ru.koi8-r "Icons:" "éËÏÎËÉ:" ::msgcat::mcset ru_ru.koi8-r "Do not query for configuration" "îÅ ÚÁÐÒÁÛÉ×ÁÔØ ËÏÎÆÉÇÕÒÁÃÉÀ" ::msgcat::mcset ru_ru.koi8-r "Max zoom-in:" "MaËÓ. Õ×ÅÌÉÞÅÎÉÅ" ::msgcat::mcset ru_ru.koi8-r "Automatic scroll during playback" "á×ÔÏÍÁÔÉÞÅÓËÉ ÓËÒÏÌÌÉÒÏ×ÁÔØ ×Ï ×ÒÅÍÑ ÐÒÏÉÇÒÙ×ÁÎÉÑ" ::msgcat::mcset ru_ru.koi8-r "Installed plug-ins:" "éÎÓÔÁÌÌÉÒÏ×ÁÎÎÙÅ plug-in'Ù:" ::msgcat::mcset ru_ru.koi8-r "Description:" "ïÐÉÓÁÎÉÅ:" ::msgcat::mcset ru_ru.koi8-r "Save to PS-file:" "óÏÈÒÁÎÉÔØ × PS-ÆÁÊÌÅ:" ::msgcat::mcset ru_ru.koi8-r "Save" "óÏÈÒÁÎÉÔØ" ::msgcat::mcset ru_ru.koi8-r "Printing..." "ðÅÞÁÔÁÅÍ..." ::msgcat::mcset ru_ru.koi8-r "Do you really want to close?" "÷Ù ÄÅÊÓÔ×ÉÔÅÌØÎÏ ÈÏÔÉÔÅ ÚÁËÒÙÔØ?" wavesurfer-1.8.8p5/msgs/se.msg000066400000000000000000000164001325326000200162500ustar00rootroot00000000000000::msgcat::mcset se "Initializing..." "Initialiserar..." ::msgcat::mcset se "Components read:" "Antal lästa komponenter:" ::msgcat::mcset se "Normalize" "Normalisera" ::msgcat::mcset se "Normalize to:" "Normalisera till:" ::msgcat::mcset se "Create Pane" "Skapa yta" ::msgcat::mcset se "Delete Pane" "Ta bort yta" ::msgcat::mcset se "Apply Configuration..." "Applicera konfiguration..." ::msgcat::mcset se "Save Configuration..." "Spara konfiguration..." ::msgcat::mcset se "Properties..." "Egenskaper..." ::msgcat::mcset se "Apply" "Applicera" ::msgcat::mcset se "Pane" "Yta" ::msgcat::mcset se "Sound" "Ljud" ::msgcat::mcset se "Playback" "Uppspelning" ::msgcat::mcset se "Selection color:" "Markeringsramens färg:" ::msgcat::mcset se "Selection frame color:" "Markeringens ram:" ::msgcat::mcset se "Y-axis color:" "Y-axelns färg:" ::msgcat::mcset se "Y-axis font:" "Y-axelns typsnitt:" ::msgcat::mcset se "Background color:" "Bakgrundsfärg:" ::msgcat::mcset se "Cursor color:" "Pekarens färg:" ::msgcat::mcset se "Pane height:" "Ytans höjd:" ::msgcat::mcset se "Vertical zoom factor:" "Vertikal zoomfaktor:" ::msgcat::mcset se "Display selection length" "Visa markeringens längd" ::msgcat::mcset se "Choose..." "Välj..." ::msgcat::mcset se "Sound file properties" "Ljudfilsegenskaper" ::msgcat::mcset se "Filename:" "Filnamn:" ::msgcat::mcset se "Sound file format:" "Ljudfilsformat:" ::msgcat::mcset se "Sample rate:" "Samplingshastiget:" ::msgcat::mcset se "Number of channels:" "Antal kanaler:" ::msgcat::mcset se "Sample format encoding:" "Sampelformat:" ::msgcat::mcset se "Sound length:" "Ljudlängd:" ::msgcat::mcset se "File size:" "Filstorlek:" ::msgcat::mcset se "File date:" "Fildatum:" ::msgcat::mcset se "Change sound properties" "Ändra ljudformatsegenskaper" ::msgcat::mcset se "Set sample rate:" "Sätt samplingshastiget:" ::msgcat::mcset se "Set sample encoding:" "Sätt sampelformat:" ::msgcat::mcset se "Set number of channels:" "Sätt antal kanaler:" ::msgcat::mcset se "Channel mapping:" "Kanal-allokering:" ::msgcat::mcset se "None (single channel sound)" "Ingen (mono-ljud)" ::msgcat::mcset se "out:" "ut:" ::msgcat::mcset se "Right" "Höger" ::msgcat::mcset se "Left" "Vänster" ::msgcat::mcset se "Input channel" "In-kanal" ::msgcat::mcset se "Input device:" "Inspelningsenhet:" ::msgcat::mcset se "Output device:" "Uppspelningsenhet:" ::msgcat::mcset se "Sound storage:" "Ljudlagring:" ::msgcat::mcset se "Temporary directory:" "Temporär katalog:" ::msgcat::mcset se "" "" ::msgcat::mcset se "Record time limit:" "Inspelningsbegränsning:" ::msgcat::mcset se "Show level meter" "Visa nivåmätare" ::msgcat::mcset se "File" "Arkiv" ::msgcat::mcset se "New" "Nytt" ::msgcat::mcset se "Open..." "Öppna..." ::msgcat::mcset se "Revert" "Återgå" ::msgcat::mcset se "Chooser..." "Väljaren..." ::msgcat::mcset se "Save" "Spara" ::msgcat::mcset se "Save As..." "Spara som..." ::msgcat::mcset se "Save Selection..." "Spara markering..." ::msgcat::mcset se "Show Console..." "Visa konsol..." ::msgcat::mcset se "Print..." "Skriv ut..." ::msgcat::mcset se "Preferences..." "Inställningar..." ::msgcat::mcset se "Preferences" "Inställningar" ::msgcat::mcset se "Mixer..." "Mixer..." ::msgcat::mcset se "Close" "Stäng" ::msgcat::mcset se "Exit" "Avsluta" ::msgcat::mcset se "Edit" "Redigera" ::msgcat::mcset se "Undo" "Ångra" ::msgcat::mcset se "Cut" "Klipp ut" ::msgcat::mcset se "Copy" "Kopiera" ::msgcat::mcset se "Paste" "Klistra in" ::msgcat::mcset se "Mix Paste..." "Mixa in..." ::msgcat::mcset se "Select All" "Markera allt" ::msgcat::mcset se "Selection to New" "Markering som nytt" ::msgcat::mcset se "Zero Cross Adjust" "Justera till nollgenomgång" ::msgcat::mcset se "Transform" "Transformera" ::msgcat::mcset se "Convert..." "Konvertera..." ::msgcat::mcset se "Amplify..." "Förstärk..." ::msgcat::mcset se "Fade..." "Tona..." ::msgcat::mcset se "Normalize..." "Normalisera..." ::msgcat::mcset se "Echo..." "Eko..." ::msgcat::mcset se "Mix Channels..." "Mixa kanaler..." ::msgcat::mcset se "Invert" "Invertera" ::msgcat::mcset se "Reverse" "Backa" ::msgcat::mcset se "Silence" "Tystnad" ::msgcat::mcset se "Silence..." "Tystnad..." ::msgcat::mcset se "Remove DC" "Ta bort DC" ::msgcat::mcset se "Convert" "Konvertera" ::msgcat::mcset se "Amplify" "Förstärk" ::msgcat::mcset se "Fade" "Fade" ::msgcat::mcset se "Normalize" "Normalisera" ::msgcat::mcset se "Echo" "Eko" ::msgcat::mcset se "Mix Channels" "Mixa kanaler" ::msgcat::mcset se "View" "Visa" ::msgcat::mcset se "Master Sound" "Visa" ::msgcat::mcset se "None" "Ingen" ::msgcat::mcset se "Zoom In" "Zooma in" ::msgcat::mcset se "Zoom Out" "Zooma ut" ::msgcat::mcset se "Zoom Out Full" "Zooma ut helt" ::msgcat::mcset se "Zoom to Selection" "Zooma till markering" ::msgcat::mcset se "Debug" "Avlusa" ::msgcat::mcset se "Trace Procedure Calls" "Spåra proceduranrop" ::msgcat::mcset se "Snack Trace Level" "Spårningsnivå i Snack" ::msgcat::mcset se "Level 1" "Nivå 1" ::msgcat::mcset se "Level 2" "Nivå 2" ::msgcat::mcset se "Level 3" "Nivå 3" ::msgcat::mcset se "Level 4" "Nivå 4" ::msgcat::mcset se "Level 5" "Nivå 5" ::msgcat::mcset se "Help" "Hjälp" ::msgcat::mcset se "About Plug-ins" "Om plug-ins" ::msgcat::mcset se "About WaveSurfer" "Om WaveSurfer" ::msgcat::mcset se "Choose Configuration" "Välj konfiguration" ::msgcat::mcset se "You have unsaved changes." "Det finns icke sparade ändringar." ::msgcat::mcset se "Do you really want to close?" "Vill du verkligen stänga?" ::msgcat::mcset se "Chooser" "Väljaren" ::msgcat::mcset se "Add files..." "Lägg till filer..." ::msgcat::mcset se "Load file list..." "Öppna fillista..." ::msgcat::mcset se "Clear list" "Rensa lista" ::msgcat::mcset se "Sort" "Sortera" ::msgcat::mcset se "Load new file into current sound" "Öppna ny fil i befintligt fönster" ::msgcat::mcset se "Auto play" "Automatisk uppspelning" ::msgcat::mcset se "Print:" "Skriv ut:" ::msgcat::mcset se "Print" "Skriv ut" ::msgcat::mcset se "Preview" "Visa" ::msgcat::mcset se "to" "till" ::msgcat::mcset se "Print selection only" "Skriv endast ut markering" ::msgcat::mcset se "Print command:" "Kommando för utskrift:" ::msgcat::mcset se "Preview command:" "Kommando för skärmutskrift:" ::msgcat::mcset se "Save to PS-file:" "Spara som PS-fil:" ::msgcat::mcset se "Printing..." "Skriver ut..." ::msgcat::mcset se "File:" "Filnamn:" ::msgcat::mcset se "Page:" "Sida:" ::msgcat::mcset se "Pages:" "Sidorna:" ::msgcat::mcset se "of" "av" ::msgcat::mcset se "Printed:" "Utskriven:" ::msgcat::mcset se "Cancel" "Avbryt" ::msgcat::mcset se "Channels" "Kanaler" ::msgcat::mcset se "Sample Encoding" "Samplingsformat" ::msgcat::mcset se "Sample Rate" "Samplingshastiget" ::msgcat::mcset se "Amplify by:" "Förstärk med:" ::msgcat::mcset se "Decibels" "Decibel" ::msgcat::mcset se "Keys" "Tangenter" ::msgcat::mcset se "Raw files" "Rå-filer" ::msgcat::mcset se "Misc" "Blandat" ::msgcat::mcset se "Sound I/O" "Ljud I/O" ::msgcat::mcset se "Delete" "Ta bort" ::msgcat::mcset se "Defaults" "Återställ" ::msgcat::mcset se "Waveform" "Vågform" ::msgcat::mcset se "Spectrogram" "Spektrogram" ::msgcat::mcset se "Pitch contour" "Grundtonskurva" ::msgcat::mcset se "Power plot" "Energikurva" ::msgcat::mcset se "Formants" "Formanter" ::msgcat::mcset se "Default configuration:" "Standardkonfiguration:" ::msgcat::mcset se "Make this the default configuration" "Gör detta till standardkonfiguration" ::msgcat::mcset se "" "" wavesurfer-1.8.8p5/src/000077500000000000000000000000001325326000200147465ustar00rootroot00000000000000wavesurfer-1.8.8p5/src/app-wavesurfer/000077500000000000000000000000001325326000200177155ustar00rootroot00000000000000wavesurfer-1.8.8p5/src/app-wavesurfer/pkgIndex.tcl000066400000000000000000000003511325326000200221710ustar00rootroot00000000000000# Automatically generated package index file # date : Thu Jan 26 14:20:04 CET 2017 # cmdline: build/mkPkgIndex.tcl src/app-wavesurfer/wavesurfer.tcl package ifneeded app-wavesurfer 1.8 [list source [file join $dir wavesurfer.tcl]] wavesurfer-1.8.8p5/src/app-wavesurfer/wavesurfer.tcl000066400000000000000000003045541325326000200226250ustar00rootroot00000000000000#!/bin/sh # the next line restarts using wish \ exec wish "$0" "$@" set RELEASE 1.8.8p5 set BUILD @BUILD@ # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # package provide app-wavesurfer 1.8 catch {package require Tk} set dir [file normalize [file dirname [info script]]] set auto_path [concat [list [file dirname $dir]] $auto_path] package require surfutil proc ShowConsole {} { if {[catch {console show}]} { if {[info command tkcon] == ""} { package require tkcon set ::tkcon::OPT(exec) {} set ::tkcon::PRIV(root) .tkcon set ::tkcon::PRIV(protocol) {} ::tkcon::Init } else { tkcon show } } } # check for --show-console option a.s.a.p. so we may use it to diagnose startup problems # in wrapped apps if {"--show-console" in $argv} { set argv [lreplace $argv [lsearch $argv "--show-console"] [lsearch $argv "--show-console"]] ShowConsole } set version_major 1 set version_minor 8 set version ${version_major}.${version_minor} namespace eval ::splash { variable progress variable filecount set filecount 0 set splash [toplevel .splash -relief raised -bd 1] wm withdraw $splash wm withdraw . wm overrideredirect $splash 1 if [file exists $dir/../../icons/ws10h.gif] { set img [image create photo -file $dir/../../icons/ws10h.gif] } else { set img [image create photo] } set pad 20 set width [expr [image width $img]+2*$pad] set height [expr [image height $img]+2*$pad] set bg lightgray set fg black set fg2 black pack [label $splash.lx -text [::util::mc "WaveSurfer 1.8.8p5"] -font "helvetica 12" -bg $bg -fg $fg] -side top -expand 1 -fill x pack [canvas $splash.c -width $width -height $height -bg $bg -highlightthickness 0] -side top $splash.c create image $pad $pad -image $img -anchor nw pack [label $splash.l0 -text [::util::mc "Initializing..."] -font "helvetica 12" -bg $bg -fg $fg] -side top -expand 1 -fill x pack [frame $splash.f -bg $bg] -side top -expand 1 -fill x pack [label $splash.f.l1 -text [::util::mc "Components read:"] -font "helvetica 12" -bg $bg -fg $fg] -side left -expand 1 -fill x pack [label $splash.f.l2 -textvariable ::splash::progress -font "helvetica 12" -bg $bg -fg $fg2 -anchor w] -side left -expand 1 -fill x set ww $width set wh [expr {$height+150}] wm geometry $splash +[expr {([winfo screenwidth .]-$ww)/2}]+[expr {([winfo screenheight .]-$wh)/2}] wm deiconify $splash update idletasks } set proctracefile [file join [file dirname [info script]] proctrace.tcl] if {[file exists $proctracefile]} { # source $proctracefile } if {$::tcl_platform(os) == "Darwin"} { set ::ocdir right } else { set ::ocdir left } set surf(wavesurferdir) [file dirname [info script]] proc SetIcon {w} { if {[info exists ::wrap] && [info commands winico] != ""} { set icofile [file join $::wrap(dir) icons b32-256.ico] if {[file exists $icofile]} { if {![info exists ::surf(board)]} { set tmpfile [file join [util::tmpdir] board.ico] set fin [open $icofile r] fconfigure $fin -translation binary set fout [open $tmpfile w] fconfigure $fout -translation binary puts -nonewline $fout [read $fin] close $fin close $fout set ::surf(board) [winico create $tmpfile] file delete $tmpfile } # set the toplevel icon... winico setwindow $w $::surf(board) # set the taskbar icon... # winico text $::surf(board) {WaveSurfer, LMB: play/pause, MMB: record/stop} # winico taskbar add $::surf(board) -callback [list taskbarCallback %m %x %y] } } } proc taskbarCallback {m x y} { if {[string match WM_LBUTTONUP $m ]} { PlayPause } if {[string match WM_MBUTTONUP $m ]} { set w [::wsurf::GetCurrent] if {$w == ""} return if {[$w getInfo isRecording] == 1} { $w stop } else { $w record } } } # try to remove all libsnack* files in the tmp directory # note: a currently loaded library cannot be deleted, # it will have to stay until next time. # CleanUp will called both at startup and exit. proc CleanUp {} { foreach f [glob -nocomplain [file join [util::tmpdir] libsnack*]] { catch {file delete -force $f} } } set surf(fileFormat) WAV set surf(extTypes) {} set surf(loadTypes) {} set surf(loadKeys) {} set surf(saveTypes) {} set surf(saveKeys) {} proc GetTopLevel {w} { if {$w == ""} { return [lindex $::Info(toplevels) 0] } return .[lindex [split $w .] 1] } proc GetCurrentPath {} { set w [::wsurf::GetCurrent] set path "" if {$w != ""} { if {[$w getInfo fileName] != ""} { set path [file dirname [$w getInfo fileName]] } } if {$w == "" && $path == ""} { if {[info exists ::recentFiles] && [llength $::recentFiles] > 0} { set path [file dirname [lindex $::recentFiles 0]] if {[file exists $path] == 0} { set path "" } } } return $path } proc Open {} { set w [::wsurf::GetCurrent] set path [GetCurrentPath] # workaround for evil windows tk_get*File bug set mb [GetTopLevel $w].bf.lab messagebar::configure $mb -state disabled # For unknown RAW files, add the current extension to the list in the file selection dialog if {$::surf(fileFormat) == "RAW"} { if {[info exists ::recentFiles] && [llength $::recentFiles] > 0} { set ext [file extension [lindex $::recentFiles 0]] if {[regexp " $ext\}" $::surf(loadTypes)] == 0} { set ::surf(loadTypes) [concat $::surf(loadTypes) [list "{Raw Files} $ext"]] snack::addLoadTypes $::surf(loadTypes) $::surf(loadKeys) } } } set fileName [snack::getOpenFile -initialdir $path -format $::surf(fileFormat)] update messagebar::configure $mb -state normal if {$fileName == ""} return OpenFile $fileName } set filelist {} set fileName {} proc ReadFileList {fileName} { if {[file isdir $fileName]} { set ::listfiles [glob $fileName/*.wav] set ::filelist {} } else { set fd [open $fileName] set ::listfiles {} set ::filelist {} foreach e [split [read -nonewline $fd] \n] { if {[string match windows $::tcl_platform(platform)]} { regsub -all {\\} $e "/" e } lappend ::listfiles $e } close $fd } foreach n [list 0 1 2 3] { if {[file dirname [lindex $::listfiles 0]] == "."} break set path [eval file join [lrange [file split \ [file dirname [lindex $::listfiles 0]]] 0 end-$n]] set chopMore 0 foreach f $::listfiles { if {[string match "$path*" $f] == 0} { set chopMore 1 ; break} } if {$chopMore == 0} break } foreach e $::listfiles { set name [eval file join [lrange [file split $e] end-$n end]] if {[regexp {.*:[\d]+} $e]} { regexp {(.*):[\d]+} $name dummy shortname regexp {(.*):[\d]+} $e dummy longname set ::filemap($shortname) $longname } else { set ::filemap($name) $e } lappend ::filelist $name } set ::fileName $fileName } proc UpdateFileList {files} { if {[string match windows $::tcl_platform(platform)]} { regsub -all {\\} $files "/" files } set ::listfiles $files set ::filelist {} foreach n [list 0 1 2 3] { if {[file dirname [lindex $::listfiles 0]] == "."} break set path [eval file join [lrange [file split \ [file dirname [lindex $::listfiles 0]]] 0 end-$n]] set chopMore 0 foreach f $::listfiles { if {[string match "$path*" $f] == 0} { set chopMore 1 ; break} } if {$chopMore == 0} break } foreach e $::listfiles { set name [eval file join [lrange [file split $e] end-$n end]] if {[regexp {.*:[\d]+} $e]} { regexp {(.*):[\d]+} $name dummy shortname regexp {(.*):[\d]+} $e dummy longname set ::filemap($shortname) $longname } else { set ::filemap($name) $e } lappend ::filelist $name } } proc Chooser {} { catch {destroy .chooser} set e [toplevel .chooser] # wm geometry .blowup +$v(blowupwinx)+$v(blowupwiny) wm title $e [::util::mc "Chooser"] pack [ttk::frame $e.frame] -side top -expand yes -fill both scrollbar $e.frame.scroll -command "$e.frame.list yview" listbox $e.frame.list -yscroll "$e.frame.scroll set" -setgrid 1 -selectmode single -exportselection false -height 16 -width 40 pack $e.frame.scroll -side right -fill y pack $e.frame.list -side left -expand 1 -fill both bind $e.frame.list {Choose %y} foreach file $::filelist { $e.frame.list insert end $file } pack [ttk::frame $e.f2] -fill x pack [ttk::button $e.f2.b2 -width 12 -text [::util::mc "Add files..."] -command AddFilesToList] -side left -padx 5 -pady 5 pack [ttk::button $e.f2.b1 -width 12 -text [::util::mc "Load file list..."] -command LoadFileList] -side left -padx 5 -pady 5 pack [ttk::button $e.f2.b3 -width 12 -text [::util::mc "Clear list"] -command ClearFileList] -side left -padx 5 -pady 5 pack [ttk::button $e.f2.b4 -width 12 -text [::util::mc "Sort"] -command SortFileList] -side left -padx 5 -pady 5 # pack [ttk::frame $e.f3] -fill x # pack [label $e.f3.l1 -text [::util::mc "File path:"]] -side left # pack [ttk::entry $e.f3.e1 -textvariable Info(chooser,dir)] -side left # pack [ttk::button $e.f3.b1 -text [::util::mc "Browse..."] -command browseForDir] -side left pack [ttk::frame $e.f4] -fill x -ipadx 10 -ipady 10 pack [ttk::checkbutton $e.f4.cb -text [::util::mc "Load new file into current sound"] -variable ::Info(chooser,replacecurrent)] -side left -padx 5 -pady 5 pack [ttk::checkbutton $e.f4.cb2 -text [::util::mc "Auto play"] -variable ::Info(chooser,autoplay)] -side left -padx 5 -pady 5 pack [ttk::checkbutton $e.f4.cb3 -text [::util::mc "Auto zoom out"] -variable ::Info(chooser,autozoom)] -side left -padx 5 -pady 5 } proc LoadFileList {} { set fn [tk_getOpenFile -initialdir [GetCurrentPath]] if {$fn == ""} return set fd [open $fn] UpdateFileList [split [read -nonewline $fd] \n] close $fd set e .chooser $e.frame.list delete 0 end foreach file $::filelist { $e.frame.list insert end $file } } proc AddFilesToList {} { set newfiles [tk_getOpenFile -title [::util::mc "Select files to add"] -multiple 1 -initialdir [GetCurrentPath]] UpdateFileList [concat $::filelist $newfiles] set e .chooser $e.frame.list delete 0 end foreach file $::filelist { $e.frame.list insert end $file } } proc ClearFileList {} { set e .chooser $e.frame.list delete 0 end UpdateFileList [list] } proc SortFileList {} { set e .chooser $e.frame.list delete 0 end foreach file [lsort -dictionary $::filelist] { $e.frame.list insert end $file } } proc Choose y { set index [.chooser.frame.list nearest $y] ChooseEntry $index } proc ChooseNext {} { set index [.chooser.frame.list curselection] .chooser.frame.list selection clear $index incr index .chooser.frame.list selection set $index ChooseEntry $index set w [::wsurf::GetCurrent] $w xscroll moveto 0.0 $w configure -selection [list 0.0 0.0] } proc ChooseEntry {index} { set entry [.chooser.frame.list get $index] foreach {name pos} [split $entry ;] {} set w [::wsurf::GetCurrent] if {$w == ""} { set w [newWidget "" expanded] } if {[info exists ::filemap($name)]} { if {$::Info(chooser,replacecurrent) && $w != ""} { # load file into current widget $w openFile $::filemap($name) if {[$w cget -configuration] == ""} { if {[lindex $::surf(conf) 0] != "unspecified"} { $w configure -configuration [lindex $::surf(conf) 0] } } } elseif {$::surf(conf) != "unspecified"} { OpenFile $::filemap($name) [lindex $::surf(conf) 0] } else { OpenFile $::filemap($name) } if 0 { # 070910, for playing back float-files set ::convert(encoding) Lin16 set ::convert(rate) 44100 set ::convert(channels) 1 DoConvert $w set length [[$w cget -sound] length -unit seconds] $w configure -selection [list 0.0 $length] DoNormalize $w } if {$::Info(chooser,autoplay)} { [wsurf::GetCurrent] play } } if {$::Info(chooser,autozoom)} { [::wsurf::GetCurrent] zoomall } if {$pos != ""} { set w [::wsurf::GetCurrent] $w configure -selection [list $pos $pos] $w zoomin $w zoomout } else { $w configure -selection [list 0.0 0.0] } set title [::util::mc "Chooser"] append title " ([expr $index+1] of [llength $::filelist])" append title " $::fileName" wm title .chooser $title } proc Revert {} { if {[::wsurf::NeedSave]} { if {[tk_messageBox -message "[::util::mc "You have unsaved changes."] \n [::util::mc "Do you really want to revert to the file on disk?"]" -type yesno -icon question] == "no"} { return } } set w [::wsurf::GetCurrent] if {$w != ""} { if {[$w getInfo fileName] != ""} { $w openFile [$w getInfo fileName] } } } proc OpenFile {args} { puts [info level 0] puts defaultConfig=$::wsurf::Info(Prefs,defaultConfig) global surf variable Info set fileName [lindex $args 0] if {![file readable $fileName]} { tk_messageBox -message "[::util::mc {Can't open the file}] \"$fileName\"" \ -icon error return } set w [::wsurf::GetCurrent] if {$w != "" && [$w getInfo isUntouched]} { $w closeWidget } if {[::wsurf::GetCurrent] != ""} { set w [CreateToplevel] } else { set w [wsurf [GetTopLevel $w].s[incr surf(count)] \ -messageproc setMsg -progressproc progressCallback \ -playpositionproc progressCallback -dropfileproc dropFileCallback] lappend ::Info(widgets,$::Info(toplevels)) $w } $w openFile $fileName pack $w -expand 0 -fill both -side top set conf "" if {[llength $args] == 1} { if {$::wsurf::Info(Prefs,defaultConfig) == ""} { set makedefault 0 set conf [::wsurf::ChooseConfigurationDialog makedefault] if {$conf == ""} { destroy $w return } puts makedefault=$makedefault if $makedefault { wsurf::SetPreference defaultConfig [file root [file tail $conf]] ::SavePreferences } } else { set l [::wsurf::GetConfigurations] set ind [lsearch -regexp $l ".*$::wsurf::Info(Prefs,defaultConfig)\[\\w\\s\]*.conf"] if {$ind != -1} { set conf [lindex $l $ind] } else { set conf "" } } if {$conf == "standard"} { set conf "" } } else { set conf [lindex $args 1] } $w configure -configuration $conf SetMasterWidget # Remember this file format type for next time set surf(fileFormat) [lindex [[$w cget -sound] info] 6] RecentFile $fileName if {$surf(play)} { $w play } # set mb [GetTopLevel $w].bf.lab # messagebar::configure $mb -text [[$w cget -sound] info] } proc CreateToplevel {} { global surf incr surf(count) if {[string match separate $::wsurf::Info(Prefs,createWidgets)]} { toplevel .x$surf(count) lappend ::Info(toplevels) .x$surf(count) wm title .x$surf(count) "WaveSurfer #$surf(count)" CreateMenus .x$surf(count) CreateToolbar .x$surf(count) CreateMessagebar .x$surf(count) BindKeys .x$surf(count) proc pgcb.x$surf(count) {args} { set name [string trimleft [lindex [info level 0] 0] pgcb].bf.lab eval progressCallback2 $name $args } proc smcb.x$surf(count) {args} { set name [string trimleft [lindex [info level 0] 0] smcb].bf.lab eval setMsg2 $name $args } set index [lsearch -exact $::wsurf::Info(Prefs,icons) close] set icons [lreplace $::wsurf::Info(Prefs,icons) $index $index] set w [wsurf .x$surf(count).s$surf(count) -icons $icons \ -messageproc smcb.x$surf(count) -progressproc pgcb.x$surf(count)\ -playpositionproc pgcb.x$surf(count) -dropfileproc dropFileCallback] wm protocol .x$surf(count) WM_DELETE_WINDOW [list KillWindow .x$surf(count)] wm minsize .x$surf(count) 200 1 wm resizable .x$surf(count) 1 0 lappend ::Info(widgets,.x$surf(count)) $w } else { set w [wsurf [lindex $::Info(toplevels) 0].s[incr surf(count)] \ -messageproc setMsg -progressproc progressCallback \ -playpositionproc progressCallback -dropfileproc dropFileCallback] lappend ::Info(widgets,[lindex $::Info(toplevels) 0]) $w } return $w } proc RecentFile fn { global recentFiles if {$fn == ""} return if {[info exists recentFiles]} { } else { set recentFiles {} } set index [lsearch -exact $recentFiles $fn] set recentFiles [lreplace $recentFiles $index $index] set recentFiles [linsert $recentFiles 0 $fn] if {[llength $recentFiles] > 6} { set recentFiles [lreplace $recentFiles 6 end] } foreach tl $::Info(toplevels) { set m $tl.menu $m.file delete $::fileMenuIndex end foreach e $recentFiles { set l $e if {[string length $e] > 30} { set l ...[string range $e [expr {[string length $e]-30}] end] } $m.file add command -label $l -command [list OpenFile $e] } $m.file add separator $m.file add command -label [::util::mc Close] -command [list Close $tl] \ -accelerator $::AccKeyM+W if {$::tcl_platform(os) != "Darwin"} { $m.file add command -label [::util::mc Exit] -command Exit } } set fn [file join $::env(HOME) .wavesurfer $::Info(Version) recent-files] if {[catch {open $fn w} out]} { } else { puts $out "set ::recentFiles \[list $recentFiles\]" close $out } } proc PlayFile {filename} { set ::surf(play) 1 OpenFile $filename "" } proc BreakIfInvalid {w} { if {[string match *.bf [focus]]} { regexp {(\.x[0-9]*\.).*} $w junk w } if {[string match *.tb.* [focus]]} { regexp {(\.x[0-9]*\.).*} $w junk w } if {$w == "" || ([string match $w* [focus]] == 0 && \ [string match .tkcon.text [focus]] == 0)} { return -code return } } proc Save {{w ""}} { puts [info level 0] if {$w==""} { set w [::wsurf::GetCurrent] BreakIfInvalid $w } set fn [$w getInfo fileName] puts fn=$fn if {$fn == ""} { return [SaveAs $w] } else { $w saveFile $fn return $fn } } proc SaveAs {{w ""}} { if {$w==""} { set w [::wsurf::GetCurrent] BreakIfInvalid $w } return [$w saveAs] } proc SaveAs:OLD {} { puts [info level 0] set w [::wsurf::GetCurrent] # BreakIfInvalid $w set path [file dirname [$w getInfo fileName]] set fileName [snack::getSaveFile -initialdir $path \ -format $::surf(fileFormat)] if {$fileName == ""} return "" $w saveFile $fileName return $filename } proc SaveSelection {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w 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 fileName [snack::getSaveFile -initialdir $path \ -format $::surf(fileFormat)] if {$fileName == ""} return $s write $fileName -start $start -end $end -progress progressCallback } proc Print {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w printDialog } proc Close {p} { if {[llength $::Info(widgets,$p)] == 1} { # Choose the single widget of this toplevel set w $::Info(widgets,$p) } else { # Get current widget set w [::wsurf::GetCurrent] # If it isn't a child of the current toplevel, get the first child instead set n [lsearch $::Info(widgets,$p) $w] if {$n == -1} { set n 0 } set w [lindex $::Info(widgets,$p) $n] } if {[winfo exists $w]} { $w closeWidget } # If there are several toplevels check if this one should be closed if {[llength $::Info(toplevels)] > 1} { # Remove the widget from the widget list for this toplevel set n [lsearch $::Info(widgets,$p) $w] set ::Info(widgets,$p) [lreplace $::Info(widgets,$p) $n $n] # Close the toplevel if there are no children left if {[llength $::Info(widgets,$p)] == 0} { set n [lsearch $::Info(toplevels) $p] set ::Info(toplevels) [lreplace $::Info(toplevels) $n $n] destroy $p } } } proc KillWindow {w} { if {[llength $::Info(toplevels)] > 1 || [winfo exists .chooser]} { # Close all widgets in this toplevel foreach widget $::Info(widgets,$w) { Close $w } } else { # Exit if this was the last toplevel closed Exit } } set Info(showExitDialog) 1 proc Exit:OLD {} { if {[::wsurf::NeedSave]} { if {$::Info(showExitDialog)} { set ::Info(showExitDialog) 0 if {[tk_messageBox -message "[::util::mc "You have unsaved changes."] \n [::util::mc "Do you really want to exit?"]" -type yesno -icon question] == "no"} { set ::Info(showExitDialog) 1 return } } else { return } } # Remember geometry if {[winfo exists .x]} { if {[catch {open $::Info(geometryFile) w} out]} { } else { regexp {([\d]+)[x][\d]+[+]([\d]+)[+]([\d]+)} [wm geometry .x] dummy w x y if {[info exists w]} { puts $out "set Info(Prefs,wsWidth) $w" puts $out "set Info(Prefs,wsLeft) $x" puts $out "set Info(Prefs,wsTop) $y" } close $out } } foreach f $::surf(tmpfiles) { file delete -force $::surf(tmpfiles) } CleanUp if {[info exists ::wrap] && [info commands winico] != ""} { # winico taskbar delete $::surf(board) } exit } # rename the exit command so we can catch it rename exit _exit proc exit {} {Exit} proc Exit {} { foreach w [wsurf::GetUnsavedWidgets] { # try to close widget. this will pop up an ask-for-save dialog # if happily closed, it returns true. else (user cancelled), # it returns false if {![$w closeWidget]} { return } } # if we got here, it's really time to exit. # Remember geometry if {[winfo exists .x]} { if {[catch {open $::Info(geometryFile) w} out]} { } else { regexp {([\d]+)[x][\d]+[+]([\d]+)[+]([\d]+)} [wm geometry .x] dummy w x y if {[info exists w]} { puts $out "set Info(Prefs,wsWidth) $w" puts $out "set Info(Prefs,wsLeft) $x" puts $out "set Info(Prefs,wsTop) $y" } close $out } } foreach f $::surf(tmpfiles) { file delete -force $::surf(tmpfiles) } CleanUp if {[info exists ::wrap] && [info commands winico] != ""} { # winico taskbar delete $::surf(board) } _exit } proc Exit:not {} { foreach w [wsurf::GetUnsavedWidgets] { set qst [::util::mc "Do you want to save the changes made to"] append qst " " \"[$w cget -title]\" "?" set reply [tk_messageBox -message $qst -type yesnocancel] switch $reply { yes { if {[Save $w]==""} { # the save operation was cancelled, don't exit return } } no { # do nothing, really. } cancel { return } } } # if we got here, it's really time to exit. # Remember geometry if {[winfo exists .x]} { if {[catch {open $::Info(geometryFile) w} out]} { } else { regexp {([\d]+)[x][\d]+[+]([\d]+)[+]([\d]+)} [wm geometry .x] dummy w x y if {[info exists w]} { puts $out "set Info(Prefs,wsWidth) $w" puts $out "set Info(Prefs,wsLeft) $x" puts $out "set Info(Prefs,wsTop) $y" } close $out } } foreach f $::surf(tmpfiles) { file delete -force $::surf(tmpfiles) } CleanUp if {[info exists ::wrap] && [info commands winico] != ""} { # winico taskbar delete $::surf(board) } _exit } proc newWidget {conf {state collapsed}} { global surf set w [CreateToplevel] $w configure -configuration $conf pack $w -expand 0 -fill both -side top return $w } proc New {} { if {$::wsurf::Info(Prefs,defaultConfig) == ""} { set makedefault 0 set conf [::wsurf::ChooseConfigurationDialog makedefault] if {$conf == ""} { # deleteWidget return } puts makedefault=$makedefault if $makedefault { wsurf::SetPreference defaultConfig [file root [file tail $conf]] ::SavePreferences } } else { set l [::wsurf::GetConfigurations] set ind [lsearch -regexp $l ".*$::wsurf::Info(Prefs,defaultConfig)\[\\w\\s\]*.conf"] if {$ind != -1} { set conf [lindex $l $ind] } else { set conf "" } } if {$conf == ""} return if {$conf == "standard"} { set conf "" } newWidget $conf expanded SetMasterWidget } proc deleteWidget {} { set w [::wsurf::GetCurrent] destroy $w } proc setMsg {m} { set w [::wsurf::GetCurrent] set mb [GetTopLevel $w].bf.lab setMsg2 $mb $m } proc setMsg2 {mb m} { messagebar::configure $mb -text $m } proc lockMessageBar {w} { set mb [GetTopLevel $w].bf.lab if {$::surf(locked) == 0} { messagebar::configure $mb -locked 1 set ::surf(locked) 1 } else { messagebar::configure $mb -locked 0 set ::surf(locked) 0 } } proc progressCallback {message fraction} { set w [::wsurf::GetCurrent] set mb [GetTopLevel $w].bf.lab progressCallback2 $mb $message $fraction } proc progressCallback2 {mb message fraction} { switch -- $message { "Converting rate" { set message [::util::mc "Converting sample rate..."] } "Converting encoding" { set message [::util::mc "Converting sample encoding format..."] } "Converting channels" { set message [::util::mc "Converting number of channels..."] } "Computing pitch" { set message [::util::mc "Computing pitch..."] } "Computing power" { set message [::util::mc "Computing power..."] } "Reading sound" { set message [::util::mc "Reading sound..."] } "Writing sound" { set message [::util::mc "Writing sound..."] } "Computing waveform" { set message [::util::mc "Precomputing waveform..."] } "Reversing sound" { set message [::util::mc "Reversing sound..."] } "Filtering sound" { set message [::util::mc "Filtering sound..."] } "Play" { set s $::wsurf::Info(ActiveSound) set rangeStart [util::min [expr {int($fraction*[$s cget -rate])}] \ [expr {[$s length]-1}]] set rangeEnd [util::min [expr {int(($fraction+0.1)*[$s cget -rate])}] \ [expr {[$s length]-1}]] set logarg [$s max -start $rangeStart -end $rangeEnd] if {$logarg < 1} { set logarg 1 } set level [expr {log($logarg)/10.3972}] messagebar::configure $mb -level $level set w [::wsurf::GetCurrent] [GetTopLevel $w].tb.time configure -text [$w formatTime $fraction] return } "Stop" { messagebar::configure $mb -level 0.0 set w [::wsurf::GetCurrent] [GetTopLevel $w].tb.time configure -text [$w formatTime $fraction] return } } if {$fraction==0.0} { append message [::util::mc " (click to cancel)"] set ::surf(interrupted) 0 LockGui true } elseif {$fraction>=0.0 && $fraction<1.0} { append message [::util::mc " (click to cancel)"] messagebar::configure $mb -progress $fraction set ::surf(interrupted) 0 } elseif {$fraction==1.0} { append message [::util::mc " done."] messagebar::configure $mb -progress 0.0 LockGui false } messagebar::configure $mb -text $message update # check if someone clicked the messagebar if {$::surf(interrupted)} { return -code error } # inhibit interruption when done if {$fraction==1.0} { set ::surf(interrupted) 1 } } # procedure to lock the gui under time-consuming operations. # grab on the messagebar frame (to recieve interrupt-click). # On windows, the menu bar is not affected by the grab (tk-bug?) # so we need to swap in a dummy menu bar! proc LockGui {state} { set w [::wsurf::GetCurrent] set mbf [GetTopLevel $w].bf if {$state} { set ::surf(oldFocus) [focus] focus $mbf grab $mbf if {[string match windows $::tcl_platform(platform)]} { foreach tl $::Info(toplevels) { $tl config -menu $tl.dummy } } } else { if {[info exists ::surf(oldFocus)] == 0} return grab release $mbf focus $::surf(oldFocus) if {[string match windows $::tcl_platform(platform)]} { foreach tl $::Info(toplevels) { $tl config -menu $tl.menu } } } } proc Interrupt {} { set w [::wsurf::GetCurrent] set mb [GetTopLevel $w].bf.lab if {!$::surf(interrupted)} { messagebar::configure $mb -progress 0.0 messagebar::configure $mb -text [::util::mc Interrupted] LockGui false set ::surf(interrupted) 1 } } proc Undo {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return $w undo } proc Cut {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return $w cut cbs } proc Copy {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return $w copy cbs } proc SelectoNew {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w 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])}] New set wnew [::wsurf::GetCurrent] set snew [$wnew cget -sound] $snew copy $s -start $start -end $end } proc ZoomIn {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w zoomin } proc ZoomOut {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w zoomout } proc ZoomSel {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w zoomsel } proc ZoomAll {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w zoomall } proc Zoom {v} { set w [::wsurf::GetCurrent] BreakIfInvalid $w set pps [winfo fpixels $w ${v}m] $w configure -pixelspersecond $pps } proc Paste {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return $w paste cbs # snack::menuEntryOn Edit Undo } proc DoMixPaste {w} { global mixpaste foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return cbs2 copy $s if [catch {$s mix cbs -start $start -end $end \ -prescaling [expr {$mixpaste(prescale)/ 100.0}] \ -mixscaling [expr {$mixpaste(mixscale)/ 100.0}] \ -progress progressCallback}] { $s copy cbs2 return } ::wsurf::PrepareUndo "$s swap cbs2" "$s swap cbs2" } proc MixPaste {} { global mixpaste set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break if {$left == $right} { $w configure -selection \ [list $left [expr $left + [cbs length -unit seconds]]] } set tl .mixpaste catch {destroy $tl} toplevel $tl wm title $tl [::util::mc "Mix Paste"] pack [ ttk::label $tl.l1 -text [::util::mc "Scale paste sound by:"]] \ -fill x pack [ttk::frame $tl.f1] -fill both -expand true pack [ttk::scale $tl.f1.s1 -command "" -orient horizontal \ -variable mixpaste(mixscale) -from 0.0 -to 100.0] -side left $tl.f1.s1 set $mixpaste(mixscale) pack [ttk::entry $tl.f1.e -textvariable mixpaste(mixscale) -width 5] -side left pack [ttk::label $tl.f1.l -text % -width 1] -side left pack [ttk::label $tl.l2 -text [::util::mc "Scale original sound by:"]] \ -fill x pack [ ttk::frame $tl.f2] -fill both -expand true pack [ttk::scale $tl.f2.s1 -command "" -orient horizontal \ -variable mixpaste(prescale) -from 0.0 -to 100.0] -side left $tl.f2.s1 set $mixpaste(prescale) pack [ttk::entry $tl.f2.e -textvariable mixpaste(prescale) -width 5] -side left pack [ttk::label $tl.f2.l -text % -width 1] -side left insertOKCancelButtons $tl.f3 "DoMixPaste $w;destroy $tl" "destroy $tl" } proc SelectAll {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w 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] } proc ZeroXAdjust {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w set s [$w cget -sound] set length [$s length] if {$length == 0} return foreach m [$w cget -selection] { set start [expr {int($m*[$s cget -rate])}] set leftmost [expr {$start-200}] if {$leftmost < 0} { ;# to fill sample buffer with leftmost $s sample 0 } else { $s sample [expr {$start-200}] } for {set i 0} {$i < 200} {incr i} { set j [expr {$start + $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] < 0} { break } } set j [expr {$start - $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] < 0} { break } } } lappend limits $j } $w configure -selection [list \ [expr {double([lindex $limits 0])/[$s cget -rate]}] \ [expr {double([lindex $limits 1]-1)/[$s cget -rate]}]] } proc PlayPause {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w # Hack that solves double play issue due to keyboard focus and space-button if {[string match *play* [focus]] && $::tcl_platform(platform) == "windows" && $::Info(Prefs,PlayPause) == "space"} { return } if {[$w getInfo isPlaying] == 1} { $w pause } else { $w play } } proc PlayStop {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isPlaying] == 1} { $w stop } else { $w play } } proc PlaySelection {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isPlaying] == 1} { $w stop } $w play } proc PlayAtCursor {x} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isPlaying] == 1} { $w stop } foreach {start end} [$w cget -selection] break set s [$w cget -sound] set rate [$s cget -rate] set c [[lindex [$w _getPanes] 0] canvas] set x [$c canvasx $x] set cursorTime [expr {$x/[$w cget -pixelspersecond]}] if {$cursorTime < $start} { set end $start set start $cursorTime } else { set start $start set end $cursorTime } $w play $start $end } proc PlayAll {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isPlaying] == 1} { $w stop } $w play 0 -1 } proc PlayVisible {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isPlaying] == 1} { $w stop } foreach {left right} [$w cget -zoomfracs] break $w play $left $right } proc PlayLoop {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w $w playloop } # ----------------------------------------------------------------------------- # Transformations proc Reverse {} { set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] set start 0 set end -1 } cbs copy $s if [catch {$s reverse -start $start -end $end \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s reverse -start $start -end $end" \ "$s reverse -start $start -end $end" } proc Invert {} { variable Info set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] set start 0 set end -1 } $Info(filter) configure -1.0 cbs copy $s if [catch {$s filter $Info(filter) -start $start -end $end \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc Silence {} { variable Info set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break if {$left == $right} { InsertSilence $w return } set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] $Info(filter) configure 0.0 cbs copy $s if [catch {$s filter $Info(filter) -start $start -end $end \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc DoInsertSilence {w} { global silence foreach {left right} [$w cget -selection] break set s [$w cget -sound] set insertPos [expr {int($left*[$s cget -rate])}] cbs copy $s snack::sound _doinsertsiltmp -encoding [$s cget -encoding] \ -rate [$s cget -rate] -channels [$s cget -channels] _doinsertsiltmp length [expr {int($silence(l)*[$s cget -rate])}] $s insert _doinsertsiltmp $insertPos _doinsertsiltmp destroy ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc InsertSilence {w} { global silence set tl .sil catch {destroy $tl} toplevel $tl wm title $tl [::util::mc "Insert Silence"] pack [ ttk::frame $tl.f] -fill both -expand true pack [ ttk::label $tl.f.l -text [::util::mc "Silence length:"]] -side left pack [ ttk::entry $tl.f.e -textvariable silence(l) -width 5] -side left pack [ ttk::label $tl.f.l2 -text seconds] -side left insertOKCancelButtons $tl.f3 "DoInsertSilence $w;destroy $tl" "destroy $tl" } proc insertOKCancelButtons {w okcmd cancelcmd} { pack [ ttk::frame $w] -expand true -fill both -ipadx 10 -ipady 10 pack [ ttk::button $w.b1 -text [::util::mc OK] \ -command $okcmd] -side $::ocdir -padx 3 \ -expand true pack [ ttk::button $w.b2 -text [::util::mc Cancel] \ -command $cancelcmd] -side $::ocdir -padx 3 -expand true } proc insertOKCancelButtons2 {w okcmd cancelcmd} { set f [ ttk::frame $w] ttk::button $f.b1 -text [::util::mc OK] -command $okcmd ttk::button $f.b2 -text [::util::mc Cancel] -command $cancelcmd grid x $f.b1 $f.b2 -pady 6 -padx 6 grid columnconfigure $f 0 -weight 1 grid $f #pack $f -side bottom -expand false -fill x } proc RemoveDC {} { variable Info set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] set start 0 set end -1 } cbs copy $s if [catch {$s filter $::remdc(f) -start $start -end $end \ -progress progressCallback -continuedrain 0}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc DoConvert {w} { global convert set s [$w cget -sound] cbs copy $s if {$convert(rate) != [$s cget -rate]} { if {[catch {$s convert -rate $convert(rate) \ -progress progressCallback} ret]} { $s copy cbs if {$ret != ""} { error "$ret" } } else { set convert(rate) [$s cget -rate] } } if {$convert(encoding) != [$s cget -encoding]} { if {[catch {$s convert -encoding $convert(encoding) \ -progress progressCallback} ret]} { $s copy cbs if {$ret != ""} { error "$ret" } } else { set convert(encoding) [$s cget -encoding] } } if {$convert(channels) != [$s cget -channels]} { if {[catch {$s convert -channels $convert(channels) \ -progress progressCallback} ret]} { $s copy cbs if {$ret != ""} { error "$ret" } } else { set convert(channels) [$s cget -channels] } } ::wsurf::PrepareUndo "$s copy cbs" "DoConvert $w" } proc Convert {} { global convert set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return set s [$w cget -sound] set convert(rate) [$s cget -rate] set convert(encoding) [$s cget -encoding] set convert(channels) [$s cget -channels] set tl .conv catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Convert] wm resizable $tl 0 0 ttk::frame $tl.q pack $tl.q -expand 1 -fill both -side top pack [ttk::frame $tl.q.f1] -side left -anchor nw -padx 3m -pady 2m pack [ttk::frame $tl.q.f2] -side left -anchor nw -padx 3m -pady 2m pack [ttk::frame $tl.q.f3] -side left -anchor nw -padx 3m -pady 2m pack [ttk::frame $tl.q.f4] -side left -anchor nw -padx 3m -pady 2m pack [ttk::label $tl.q.f1.l -text [::util::mc "Sample Rate"]] ttk::combobox $tl.q.f1.cb \ -textvariable [namespace current]::convert(rate) \ -width 7 -values [snack::audio rates] pack $tl.q.f1.cb -side left pack [ttk::label $tl.q.f2.l -text [::util::mc "Sample Encoding"]] foreach e [snack::audio encodings] { pack [ttk::radiobutton $tl.q.f2.r$e -text $e -value $e \ -variable [namespace current]::convert(encoding)] -anchor w } pack [ttk::label $tl.q.f3.l -text [::util::mc Channels]] pack [ttk::radiobutton $tl.q.f3.1 -text [::util::mc Mono] -value 1 \ -variable [namespace current]::convert(channels)] -anchor w pack [ttk::radiobutton $tl.q.f3.2 -text [::util::mc Stereo] -value 2 \ -variable [namespace current]::convert(channels)] -anchor w pack [ttk::radiobutton $tl.q.f3.4 -text 4 -value 4 \ -variable [namespace current]::convert(channels)] -anchor w pack [ttk::entry $tl.q.f3.e -textvariable [namespace current]::convert(channels) \ -width 3] -anchor w insertOKCancelButtons $tl.f3 "DoConvert $w;destroy $tl" "destroy $tl" } proc ConfAmplify {flag} { global amplify set w .amp if {$amplify(db) == 1} { $w.f.l configure -text dB set tmp [expr {20.0*log10(($amplify(v)+0.000000000000000001)/100.0)}] $w.f.s1 configure -from -96.0 -to 24.0 } else { $w.f.l configure -text % set tmp [expr {100.0*pow(10,$amplify(v)/20.0)}] $w.f.s1 configure -from 0.0 -to 300.0 } if {$flag} { set amplify(v) $tmp $w.f.s1 set $amplify(v) } } proc DoAmplify {w} { global amplify foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return if {$amplify(db) == 1} { set tmp [expr {pow(10,$amplify(v)/20.0)}] } else { set tmp [expr {$amplify(v) / 100.0}] } $amplify(f) configure $tmp cbs copy $s if [catch {$s filter $amplify(f) -start $start -end $end \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc Amplify {} { global amplify set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] } set tl .amp catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Amplify] wm resizable $tl 0 0 pack [ttk::label $tl.l -text [::util::mc "Amplify by:"] -anchor w] -fill x pack [ ttk::frame $tl.f] -fill both -expand true pack [ttk::scale $tl.f.s1 -command "" -orient horizontal \ -variable amplify(v)] -side left pack [ttk::entry $tl.f.e -textvariable amplify(v) -width 5] -side left pack [ttk::label $tl.f.l -text xx -width 2] -side left pack [ttk::checkbutton $tl.cb -text [::util::mc "Decibels"] -variable amplify(db) \ -command [list ConfAmplify 1]] -fill both -expand true insertOKCancelButtons $tl.f3 "DoAmplify $w;destroy $tl" "destroy $tl" ConfAmplify 0 $tl.f.s1 set $amplify(v) } proc DoFade {w} { global fade foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set length [expr {int(($right-$left)*1000)}] if {$length == 0} return $fade(f) configure $fade(dir) $fade(type) $length [expr $fade(floor)/100.0] cbs copy $s if [catch {$s filter $fade(f) -start $start \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc ShowFadeType {w} { global fade switch $fade(type),$fade(dir) { Linear,In { $w coords fade 0 60 30 30 60 0 } Linear,Out { $w coords fade 0 0 30 30 60 60 } Logarithmic,In { $w coords fade 0 60 10 10 60 0 } Logarithmic,Out { $w coords fade 0 0 50 10 60 60 } Exponential,In { $w coords fade 0 60 50 50 60 0 } Exponential,Out { $w coords fade 0 0 10 50 60 60 } } } proc Fade {} { global fade set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list $left [expr $left+.1]] } set tl .fade catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Fade] pack [ ttk::label $tl.l -text [::util::mc "Fade direction:"] -anchor c] -fill x pack [ ttk::frame $tl.f] -fill both -expand true foreach e [list In Out] { pack [ttk::radiobutton $tl.f.r$e -text $e -value $e \ -variable [namespace current]::fade(dir) \ -command [list ShowFadeType $tl.c]] -anchor w } pack [ ttk::label $tl.l2 -text [::util::mc "Fade type:"] -anchor c] -fill x pack [ ttk::frame $tl.f2] -fill both -expand true foreach e [list Linear Logarithmic Exponential] { pack [ttk::radiobutton $tl.f2.r$e -text $e -value $e \ -variable [namespace current]::fade(type) \ -command [list ShowFadeType $tl.c]] -anchor w } pack [canvas $tl.c -width 60 -height 60] $tl.c create line 0 0 0 0 0 0 -smooth on -tags fade ShowFadeType $tl.c pack [ ttk::frame $tl.f3] -fill x pack [ ttk::label $tl.f3.l -text [::util::mc "Fade floor:"]] -fill x pack [ ttk::frame $tl.f3.f] -fill both -expand true pack [ttk::scale $tl.f3.f.s1 -command "" -orient horizontal \ -variable fade(floor) -from 0.0 -to 100.0] -side left $tl.f3.f.s1 set $fade(floor) pack [ttk::entry $tl.f3.f.e -textvariable fade(floor) -width 5] -side left pack [ttk::label $tl.f3.f.l -text % -width 1] -side left insertOKCancelButtons $tl.f4 "DoFade $w;destroy $tl" "destroy $tl" } proc ConfNormalize {flag} { global normalize set w .norm if {$normalize(db) == 1} { $w.f.l configure -text dB set tmp [expr {20.0*log10(($normalize(v)+0.000000000000000001)/100.0)}] $w.f.s1 configure -from -96.0 -to 0.0 } else { $w.f.l configure -text % set tmp [expr {100.0*pow(10,$normalize(v)/20.0)}] $w.f.s1 configure -from 0.0 -to 100.0 } if {$flag} { set normalize(v) $tmp $w.f.s1 set $normalize(v) } } proc DoNormalize {w} { global normalize foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [util::min [expr {int($right*[$s cget -rate])}] \ [expr {[$s length]-1}]] if {$start == $end} return if {$normalize(db) == 1} { set tmp [expr {pow(10,$normalize(v)/20.0)}] } else { set tmp [expr {$normalize(v) / 100.0}] } if {[string match [$s cget -encoding] Lin8]} { set smax 255.0 } elseif {[string match Lin24* [$s cget -encoding]]} { set smax 8388607.0 } else { set smax 32767.0 } for {set c 0} {$c < [$s cget -channels]} {incr c} { if {$normalize(allEqual)} { set max [$s max -start $start -end $end] set min [$s min -start $start -end $end] } else { set max [$s max -start $start -end $end -channel $c] set min [$s min -start $start -end $end -channel $c] } if {$max < -$min} { set max [expr {-$min}] if {$max > $smax} { set max $smax } } if {$max == 0} { set max 1.0 } set factor [expr {$tmp * $smax / $max}] lappend factors $factor if {$normalize(allEqual)} break if {$c < [expr {[$s cget -channels] - 1}]} { for {set i 0} {$i < [$s cget -channels]} {incr i} { lappend factors 0.0 } } } eval $normalize(f) configure $factors cbs copy $s if [catch {$s filter $normalize(f) -start $start -end $end \ -progress snack::progressCallback}] { SetMsg [::util::mc "Normalize cancelled"] $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc Normalize {} { global normalize set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] } set tl .norm catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Normalize] ttk::label $tl.l -text [::util::mc "Normalize to:"] ttk::frame $tl.f pack [ttk::scale $tl.f.s1 -command "" -orient horizontal \ -variable normalize(v) -from 0.0 -to 100.0] -side left $tl.f.s1 set $normalize(v) pack [ttk::entry $tl.f.e -textvariable normalize(v) -width 5] -side left pack [ttk::label $tl.f.l -text xx -width 2] -side left ttk::checkbutton $tl.cb1 -text [::util::mc "Decibels"] \ -variable normalize(db) \ -command [list ConfNormalize 1] ttk::checkbutton $tl.cb2 \ -text [::util::mc "Normalize all channels equally"] \ -variable normalize(allEqual) grid $tl.l -sticky ew grid $tl.f -sticky ew grid $tl.cb1 -sticky ew grid $tl.cb2 -sticky ew grid columnconfigure $tl 0 -weight 1 ;# vad gör denna? insertOKCancelButtons2 $tl.f3 "DoNormalize $w;destroy $tl" "destroy $tl" if {[$s cget -channels] == 1} { $tl.cb2 configure -state disabled } else { $tl.cb2 configure -state normal } ConfNormalize 0 } proc Normalize {} { global normalize set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] } set tl .norm catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Normalize] pack [ttk::label $tl.l -text [::util::mc "Normalize to:"]] -fill x pack [ttk::frame $tl.f] -fill both -expand true pack [ttk::scale $tl.f.s1 -command "" -orient horizontal \ -variable normalize(v) -from 0.0 -to 100.0] -side left $tl.f.s1 set $normalize(v) pack [ttk::entry $tl.f.e -textvariable normalize(v) -width 5] -side left pack [ttk::label $tl.f.l -text xx -width 2] -side left pack [ttk::checkbutton $tl.cb1 -text [::util::mc "Decibels"] \ -variable normalize(db) \ -command [list ConfNormalize 1]] -fill both -expand true pack [ttk::checkbutton $tl.cb2 \ -text [::util::mc "Normalize all channels equally"] \ -variable normalize(allEqual)] -fill both -expand true insertOKCancelButtons $tl.f3 "DoNormalize $w;destroy $tl" "destroy $tl" if {[$s cget -channels] == 1} { $tl.cb2 configure -state disabled } else { $tl.cb2 configure -state normal } ConfNormalize 0 } proc ConfEcho {args} { global echo set iGain [expr {0.01 * $echo(iGain)}] set oGain [expr {0.01 * $echo(oGain)}] set values "$iGain $oGain " for {set i 1} {$i <= $echo(n)} {incr i} { if {![info exists echo(delay$i)]} { set echo(delay$i) 220.0 } if {![info exists echo(decay$i)]} { set echo(decay$i) 60 } set decay [expr {0.01 * $echo(decay$i)}] append values "$echo(delay$i) $decay " } eval $echo(f) configure $values } proc DoEcho {w} { global echo foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return ConfEcho cbs copy $s if [catch {$s filter $echo(f) -start $start -end $end \ -continuedrain $echo(drain) \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc PlayEcho {w} { global echo foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return ConfEcho $s stop $s play -filter $echo(f) -start $start -end $end } proc AddEcho {} { global echo if {$echo(n) > 9} return set tl .proc incr echo(n) AddEchoW $echo(n) if {$echo(n) > 1} { $tl.f.fe.2 configure -state normal } if {$echo(n) > 9} { $tl.f.fe.1 configure -state disabled } } proc AddEchoW {n} { global echo set tl .proc set f [expr {$n + 2}] ttk::separator $tl.f.f$f -orient vertical pack $tl.f.f$f -side left -before $tl.f.hidden if {![info exists echo(delay$n)]} { set echo(delay$n) 30.0 set echo(delayI$n) 30.0 } pack [ttk::label $tl.f.f$f.l -text [::util::mc "Echo $n"] -anchor c] -side top \ -fill x pack [ttk::frame $tl.f.f$f.f1] -side left pack [ttk::scale $tl.f.f$f.f1.s -from 10.0 -to 250.0 -orient vertical \ -variable echo(delayI$n) -command "FlipScaleValue ::echo(delayI$n) ::echo(delay$n) 260.0;ConfEcho"] $tl.f.f$f.f1.s set $echo(delay$n) pack [ttk::frame $tl.f.f$f.f1.f] pack [ttk::entry $tl.f.f$f.f1.f.e -textvariable echo(delay$n) -width 3] \ -side left pack [ttk::label $tl.f.f$f.f1.f.l -text ms] -side left if {![info exists echo(decay$n)]} { set echo(decay$n) 40 set echo(decayI$n) 40 } pack [ttk::frame $tl.f.f$f.f2] -side left pack [ttk::scale $tl.f.f$f.f2.s -from 0 -to 100 -orient vertical \ -variable echo(decayI$n) -command "FlipScaleValue ::echo(decayI$n) ::echo(decay$n) 100.0;ConfEcho"] $tl.f.f$f.f2.s set $echo(decay$n) pack [ttk::frame $tl.f.f$f.f2.f] pack [ttk::entry $tl.f.f$f.f2.f.e -textvariable echo(decay$n) -width 3] \ -side left pack [ttk::label $tl.f.f$f.f2.f.l -text %] -side left } proc RemEcho {} { global echo if {$echo(n) < 2} return set tl .proc set f [expr {$echo(n) + 2}] destroy $tl.f.f$f incr echo(n) -1 if {$echo(n) < 2} { $tl.f.fe.2 configure -state disabled } $tl.f.fe.1 configure -state normal } proc FlipScaleValue {scaleVar var max} { set $var [expr $max-[set $scaleVar]] } proc Echo {} { global echo set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] } set tl .proc catch {destroy $tl} toplevel $tl wm title $tl [::util::mc Echo] pack [ttk::frame $tl.f] -expand true -fill both pack [ttk::frame $tl.f.f1] -side left pack [ttk::label $tl.f.f1.l -text [::util::mc In]] pack [ttk::scale $tl.f.f1.s -from 0 -to 100 -orient vertical \ -variable echo(iGainI) -command "FlipScaleValue ::echo(iGainI) ::echo(iGain) 100.0;ConfEcho"] $tl.f.f1.s set $echo(iGain) pack [ttk::frame $tl.f.f1.f] pack [ttk::entry $tl.f.f1.f.e -textvariable echo(iGain) -width 3] -side left pack [ttk::label $tl.f.f1.f.l -text %] -side left pack [ttk::frame $tl.f.f2] -side left pack [ttk::label $tl.f.f2.l -text [::util::mc Out]] pack [ttk::scale $tl.f.f2.s -from 0 -to 100 -orient vertical \ -variable echo(oGainI) -command "FlipScaleValue ::echo(oGainI) ::echo(oGain) 100.0;ConfEcho"] $tl.f.f2.s set $echo(oGain) pack [ttk::frame $tl.f.f2.f] pack [ttk::entry $tl.f.f2.f.e -textvariable echo(oGain) -width 3] -side left pack [ttk::label $tl.f.f2.f.l -text %] -side left pack [ttk::frame $tl.f.fe] -side left pack [ttk::button $tl.f.fe.1 -text + -command AddEcho] -padx 3 pack [ttk::button $tl.f.fe.2 -text - -command RemEcho -state disabled] -padx 3 pack [ttk::frame $tl.f.hidden] -side left for {set i 1} {$i <= $echo(n)} {incr i} { AddEchoW $i } pack [ttk::checkbutton $tl.cb -text [::util::mc "Drain beyond selection"] \ -variable echo(drain)] -anchor w -fill x pack [ ttk::frame $tl.f3] -pady 0 -expand true -fill both pack [ ttk::button $tl.f3.b1 -style Toolbutton -image $::wsurf::Info(Img,play) -command "PlayEcho $w"] \ -side left -padx 3 pack [ ttk::button $tl.f3.b2 -style Toolbutton -image $::wsurf::Info(Img,stop) -command "$w stop"] -side left \ -padx 3 insertOKCancelButtons $tl.f4 "DoEcho $w;destroy $tl" "destroy $tl" } proc ConfMix {w args} { global mix set s [$w cget -sound] set n [$s cget -channels] for {set i 0} {$i < $n} {incr i} { for {set j 0} {$j < $n} {incr j} { set val [expr {0.01 * $mix($i,$j)}] append values "$val " } } eval $mix(f) configure $values } proc DoMix {w} { global mix foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return ConfMix $w cbs copy $s if [catch {$s filter $mix(f) -start $start -end $end \ -progress progressCallback}] { $s copy cbs return } ::wsurf::PrepareUndo "$s swap cbs" "$s swap cbs" } proc PlayMix {w} { global mix foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} return ConfMix $w $s stop $s play -filter $mix(f) -start $start -end $end } proc MixChan {} { global mix set w [::wsurf::GetCurrent] BreakIfInvalid $w if {[$w getInfo isLinked2File]} return foreach {left right} [$w cget -selection] break set s [$w cget -sound] set start [expr {int($left*[$s cget -rate])}] set end [expr {int($right*[$s cget -rate])}] if {$start == $end} { $w configure -selection [list 0.0 [$s length -unit seconds]] } set tl .mix catch {destroy $tl} toplevel $tl wm title $tl [::util::mc "Mix Channels"] pack [ttk::frame $tl.f] -expand true -fill both ttk::label $tl.f.l -text [::util::mc "New channel"] grid $tl.f.l set n [$s cget -channels] for {set i 0} {$i < $n} {incr i} { for {set j 0} {$j < $n} {incr j} { if {![info exists mix($i,$j)]} { if {$i == $j} { set mix($i,$j) 100 } else { set mix($i,$j) 0 } } } } for {set i 0} {$i < $n} {incr i} { if {$i == 0} { set label Left } elseif {$i == 1} { set label Right } else { set label [expr {$i + 1}] } ttk::label $tl.f.ly$i -text $label grid $tl.f.ly$i -row [expr {$i + 1}] -column 0 ttk::label $tl.f.lx$i -text [::util::mc "Channel $label"] grid $tl.f.lx$i -row 0 -column [expr {$i + 1}] for {set j 0} {$j < $n} {incr j} { ttk::frame $tl.f.f$i-f$j grid $tl.f.f$i-f$j -row [expr {$i + 1}] -column [expr {$j + 1}] -padx 5 pack [ttk::scale $tl.f.f$i-f$j.s -orient horizontal \ -from -100 -to 100 -command "ConfMix $w" \ -variable mix($i,$j)] $tl.f.f$i-f$j.s set $mix($i,$j) pack [ttk::frame $tl.f.f$i-f$j.f] pack [ttk::entry $tl.f.f$i-f$j.f.e -textvariable mix($i,$j) -width 4] \ -side left pack [ttk::label $tl.f.f$i-f$j.f.l -text %] -side left } } pack [ttk::frame $tl.f3] -expand true -fill both pack [ ttk::button $tl.f3.b1 -style Toolbutton -image $::wsurf::Info(Img,play) -command "PlayMix $w"] \ -side left -padx 3 -anchor c pack [ ttk::button $tl.f3.b2 -style Toolbutton -image $::wsurf::Info(Img,stop) -command "$w stop"] \ -side left -padx 3 -anchor c insertOKCancelButtons $tl.f4 "DoMix $w;destroy $tl" "destroy $tl" } # ----------------------------------------------------------------------------- # PreferencesDialog proc PreferencesDialog {} { destroy .prefs toplevel .prefs wm title .prefs [::util::mc Preferences] wm resizable .prefs 0 0 pack [ttk::frame .prefs.f] -side bottom -expand 0 -fill x -ipadx 10 -ipady 10 pack [ttk::button .prefs.f.b1 -text [::util::mc OK] -width 8 -default active \ -command "destroy .prefs;SavePreferences"] -side $::ocdir -padx 3 -expand true pack [ttk::button .prefs.f.b2 -text [::util::mc Cancel] -width 8 \ -command "destroy .prefs"] -side $::ocdir -padx 3 -expand true pack [ttk::button .prefs.f.b3 -text [::util::mc Defaults] \ -command SetDefaultPrefs] -side left -padx 3 -expand true pack [ttk::button .prefs.f.b4 -text [::util::mc Apply] -width 8 \ -command ApplyPreferences] -side left -padx 3 -expand true set notebook .prefs.nb set pages {} lappend pages [::util::mc "Keys"] lappend procs KeyBindingsPage foreach {title pageProc} [::wsurf::PreferencePages] { if {$title != ""} { lappend pages $title lappend procs $pageProc } } ttk::notebook $notebook -padding 6 pack $notebook -fill both -expand yes if {[string match macintosh $::tcl_platform(platform)] || \ [string match Darwin $::tcl_platform(os)]} { update } foreach page $pages proc $procs { set lowpage [string tolower $page] $notebook add [ttk::frame $notebook.$lowpage] -text $page eval $proc [list $notebook.$lowpage] } $notebook select 2 } set Prefs(Table) [list \ PlaySelection PlaySelection "Play whole selection" \ PlayCursor [list PlayAtCursor %x] "Play at cursor" \ PlayAll PlayAll "Play whole sound" \ PlayVisible PlayVisible "Play visible sound" \ PlayLoop PlayLoop "Play loop" \ LockMessageBar [list lockMessageBar %W] "Toggle message bar lock" \ PlayPause PlayPause "Toggle play/pause" \ PlayStop PlayStop "Toggle play/stop" \ "x0" "" "File menu" \ Revert Revert "Revert" \ Chooser Chooser "Chooser..." \ SaveSelection SaveSelection "Save Selection..." \ ShowConsole ShowConsole "Show Console..." \ Print Print "Print..." \ Prefs PreferencesDialog "Preferences..." \ "x1" "" "Edit menu" \ MixPaste MixPaste "Mix Paste..." \ SelectAll SelectAll "Select All" \ SelectoNew SelectoNew "Selection to New" \ ZeroXAdjust ZeroXAdjust "Zero Cross Adjust" \ "x2" "" "Transform menu" \ Convert Convert "Convert..." \ Amplify Amplify "Amplify..." \ Fade Fade "Fade..." \ Normalize Normalize "Normalize..." \ Echo Echo "Echo..." \ MixChan MixChan "Mix Channels..." \ Invert Invert "Invert" \ Reverse Reverse "Reverse" \ Silence Silence "Silence" \ RemoveDC RemoveDC "RemoveDC" \ "x3" "" "View menu" \ ZoomIn ZoomIn "Zoom In" \ ZoomOut ZoomOut "Zoom Out" \ ZoomFullOut ZoomAll "Zoom Out Full" \ ZoomToSelection ZoomSel "Zoom to Selection" \ ] # ----------------------------------------------------------------------------- # SavePreferences proc SavePreferences {} { variable Info ApplyPreferences set pf $Info(PrefsFile) set f [open $pf w] set confspec [string trim [eval ::wsurf::GetPreferences]] foreach line [split $confspec \n] { puts $f $line } foreach {prefKey script text} $::Prefs(Table) { puts $f "set ::Info(Prefs,$prefKey) \{$Info(Prefs,$prefKey)\}" } close $f } proc ApplyPreferences {} { variable Info foreach {prefKey script text} $::Prefs(Table) { if {[info exists Info(Prefs,t,$prefKey)]} { set Info(Prefs,$prefKey) $Info(Prefs,t,$prefKey) } } foreach tl $::Info(toplevels) { BindKeys $tl } ::wsurf::ApplyPreferences } proc SetDefaultPrefs {} { ::wsurf::SetDefaultPrefs } proc KeyBindingsPage {p} { variable Info foreach {prefKey script text} $::Prefs(Table) { set Info(Prefs,t,$prefKey) $Info(Prefs,$prefKey) } set t $p.canv canvas $t -yscrollcommand [list $p.scroll set] -highlightthickness 0 -borderwidth 0 -height 500 # text $t -yscrollcommand "$p.scroll set" -setgrid true -width 50 \ # -height 10 -wrap word -highlightthickness 0 -borderwidth 0 \ # -tabs {5c left} set f $t.frame $t create window 0 0 -anchor nw -window [ttk::frame $f] -tags frame bind $t [list $t itemconfigure frame -width %w] bind $f [list $t configure -scrollregion "0 0 %w %h"] ttk::scrollbar $p.scroll -orient vertical -command [list $t yview] # scrollbar $p.scroll -orient vertical -command [list $t yview] grid $t $p.scroll -sticky news grid columnconfigure $p 0 -weight 1 set subi 0 set subframe $f.l[incr subi] pack [ttk::labelframe $subframe] -fill x -expand 1 -side top foreach {prefKey script text} $::Prefs(Table) { if {$script == ""} { set subframe $f.l[incr subi] pack [ttk::labelframe $subframe -text [::util::mc ${text}]] -fill x -side top -expand 1 } else { ttk::label $subframe.l$prefKey -width 15 -text [::util::mc ${text}] ttk::entry $subframe.e$prefKey -width 15 -textvar Info(Prefs,t,$prefKey) grid $subframe.l$prefKey $subframe.e$prefKey -sticky we grid columnconfigure $subframe 0 -weight 1 grid columnconfigure $subframe 1 -weight 0 } } $t configure -state disabled } # GetCTTRegVars # - check if CTT-Toolbox is installed. # If it is, modify auto_path to include Toolbox directories proc GetCTTRegVars {} { switch $::tcl_platform(platform) { windows { package require registry set key [join [list HKEY_LOCAL_MACHINE SOFTWARE CTT] \\] catch { set cttroot [registry get $key Root] } } unix { if {[info exists ::env(CTTROOT)]} { set cttroot $::env(CTTROOT) } } } if {![info exists cttroot]} return lappend ::auto_path [file join $cttroot pkg] } proc GetWSRegVars {} { if [string match windows $::tcl_platform(platform)] { package require registry set key [join [list HKEY_LOCAL_MACHINE SOFTWARE CTT WAVESURFER $::version] \\] catch { foreach d [split [registry get $key CONFIGDIR] ;] { lappend ::surf(configpath) $d } } catch { foreach d [split [registry get $key PLUGINDIR] ;] { lappend ::surf(pluginpath) $d } } } } # ----------------------------------------------------------------------------- proc CheckRegTypes {} { package require registry foreach ext $::surf(extensions) { # puts ext=$ext if {[catch { set class [registry get [join [list HKEY_CLASSES_ROOT $ext] \\] ""] }]} { set x($ext,assoc) 0 } else { # puts class=$class set shellops [registry keys [join [list HKEY_CLASSES_ROOT $class shell] \\]] if {[lsearch -glob $shellops *WaveSurfer*]==-1} { set x($ext) 0 } else { set x($ext) 1 } } } return [array get x] } proc RegTypes {list} { package require registry array set conf $list #parray conf foreach key [array names conf *,assoc] { set ext [lindex [split $key ,] 0] if {[catch { set class [registry get [join [list HKEY_CLASSES_ROOT $ext] \\] ""] }]} { set class [string trimleft $ext .]file registry set [join [list HKEY_CLASSES_ROOT $ext] \\] "" $class registry set [join [list HKEY_CLASSES_ROOT $class] \\] "" "[string toupper [string trimleft $ext .]] sound format" } set base HKEY_CLASSES_ROOT\\$class\\shell if {$conf($ext,default)} { registry set $base "" ws.play } registry set $base\\ws.play "" "&Play using WaveSurfer" registry set $base\\ws.open "" "&Open using WaveSurfer" registry set $base\\ws.play\\command "" "$::surf(appname) -play" registry set $base\\ws.open\\command "" "$::surf(appname)" if {$conf($ext,dde)} { registry set $base\\ws.play\\ddeexec "" "PlayFile {%1}" registry set $base\\ws.open\\ddeexec "" "OpenFile {%1}" registry set $base\\ws.play\\ddeexec\\Application "" TclEval registry set $base\\ws.open\\ddeexec\\Application "" TclEval registry set $base\\ws.play\\ddeexec\\Topic "" WaveSurfer registry set $base\\ws.open\\ddeexec\\Topic "" WaveSurfer } } } proc RegTypesDialog {} { set w [toplevel .x.regTypes] wm title $w [::util::mc "Associate File Types"] set i 0 ttk::label $w.l$i -anchor w -justify left -text [::util::mc "Check \"Associate\" to add WaveSurfer as a handler for a file type\nCheck \"Make default\" to make WaveSurfer the default handler for a file type\nCheck \"Use DDE\" to use a single instance of WaveSurfer for multiple files"] grid $w.l$i -row $i -sticky nswe -columnspan 4 -ipady 5 incr i ttk::label $w.a$i -text [::util::mc "File type"] ttk::label $w.b$i -text [::util::mc "Associate"] ttk::label $w.c$i -text [::util::mc "Make default"] ttk::label $w.d$i -text [::util::mc "Use DDE"] grid $w.a$i $w.b$i $w.c$i $w.d$i -row $i -sticky we incr i foreach ext $::surf(extensions) { set ::_RegTypesDialog($ext,assoc) 1 set ::_RegTypesDialog($ext,default) 0 set ::_RegTypesDialog($ext,dde) 1 ttk::label $w.l$i -text $ext ttk::checkbutton $w.a$i -variable _RegTypesDialog($ext,assoc) -command [list \ if \$_RegTypesDialog($ext,assoc) [list $w.b$i configure -state normal]\n[list $w.c$i configure -state normal] else [list $w.b$i configure -state disabled]\n[list $w.c$i configure -state disabled]] ttk::checkbutton $w.b$i -variable _RegTypesDialog($ext,default) ttk::checkbutton $w.c$i -variable _RegTypesDialog($ext,dde) grid $w.l$i $w.a$i $w.b$i $w.c$i -row $i -sticky nswe incr i } # insertOKCancelButtons $w.bf [list set _RegTypesDialog(selection) ok] \ [list set _RegTypesDialog(selection) cancel] ttk::button $w.ok -text [::util::mc "OK"] -command [list set _RegTypesDialog(selection) ok] ttk::button $w.cancel -text [::util::mc "Cancel"] -command [list set _RegTypesDialog(selection) cancel] grid $w.ok $w.cancel -columnspan 2 -row $i -sticky nswe -ipadx 20 -ipady 5 vwait ::_RegTypesDialog(selection) destroy $w if {[string match ok $::_RegTypesDialog(selection)]} { RegTypes [array get ::_RegTypesDialog] tk_messageBox -message [::util::mc "The specified file associations have been created"] } } proc About {} { tk_messageBox -title "About WaveSurfer" -message "WaveSurfer 1.8.8p5-1701261420 Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander\n" } if {![string match macintosh $::tcl_platform(platform)]} { rename source _source proc source {args} { incr ::splash::filecount set ::splash::progress "$::splash::filecount" update idletasks uplevel _source $args } } if {[string match macintosh $::tcl_platform(platform)]} { console hide option add *background lightgrey option add *Entry.background white } package require -exact wsurf $version if {$tcl_version<8.2} { set Info(Version) 1.1 } else { set Info(Version) [package present wsurf] } set surf(count) 0 set surf(interrupted) 1 set surf(locked) 0 set surf(tmpfiles) "" if {![file readable $env(HOME)]} { if {![file readable [file join [util::tmpdir] .wavesurfer]]} { lower .splash tk_messageBox -message "Unable to use home directory [file join $env(HOME) .wavesurfer].\nWill use [file join [util::tmpdir] .wavesurfer] instead" raise .splash } set env(HOME) [util::tmpdir] } # Use lappend instead of set here since env(HOME) might contain spaces lappend userplugindir [file join $env(HOME) .wavesurfer $version plugins] lappend userconfigdir [file join $env(HOME) .wavesurfer $version configurations] set surf(pluginpath) $userplugindir set surf(configpath) $userconfigdir set oldHomes [list [file join $env(HOME) .wavesurfer 1.0] \ [file join $env(HOME) .wavesurfer 1.1] \ [file join $env(HOME) .wavesurfer 1.2] \ [file join $env(HOME) .wavesurfer 1.3] \ [file join $env(HOME) .wavesurfer 1.4] \ [file join $env(HOME) .wavesurfer 1.5] \ [file join $env(HOME) .wavesurfer 1.6] \ [file join $env(HOME) .wavesurfer 1.7]] set newHome [file join $env(HOME) .wavesurfer $version] set lastVersion [file join $env(HOME) .wavesurfer 1.0] set newVersion 0 foreach home $oldHomes { if {[file exists $home] && ![file exists [lindex $surf(configpath) 0]]} { set lastVersion $home set newVersion 1 } } GetCTTRegVars GetWSRegVars if {![file exists [lindex $userplugindir 0]]} { file mkdir [lindex $userplugindir 0] } if {![file exists [lindex $userconfigdir 0]]} { file mkdir [lindex $userconfigdir 0] } if {[info exists ::wrap]} { set surf(appname) "\"[file nativename [info nameofexecutable]]\"" } else { set surf(appname) "\"[file nativename [info nameofexecutable]]\" \"[info script]\"" } set Info(Prefs,wsWidth) 600 set Info(Prefs,wsLeft) 20 set Info(Prefs,wsTop) 20 set Info(geometryFile) [file join $::env(HOME) .wavesurfer $Info(Version) \ geometry] if {[file readable $Info(geometryFile)]} { source $Info(geometryFile) } wm withdraw . toplevel .x #wm iconbitmap .x snackPlay set Info(toplevels) .x wm withdraw .x wm title .x "WaveSurfer 1.8.8p5" wm minsize .x 200 1 if {$::tcl_platform(os) == "Darwin"} { bind .x [list wm resizable .x 1 0] } else { wm resizable .x 1 0 } wm protocol .x WM_DELETE_WINDOW [list KillWindow .x] wm geometry .x +$Info(Prefs,wsLeft)+$Info(Prefs,wsTop) if {$::tcl_platform(os) == "Darwin"} { set AccKey Command set AccKeyM Command } elseif {$::tcl_platform(platform) == "unix"} { set AccKey Alt set AccKeyM Alt } else { set AccKey Control set AccKeyM Ctrl } proc Binding2Text binding { if {[string match *-? $binding] == 0} { return $binding } foreach {key1 key2} [split $binding -] break return "$key1+[string toupper $key2]" } proc CreateMenus {p} { set m [menu $p.menu] set m2 [menu $p.dummy] $m add cascade -label [::util::mc "File"] -menu $m.file -underline 0 $m2 add cascade -label [::util::mc "File"] menu $m.file -tearoff 0 -postcommand [list ConfigureFileMenu $m] $m.file add command -label [::util::mc "New"] -command [list New] \ -accelerator $::AccKeyM+N $m.file add command -label [::util::mc "Open..."] \ -command [list Open] -accelerator $::AccKeyM+O $m.file add command -label [::util::mc "Revert"] \ -command [list Revert] $m.file add command -label [::util::mc "Chooser..."] \ -command [list Chooser] $m.file add separator $m.file add command -label [::util::mc "Save"] \ -command [list Save] -accelerator $::AccKeyM+S $m.file add command -label [::util::mc "Save As..."] \ -command [list SaveAs] $m.file add command -label [::util::mc "Save Selection..."] \ -command [list SaveSelection] $m.file add separator set ::fileMenuIndex 13 # if 1 { # set tkconfile [file join [file dirname [info script]] tkcon.tcl] # if {[info command console]!="" || [file exists $tkconfile]} { $m.file add command -label [::util::mc "Show Console..."] \ -command ShowConsole $m.file add separator incr ::fileMenuIndex 2 # } # } $m.file add command -label [::util::mc "Print..."] -command Print $m.file add separator $m.file add command -label [::util::mc "Preferences..."] \ -command PreferencesDialog if {$::tcl_platform(platform) == "unix"} { $m.file add command -label [::util::mc "Mixer..."] \ -command snack::mixerDialog incr ::fileMenuIndex } if {$::tcl_platform(platform) == "windows"} { $m.file add command -label [::util::mc "Associate File Types..."] \ -command RegTypesDialog incr ::fileMenuIndex } set recentfilesfile [file join $::env(HOME) .wavesurfer $::Info(Version) \ recent-files] if {[file readable $recentfilesfile]} {source $recentfilesfile} if {[info exists ::recentFiles]} { $m.file add separator foreach e $::recentFiles { set l $e if {[string length $e] > 30} { set l ...[string range $e [expr {[string length $e]-30}] end] } $m.file add command -label $l -command [list OpenFile $e] } } $m.file add separator $m.file add command -label [::util::mc Close] -command [list Close $p] \ -accelerator $::AccKeyM+W if {$::tcl_platform(os) != "Darwin"} { $m.file add command -label [::util::mc Exit] -command Exit } $m add cascade -label [::util::mc Edit] -menu $m.edit -underline 0 $m2 add cascade -label [::util::mc Edit] menu $m.edit -tearoff 0 -postcommand [list ConfigureEditMenu $m] $m.edit add command -label [::util::mc Undo] -command Undo $m.edit add separator $m.edit add command -label [::util::mc Cut] -command Cut \ -accelerator $::AccKeyM+X $m.edit add command -label [::util::mc Copy] -command Copy \ -accelerator $::AccKeyM+C $m.edit add command -label [::util::mc Paste] -command Paste \ -accelerator $::AccKeyM+V $m.edit add command -label [::util::mc "Mix Paste..."] -command MixPaste $m.edit add separator $m.edit add command -label [::util::mc "Select All"] -command SelectAll $m.edit add command -label [::util::mc "Selection to New"] \ -command SelectoNew $m.edit add command -label [::util::mc "Zero Cross Adjust"] \ -command ZeroXAdjust $m add cascade -label [::util::mc Transform] -menu $m.trans -underline 0 $m2 add cascade -label [::util::mc Transform] menu $m.trans -tearoff 0 -postcommand [list ConfigureTransformMenu $m] $m.trans add command -label [::util::mc Convert...] -command Convert $m.trans add command -label [::util::mc Amplify...] -command Amplify $m.trans add command -label [::util::mc Fade...] -command Fade \ -accelerator $::AccKeyM+D $m.trans add command -label [::util::mc Normalize...] -command Normalize $m.trans add command -label [::util::mc Echo...] -command Echo $m.trans add command -label [::util::mc "Mix Channels..."] -command MixChan $m.trans add command -label [::util::mc Invert] -command Invert $m.trans add command -label [::util::mc Reverse] -command Reverse $m.trans add command -label [::util::mc Silence] -command Silence $m.trans add command -label [::util::mc "Remove DC"] -command RemoveDC menu $m.view -tearoff 0 -postcommand [list ConfigureViewMenu $m] set slaves [menu $m.view.slaves -tearoff 0] $m.view add cascade -label [::util::mc "Master Sound"] \ -command proctrace::showTraceGUI -menu $slaves $m add cascade -label [::util::mc View] -menu $m.view $m2 add cascade -label [::util::mc View] -menu $m.view $m.view add command -label [::util::mc "Zoom In"] -command ZoomIn $m.view add command -label [::util::mc "Zoom Out"] -command ZoomOut $m.view add command -label [::util::mc "Zoom Out Full"] -command ZoomAll $m.view add command -label [::util::mc "Zoom to Selection"] -command ZoomSel $m.view add separator $m.view add command -label [::util::mc "10 mm/s"] -command [list Zoom 10] $m.view add command -label [::util::mc "50 mm/s"] -command [list Zoom 50] $m.view add command -label [::util::mc "100 mm/s"] -command [list Zoom 100] $m.view add command -label [::util::mc "250 mm/s"] -command [list Zoom 250] if {[info commands proctrace::showTraceGUI]!=""} { menu $m.debug -tearoff 0 $m.debug add command -label [::util::mc "Trace Procedure Calls"] \ -command proctrace::showTraceGUI $m add cascade -label [::util::mc Debug] -menu $m.debug set level [menu $m.debug.level -tearoff 0] $m.debug add cascade -label [::util::mc "Snack Trace Level"] \ -command proctrace::showTraceGUI -menu $level $m.debug.level add radiobutton -label [::util::mc "None"] -value 0 \ -variable ::wsurf::Info(debug) -command proctrace::configureSnackDebug foreach level {1 2 3 4 5} { $m.debug.level add radiobutton -label [::util::mc "Level $level"] \ -value $level \ -variable ::wsurf::Info(debug) -command proctrace::configureSnackDebug } # wsurf::_callback nowidget addMenuEntriesProc nopane $m help 0 0 # proctrace::showTraceGUI } # search for a local version of the manual. This can be in different places # depending on whether we're running wrapped, source or development version. # Use web-url as fallback. set manurl http://www.speech.kth.se/wavesurfer/man$::version_major$::version_minor.html foreach manpath [list \ [info nameofexecutable]/doc \ $::surf(wavesurferdir)/doc \ $::surf(wavesurferdir)/../web] { set f $manpath/man$::version_major$::version_minor.html if [file exists $f] { set manurl file:$f break } } #<< "manurl:$manurl" menu $m.help -tearoff 0 $m add cascade -label [::util::mc Help] -menu $m.help -underline 0 $m2 add cascade -label [::util::mc Help] # $m.help add command -label [::util::mc "About WaveSurfer"] \ \# -command [list util::showURL http://www.speech.kth.se/wavesurfer/index.html] if {[tk windowingsystem] eq "aqua"} { proc ::tk::mac::ShowHelp {} { set manurl http://www.speech.kth.se/wavesurfer/man$::version_major$::version_minor.html eval util::showURL $manurl } proc tkAboutDialog {} { About } proc ::tk::mac::ShowPreferences {} { PreferencesDialog } } if {[tk windowingsystem] ne "aqua"} { $m.help add command -label [::util::mc "Manual"] \ -command [list util::showURL $manurl] } $m.help add command -label [::util::mc "FAQ"] \ -command [list util::showURL http://www.speech.kth.se/wavesurfer/faq.html] $m.help add command -label [::util::mc "Forum"] \ -command [list util::showURL http://www1.speech.kth.se/prod/wavesurferforum/phpBB2/index.php] $m.help add separator $m.help add command -label [::util::mc "About Plug-ins"] \ -command ::wsurf::pluginsDialog $m.help add command -label [::util::mc "About WaveSurfer"] \ -command [list About] $p config -menu $m } snack::sound cbs snack::sound cbs2 set Info(filter) [snack::filter map 0.0] set remdc(f) [snack::filter iir -numerator "0.99 -0.99" -denominator "1 -0.99"] set echo(f) [snack::filter echo 0.6 0.6 30 0.4] set echo(n) 1 set echo(drain) 1 set echo(iGain) 50 set echo(oGain) 50 set mix(f) [snack::filter map 0.0] set amplify(f) [snack::filter map 1.0] set amplify(v) 100.0 set amplify(db) 0 set silence(l) 3.0 set fade(f) [snack::filter fade in linear 100] set fade(dir) In set fade(type) Linear set fade(floor) 0.0 set normalize(f) [snack::filter map 1.0] set normalize(v) 100.0 set normalize(db) 0 set normalize(allEqual) 1 set mixpaste(prescale) 100.0 set mixpaste(mixscale) 100.0 set Info(MasterWidget) none proc ConfigureFileMenu {m} { set w [::wsurf::GetCurrent] if {$w != "" && [$w needSave]} { $m.file entryconfigure [::util::mc Save] -state normal } else { $m.file entryconfigure [::util::mc Save] -state disabled } if {$w != "" && [$w getInfo hasPanes] && [string compare macintosh $::tcl_platform(platform)]} { $m.file entryconfigure [::util::mc Print...] -state normal } else { $m.file entryconfigure [::util::mc Print...] -state disabled } if {$w == ""} { $m.file entryconfigure [::util::mc "Save As..."] -state disabled $m.file entryconfigure [::util::mc Close] -state disabled } else { $m.file entryconfigure [::util::mc "Save As..."] -state normal $m.file entryconfigure [::util::mc Close] -state normal } if {$w != ""} { foreach {left right} [$w cget -selection] break } if {$w != "" && $left != $right} { $m.file entryconfigure [::util::mc "Save Selection..."] -state normal } else { $m.file entryconfigure [::util::mc "Save Selection..."] -state disabled } $m.file entryconfigure [::util::mc "Revert"] \ -accelerator [Binding2Text $::Info(Prefs,Revert)] $m.file entryconfigure [::util::mc "Chooser..."] \ -accelerator [Binding2Text $::Info(Prefs,Chooser)] $m.file entryconfigure [::util::mc "Save Selection..."] \ -accelerator [Binding2Text $::Info(Prefs,SaveSelection)] $m.file entryconfigure [::util::mc "Show Console..."] \ -accelerator [Binding2Text $::Info(Prefs,ShowConsole)] $m.file entryconfigure [::util::mc "Print..."] \ -accelerator [Binding2Text $::Info(Prefs,Print)] $m.file entryconfigure [::util::mc "Preferences..."] \ -accelerator [Binding2Text $::Info(Prefs,Prefs)] } proc ConfigureEditMenu {m} { set w [::wsurf::GetCurrent] set state "disabled" if {$w != "" && [$w getInfo isLinked2File] == 0} { set state "normal" } $m.edit entryconfigure [::util::mc Undo] -state $state $m.edit entryconfigure [::util::mc Cut] -state $state $m.edit entryconfigure [::util::mc Copy] -state $state $m.edit entryconfigure [::util::mc Paste] -state $state $m.edit entryconfigure [::util::mc "Mix Paste..."] -state $state \ -accelerator [Binding2Text $::Info(Prefs,MixPaste)] if {$w == ""} { set state "disabled" } else { set state "normal" } $m.edit entryconfigure [::util::mc "Select All"] -state $state \ -accelerator [Binding2Text $::Info(Prefs,SelectAll)] $m.edit entryconfigure [::util::mc "Selection to New"] -state $state \ -accelerator [Binding2Text $::Info(Prefs,SelectoNew)] $m.edit entryconfigure [::util::mc "Zero Cross Adjust"] -state $state \ -accelerator [Binding2Text $::Info(Prefs,ZeroXAdjust)] } proc ConfigureTransformMenu {m} { set w [::wsurf::GetCurrent] set state "disabled" set mixState "disabled" set SilenceLabel [::util::mc Silence...] set SilenceEntry [::util::mc Silence]* if {$w != ""} { if {[$w getInfo isLinked2File] == 0} { set state "normal" } # Special handling for Silence item since its name depends on selection state foreach {left right} [$w cget -selection] break if {$left == $right} { set SilenceLabel [::util::mc Silence...] } else { set SilenceLabel [::util::mc Silence] } set SilenceEntry [::util::mc Silence]* # Disable "Mix Channels" for mono files set s [$w cget -sound] set mixState $state if {[$s cget -channels] == 1} { set mixState "disabled" } } $m.trans entryconfigure [::util::mc Convert...] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Convert)] $m.trans entryconfigure [::util::mc Amplify...] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Amplify)] $m.trans entryconfigure [::util::mc Fade...] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Fade)] $m.trans entryconfigure [::util::mc Normalize...] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Normalize)] $m.trans entryconfigure [::util::mc Echo...] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Echo)] $m.trans entryconfigure [::util::mc "Mix Channels..."] -state $mixState \ -accelerator [Binding2Text $::Info(Prefs,MixChan)] $m.trans entryconfigure [::util::mc Invert] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Invert)] $m.trans entryconfigure [::util::mc Reverse] -state $state \ -accelerator [Binding2Text $::Info(Prefs,Reverse)] $m.trans entryconfigure $SilenceEntry -state $state \ -accelerator [Binding2Text $::Info(Prefs,Silence)] -label $SilenceLabel $m.trans entryconfigure [::util::mc Silence]* -state $state \ -accelerator [Binding2Text $::Info(Prefs,Silence)] $m.trans entryconfigure [::util::mc "Remove DC"] -state $state \ -accelerator [Binding2Text $::Info(Prefs,RemoveDC)] } proc ConfigureViewMenu {m} { set w [::wsurf::GetCurrent] $m.view.slaves delete 0 end if {[llength $::wsurf::Info(widgets)] > 1} { set state normal } else { set state disabled } $m.view.slaves add radiobutton -state $state -label [::util::mc None] \ -variable ::Info(MasterWidget) -command SetMasterWidget -value none $m.view.slaves add radiobutton -state $state -label [::util::mc Any] \ -variable ::Info(MasterWidget) -command SetMasterWidget -value any foreach widget $::wsurf::Info(widgets) { set label [$widget cget -title] $m.view.slaves add radiobutton -state $state -label $label \ -variable ::Info(MasterWidget) -command SetMasterWidget -value $widget } $m.view entryconfigure [::util::mc "Zoom In"] \ -accelerator [Binding2Text $::Info(Prefs,ZoomIn)] $m.view entryconfigure [::util::mc "Zoom Out"] \ -accelerator [Binding2Text $::Info(Prefs,ZoomOut)] $m.view entryconfigure [::util::mc "Zoom Out Full"] \ -accelerator [Binding2Text $::Info(Prefs,ZoomFullOut)] $m.view entryconfigure [::util::mc "Zoom to Selection"] \ -accelerator [Binding2Text $::Info(Prefs,ZoomToSelection)] } proc SetMasterWidget {} { set widgets $::wsurf::Info(widgets) foreach widget $widgets { if {[string match any $::Info(MasterWidget)] || \ [string match $widget $::Info(MasterWidget)] || \ [string match [$widget getInfo fileName] $::Info(MasterWidget)]} { set n [lsearch $widgets $widget] $widget configure -slaves [lreplace $widgets $n $n] if {[string match any $::Info(MasterWidget)] == 0} { set ::Info(MasterWidget) $widget } } else { $widget configure -slaves "" } } } # In tclkits it seems that TCLLIBPATH is not automatically included # in the auto_path. If so, let's do that ourselves: if [info exists env(TCLLIBPATH)] { foreach dir $env(TCLLIBPATH) { if {[lsearch $auto_path $dir] == -1} { lappend auto_path $dir } } } # Create toolbar icons set Info(Img,new) [image create photo -data R0lGODlhEAAQALMAAAAAAMbGxv///////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAAAAQwMMhJ6wQ4YyuB+OBmeeDnAWNpZhWpmu0bxrKAUu57X7VNy7tOLxjIqYiapIjDbDYjADs=] set Info(Img,open) [image create photo -data R0lGODlhEAAQALMAAAAAAISEAMbGxv//AP///////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAAAAQ4UMhJq6Ug3wpm7xsHZqBFCsBADGTLrbCqllIaxzSKt3wmA4GgUPhZAYfDEQuZ9ByZAVqPF6paLxEAOw==] set Info(Img,save) [image create photo -data R0lGODlhEAAQALMAAAAAAISEAMbGxv///////////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAAAAQ3UMhJqwQ4a30DsJfwiR4oYt1oASWpVuwYm7NLt6y3YQHe/8CfrLfL+HQcGwmZSXWYKOWpmDSBIgA7] set Info(Img,print) [image create photo -data R0lGODlhEAAQALMAAAAAAISEhMbGxv//AP///////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAAAAQ5UMhJqwU450u67wCnAURYkZ9nUuRYbhKalkJoj1pdYxar40ATrxIoxn6WgTLGC4500J6N5Vz1roIIADs=] set Info(Img,cut) [image create photo -data R0lGODlhEAAQALMAAAAAAAAAhMbGxv///////////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAAAAQvUMhJqwUTW6pF314GZhjwgeXImSrXTgEQvMIc3ONtS7PV77XNL0isDGs9YZKmigAAOw==] set Info(Img,copy) [image create photo -data R0lGODlhEAAQALMAAAAAAAAAhMbGxv///////////////////////////////////////////////////yH5BAEAAAIALAAAAAAQABAAAAQ+UMhJqwA4WwqGH9gmdV8HiKYZrCz3ecG7TikWf3EwvkOM9a0a4MbTkXCgTMeoHPJgG5+yF31SLazsTMTtViIAOw==] set Info(Img,paste) [image create photo -data R0lGODlhEAAQALMAAAAAAAAAhISEAISEhMbGxv//AP///////////////////////////////////////yH5BAEAAAQALAAAAAAQABAAAARMkMhJqwUYWJlxKZ3GCYMAgCdQDqLKXmUrGGE2vIRK7usu94GgMNDqDQKGZDI4AiqXhkDOiMxEhQCeAPlUEqm0UDTX4XbHlaFaumlHAAA7] set Info(Img,undo) [image create photo -data R0lGODlhEAAQALMAAAAAhMbGxv///////////////////////////////////////////////////////yH5BAEAAAEALAAAAAAQABAAAAQgMMhJq704622BB93kUSAJlhUafJj6qaLJklxc33iuXxEAOw==] set Info(Img,zoomall) [image create photo -data R0lGODlhFAATAMIAAAAAAF9fXwAA/8zM/8zMzP///////////yH5BAEAAAcALAAAAAAUABMAAAM9eLrc/tCB2OayVOGz6Z5dxTFAaZ7oN0YgmV3uu2pQUAY07ARFb8/AS6/XygCGhVANqazdSrJGQICL6qyOBAA7] set Info(Img,zoomsel) [image create photo -data R0lGODlhFAATAMIAAAAAAF9fXwAA/8zM/8zMzP///////////yH5BAEAAAcALAAAAAAUABMAAAM7eLrc/jAqwKhcdl5cN83H9wBkWZXkGHYgBLbRu2lKQAZeXez2ZQG7HcwVLAxHxePDBmDOGgEB7smhPhIAOw==] snack::createIcons proc CreateToolbar {p} { set opt "-style" set val "Toolbutton" pack [ ttk::frame $p.tb -relief raised -borderwidth 1] -side top -fill x eval pack [ ttk::button $p.tb.new -image $::Info(Img,new) -command New \ $opt $val] -side left eval pack [ ttk::button $p.tb.open -image $::Info(Img,open) -command Open \ $opt $val] -side left eval pack [ ttk::button $p.tb.save -image $::Info(Img,save) -command Save \ $opt $val] -side left pack [ ttk::frame $p.tb.sep1 -borderwidth 1 -relief sunken -width 2] \ -side left -fill y -padx 4 -anchor w -pady 2 eval pack [ ttk::button $p.tb.print -image $::Info(Img,print) -command Print \ $opt $val] -side left eval pack [ ttk::button $p.tb.mixer -image snackGain -command snack::mixerDialog \ $opt $val] -side left #pack [ttk::button $p.tb.prefs -image $::Info(Img,preferences) -command PreferencesDialog -relief flat] -side left pack [ ttk::frame $p.tb.sep2 -borderwidth 1 -relief sunken -width 2] -side left \ -fill y -padx 4 -anchor w -pady 2 eval pack [ ttk::button $p.tb.cut -image $::Info(Img,cut) -command Cut $opt $val] \ -side left eval pack [ ttk::button $p.tb.copy -image $::Info(Img,copy) -command Copy \ $opt $val] -side left eval pack [ ttk::button $p.tb.paste -image $::Info(Img,paste) -command Paste \ $opt $val] -side left eval pack [ ttk::button $p.tb.undo -image $::Info(Img,undo) -command Undo \ $opt $val] -side left pack [ ttk::frame $p.tb.sep3 -borderwidth 1 -relief sunken -width 2] -side left \ -fill y -padx 4 -anchor w -pady 2 eval pack [ ttk::button $p.tb.zoomin -image snackZoomIn -command ZoomIn \ $opt $val] -side left eval pack [ ttk::button $p.tb.zoomout -image snackZoomOut -command ZoomOut \ $opt $val] -side left eval pack [ ttk::button $p.tb.zoomall -image $::Info(Img,zoomall) -command ZoomAll \ $opt $val] -side left eval pack [ ttk::button $p.tb.zoomsel -image $::Info(Img,zoomsel) -command ZoomSel \ $opt $val] -side left pack [ ttk::frame $p.tb.sep4 -borderwidth 1 -relief sunken -width 2] -side left \ -fill y -padx 4 -anchor w -pady 2 pack [ ttk::label $p.tb.time -text 00.000 -relief flat] \ -side left } proc CreateMessagebar {p} { pack [ ttk::frame $p.bf] -side bottom -fill x if {![string is int $::Info(Prefs,wsWidth)] || $::Info(Prefs,wsWidth)<1} { set ::Info(Prefs,wsWidth) 600 } messagebar::create $p.bf.lab -text "" -progress 0.0 -command Interrupt -width $::Info(Prefs,wsWidth) pack $p.bf.lab -side left -expand yes -fill x } proc dropFileCallback {droppedfiles} { puts [info level 0] foreach file $droppedfiles { OpenFile $file } } # Create toolbar CreateToolbar .x # Create messagebar CreateMessagebar .x update idletasks ;# <------- is this necessary? # Initialize wsurf package ::wsurf::Initialize -plugindir $surf(pluginpath) -configdir $surf(configpath) set Info(Prefs,PlayPause) space set Info(Prefs,PlaySelection) F3 set Info(Prefs,PlayCursor) F1 set Info(Prefs,PlayAll) F2 set Info(Prefs,PlayVisible) F5 set Info(Prefs,PlayLoop) F8 set Info(Prefs,PlayStop) F6 set Info(Prefs,Revert) $::AccKey-r set Info(Prefs,Chooser) "" set Info(Prefs,SaveSelection) "" set Info(Prefs,ShowConsole) "" set Info(Prefs,Print) "" set Info(Prefs,Print) "" set Info(Prefs,Prefs) "" set Info(Prefs,MixPaste) $::AccKey-m set Info(Prefs,SelectoNew) "" set Info(Prefs,SelectAll) $::AccKey-a set Info(Prefs,ZeroXAdjust) F4 set Info(Prefs,LockMessageBar) F9 set Info(Prefs,ZoomOut) $::AccKey-minus set Info(Prefs,ZoomIn) $::AccKey-plus set Info(Prefs,ZoomFullOut) F11 set Info(Prefs,ZoomToSelection) F12 set Info(Prefs,Fade) $::AccKey-d set Info(Prefs,Convert) "" set Info(Prefs,Amplify) "" set Info(Prefs,Normalize) "" set Info(Prefs,Echo) "" set Info(Prefs,MixChan) "" set Info(Prefs,Invert) "" set Info(Prefs,Reverse) "" set Info(Prefs,Silence) "" set Info(Prefs,RemoveDC) "" # fix for headings in KeyBindingsPage set Info(Prefs,x0) "" set Info(Prefs,x1) "" set Info(Prefs,x2) "" set Info(Prefs,x3) "" # SetDefaultPrefs # read user preferences set Info(PrefsFile) [file join $::env(HOME) .wavesurfer $Info(Version) \ preferences] set pf $Info(PrefsFile) if {[file readable $pf]} {source $pf} # for backward compatibility with pre 1.8.8 prefs files: if [string match "Show dialog" $::wsurf::Info(Prefs,defaultConfig)] {set ::wsurf::Info(Prefs,defaultConfig) ""} # Create menus CreateMenus .x # Set-up key bindings wsurf::AddEvent PopupEvent $wsurf::Info(Prefs,popupEvent) event add <> catch {event add <> } proc ManageFocus {w} { if {[string match $w $::Info(current)] == 0} { set ::Info(current) $w set n [lsearch $::Info(toplevels) $w] if {$n >= 0} { set tl [lindex $::Info(toplevels) $n] set i [lsearch [winfo children $tl] $tl.s*] if {$i >= 0} { set wsurf [lindex [winfo children $tl] $i] wsurf::MakeCurrent $wsurf set ::WSURF $wsurf set ::SOUND [$wsurf cget -sound] } } } } proc BindKeys {p} { bind $p <$::AccKey-n> New bind $p <$::AccKey-o> Open bind $p <$::AccKey-s> Save bind $p <$::AccKey-w> [list Close $p]\nbreak bind $p <$::AccKey-x> Cut bind $p <$::AccKey-c> Copy bind $p <$::AccKey-v> Paste foreach {prefKey script text} $::Prefs(Table) { if {$::Info(Prefs,$prefKey) != ""} { bind $p <$::Info(Prefs,$prefKey)> $script } } bind $p [list ManageFocus $p] bind $p Cut # fixes for TPB project bind $p ChooseNext bind $p { #puts [focus] ::wsurf::trans::Cursor2FirstLabel [::wsurf::GetCurrent] } } BindKeys .x set Info(current) "" set Info(chooser,replacecurrent) 1 set Info(chooser,autoplay) 1 set Info(chooser,autozoom) 0 set surf(extensions) [list .wav .au .mp3 .aiff .aif .smp .sd .snd .nsp .raw] foreach ext $surf(extTypes) { lappend ::surf(extensions) $ext } foreach {ext rate enc chan bo skip} $::wsurf::Info(Prefs,rawFormats) { lappend ::surf(extensions) $ext } set surf(loadTypes) [concat $surf(loadTypes) \ [list {{Common Files} {.wav}} {{Common Files} {.au}} {{Common Files} {.aif}} {{Raw Files} {.raw}}]] foreach {ext rate enc chan bo skip} $::wsurf::Info(Prefs,rawFormats) { set surf(loadTypes) [concat $surf(loadTypes) [list "{Raw Files} $ext"]] } set surf(loadKeys) [concat $surf(loadKeys) [list WAV AU AIFF RAW]] snack::addExtTypes [concat $surf(extTypes)] snack::addLoadTypes $surf(loadTypes) $surf(loadKeys) snack::addSaveTypes $surf(saveTypes) $surf(saveKeys) #bind .x {if [string match %W .x] exit} # Command line parsing set surf(filelist) "" set surf(play) 0 set surf(conf) [list "unspecified"] # Remove Process ID given by Finder in Mac OS X if {[string match Darwin $::tcl_platform(os)]} { set psnIndex [lsearch -regexp $argv {^-psn_0_[0-9]+$}] if {$psnIndex != -1} { set argv [lreplace $argv $psnIndex $psnIndex] } } package require cmdline set argvcopy "" while {$argvcopy != $argv} { set argvcopy $argv # First let all plug-ins parse argv ::wsurf::getopt argv # Parse what's left of argv if {[cmdline::getopt argv {usage} opt arg] == 1} { puts "Usage: wavesurfer \[options\] file file2 ..." puts "Options" puts "-play" puts "-config name" puts "-filelist file" puts "-master file" puts "-debug n" exit } if {[cmdline::getopt argv {play} opt arg] == 1} { set surf(play) 1 continue } if {[cmdline::getopt argv {config.arg} opt arg] == 1} { if {$surf(conf) == "unspecified"} { set surf(conf) {} } if {[file exists $arg] && [string match *.conf $arg]} { lappend surf(conf) $arg continue } if {[string match *.conf $arg]} { set arg [file root $arg] } set l [::wsurf::GetConfigurations] set ind [lsearch -regexp $l ".*$arg\[\\w\\s\]*.conf"] if {$ind != -1 && $arg != ""} { lappend surf(conf) [lindex $l $ind] } else { lappend surf(conf) "" } continue } if {[cmdline::getopt argv {filelist.arg} opt arg] == 1} { ReadFileList $arg Chooser .chooser.frame.list selection set 0 } if {[cmdline::getopt argv {master.arg} opt arg] == 1} { set ::Info(MasterWidget) $arg SetMasterWidget continue } if {[cmdline::getopt argv {debug.arg} opt arg] == 1} { set ::wsurf::Info(debug) $arg if {$arg > 5} { snack::debug $arg ~/wsurf.log } else { snack::debug $arg } } } #set ::wsurf::Info(debug) 5 #snack::debug 5 ~/wsurf.log if {$argv == {} && [info exists listfiles] && [llength $listfiles] > 0} { set argv [lindex [split [lindex $listfiles 0] ;] 0] } # argv should only contain sound files now set surf(filelist) $argv # register dde server if {[string match windows $::tcl_platform(platform)]} { package require dde dde servername WaveSurfer } # display gui & rid splash CleanUp wm deiconify .x SetIcon .x destroy $splash::splash update idletasks if {$surf(conf) == "unspecified" && $::wsurf::Info(Prefs,defaultConfig) != ""} { set l [::wsurf::GetConfigurations] set ind [lsearch -regexp $l ".*$::wsurf::Info(Prefs,defaultConfig)\[\\w\\s\]*.conf"] if {$ind != -1} { set surf(conf) {} lappend surf(conf) [lindex $l $ind] } else { set surf(conf) [list "unspecified"] } } # create wsurf widgets if {[llength $surf(filelist)] == 1 && [file isdirectory $surf(filelist)]} { set surf(filelist) "" } if {[llength $surf(filelist)] == 0} { # no files given on command line, pack an empty widget set w [wsurf .x.s[incr surf(count)] -messageproc setMsg \ -progressproc progressCallback -playpositionproc progressCallback -dropfileproc dropFileCallback] pack $w -expand 0 -fill both -side top set Info(widgets,.x) $w if {$surf(conf) != "unspecified"} { $w configure -configuration [lindex $surf(conf) 0] } } else { # load files specified on the command line into widgets set i 0 foreach file $surf(filelist) { if {$surf(conf) != "unspecified"} { OpenFile $file [lindex $surf(conf) $i] } else { OpenFile $file } incr i if {$i == [llength $surf(conf)]} { incr i -1 } } } if {[string match macintosh $::tcl_platform(platform)]} { bind .x FixHeight set oldwi 0 proc FixHeight {} { regexp {([\d]+)[x][\d]+[+][\d]+[+][\d]+} [wm geometry .x] dummy width if {$::oldwi == $width} return if {$::oldwi == 0} { set ::oldwi $width return } bind .x "" wm geometry .x {} update idletasks regexp {[\d]+[x]([\d]+)[+][\d]+[+][\d]+} [wm geometry .x] dummy height wm geometry .x ${width}x$height set ::oldwi $width bind .x FixHeight } } if {$newVersion} { tk_messageBox -message [::util::mc "This is the first time you run WaveSurfer $Info(Version). You might have old configuration files and plug-ins in $lastVersion that need to be moved to $newHome."] } wavesurfer-1.8.8p5/src/configurations/000077500000000000000000000000001325326000200200005ustar00rootroot00000000000000wavesurfer-1.8.8p5/src/configurations/Demonstration.conf000066400000000000000000000054301325326000200234770ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer set ::Info(Prefs,wsLeft) 0 set ::Info(Prefs,wsTop) 40 set ::Info(Prefs,wsWidth) 600 $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -background {Black} $pane configure -yaxiscolor {green} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addWaveform $pane -fill "green" -limit "32768" set ::wsurf::analysis::${pane}::var(sectwinw) 352 set ::wsurf::analysis::${pane}::var(sectwinh) 391 set ::wsurf::analysis::${pane}::var(sectwinx) 727 set ::wsurf::analysis::${pane}::var(sectwiny) 213 $widget analysis::openSectWindow $pane analysis::waControls $widget $pane regsub -all {\.} $pane _ widgetPath set p .wactrl$widgetPath wm geometry $p +840+460 } set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -background {Black} $pane configure -showyaxis {true} $pane configure -yaxiscolor {green} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled dataplot]} { $widget dataplot::addDataPlot $pane -stylelist "0 red Line 1 green Line 2 blue Line 3 yellow Line" -fileextension ".frm" -invocation "indirect" -unit "Hz" -minvalue "0.0" } if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane -colormap "color" -fftlength "1024" -topfrequency "5000.0" analysis::bcControls $widget $pane regsub -all {\.} $pane _ widgetPath set p .cbctrl$widgetPath wm geometry $p +660+460 } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } 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 -labelmenu { 7 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8 {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} {} } } wavesurfer-1.8.8p5/src/configurations/HTK transcription.conf000066400000000000000000000024541325326000200241620ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } set pane [$widget addPane -maxheight 24 -minheight 24] $pane configure -height {24} $pane configure -scrollheight {24} $pane configure -background {white} 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 -format "HTK" } wavesurfer-1.8.8p5/src/configurations/IPA transcription.conf000066400000000000000000000060451325326000200241450ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "10000" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane -channel all -fftlength 256 -winlength 128 -wintype Hamming -preemphasis 0.97 -sectfftlength 512 -sectwintype Hamming -sectanalysistype FFT -sectlpcorder 20 -sectpreemphasis 0.0 -sectreference -110.0 -sectrange 110.0 -sectdoall 0 -sectexportheader 0 -gridtspacing 0 -gridfspacing 0 -gridcolor red -brightness 0.0 -contrast 0.0 -topfrequency 8000.0 -predraw 0 -scrollspeed 250 -colormap grey } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane -color black -timeformat time -font {Courier 10} } set pane [$widget addPane -maxheight 25 -minheight 25] $pane configure -height {25} $pane configure -scrollheight {25} $pane configure -relief {solid} 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 "HTK" -extension ".lab" -labelcolor black -boundarycolor black -backgroundcolor white -labeldirectory "" -fileencoding "utf-8" -labelmenuevent Shift-ButtonPress-3 -adjustleftevent Control-l -adjustrightevent Control-r -playlabelevent Control-space -locked 0 -quickenter 1 -quickentertolerance 20 -extendboundaries 0 -font {Courier 10} -labelmenu { 6 16 {\u0250} {\u0260} {\u0270} {\u0280} {\u0290} {\u02a0} {\u0251} {\u0261} {\u0271} {\u0281} {\u0291} {\u02a1} {\u0252} {\u0262} {\u0272} {\u0282} {\u0292} {\u02a2} {\u0253} {\u0263} {\u0273} {\u0283} {\u0293} {\u02a3} {\u0254} {\u0264} {\u0274} {\u0284} {\u0294} {\u02a4} {\u0255} {\u0265} {\u0275} {\u0285} {\u0295} {\u02a5} {\u0256} {\u0266} {\u0276} {\u0286} {\u0296} {\u02a6} {\u0257} {\u0267} {\u0277} {\u0287} {\u0297} {\u02a7} {\u0258} {\u0268} {\u0278} {\u0288} {\u0298} {\u02a8} {\u0259} {\u0269} {\u0279} {\u0289} {\u0299} {\u02a9} {\u025a} {\u026a} {\u027a} {\u028a} {\u029a} {\u02aa} {\u025b} {\u026b} {\u027b} {\u028b} {\u029b} {\u02ab} {\u025c} {\u026c} {\u027c} {\u028c} {\u029c} {\u02ac} {\u025d} {\u026d} {\u027d} {\u028d} {\u029d} {\u02ad} {\u025e} {\u026e} {\u027e} {\u028e} {\u029e} {} {\u025f} {\u026f} {\u027f} {\u028f} {\u029f} {} } } wavesurfer-1.8.8p5/src/configurations/Spectrogram.conf000066400000000000000000000012251325326000200231350ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } wavesurfer-1.8.8p5/src/configurations/Speech analysis.conf000066400000000000000000000033231325326000200236630ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -height {100} $pane configure -scrollheight {100} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addWaveform $pane } set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -showyaxis {true} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled dataplot]} { $widget dataplot::addDataPlot $pane -stylelist "0 red Line 1 green Line 2 blue Line 3 yellow Line" -fileextension ".frm" -invocation "indirect" -unit "Hz" -minvalue "0.0" } if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane -fftlength "256" -topfrequency "8000.0" $widget analysis::addFormants $pane -wintype "Hamming" } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -height {100} $pane configure -scrollheight {100} $pane configure -showyaxis {true} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled dataplot]} { $widget dataplot::addDataPlot $pane -stylelist "0 black Dots" -fileextension ".f0" -invocation "indirect" -unit "Hz" -maxvalue "400" -minvalue "0.0" } if {[wsurf::PluginEnabled analysis]} { $widget analysis::addPitch $pane } wavesurfer-1.8.8p5/src/configurations/TIMIT phones-words.conf000066400000000000000000000042221325326000200241460ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} $pane configure -yaxisfont {Helvetica 10} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } set pane [$widget addPane -maxheight 32 -minheight 32] $pane configure -height {32} $pane configure -scrollheight {32} $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 -extension ".PHN" -format "TIMIT" } set pane [$widget addPane -maxheight 32 -minheight 32] $pane configure -height {32} $pane configure -scrollheight {32} $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 -extension ".WRD" -format "TIMIT" } wavesurfer-1.8.8p5/src/configurations/TIMIT transcription.conf000066400000000000000000000025001325326000200244120ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } set pane [$widget addPane -maxheight 24 -minheight 24] $pane configure -height {24} $pane configure -scrollheight {24} $pane configure -background {white} 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 -extension ".PHN" -format "TIMIT" } wavesurfer-1.8.8p5/src/configurations/Transcription.conf000066400000000000000000000024361325326000200235130ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -unit {Hz} $pane configure -stipple {gray12} $pane configure -layer {top} $pane configure -showyaxis {true} if {[wsurf::PluginEnabled analysis]} { $widget analysis::addSpectrogram $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} $pane configure -background {white} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } set pane [$widget addPane -maxheight 24 -minheight 24] $pane configure -height {24} $pane configure -scrollheight {24} 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 } wavesurfer-1.8.8p5/src/configurations/Waveform.conf000066400000000000000000000010261325326000200224340ustar00rootroot00000000000000# -*-Mode:Tcl-*- # This file is automatically generated by WaveSurfer $widget configure -wavebarheight "25" $widget configure -pixelspersecond "400.0" $widget configure -playmapfilter "1" set pane [$widget addPane -maxheight 2048 -minheight 10] if {[wsurf::PluginEnabled analysis]} { $widget analysis::addWaveform $pane } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } wavesurfer-1.8.8p5/src/configurations/n-waveforms.conf000066400000000000000000000016451325326000200231210ustar00rootroot00000000000000# -*-Mode:Tcl-*- $widget configure -wavebarheight "25" $widget configure -pixelspersecond "1.0" $widget configure -playmapfilter "1" # Configuration files are Tcl script that gets evaluated inside WaveSurfer # This makes it possible to create configurations like this one containing # arbitrary code. In this case we dynamically add one waveform # pane for each channel of the current sound. This configuration file # can not be created from within the WaveSurfer tool. for {set i 0} {$i < [[$widget cget -sound] cget -channels]} {incr i} { set pane [$widget addPane -maxheight 2048 -minheight 10] $pane configure -height 50 if {[wsurf::PluginEnabled analysis]} { $widget analysis::addWaveform $pane -channel $i } } set pane [$widget addPane -maxheight 20 -minheight 20] $pane configure -height {20} $pane configure -scrollheight {20} if {[wsurf::PluginEnabled timeaxis]} { $widget timeaxis::addTimeAxis $pane } wavesurfer-1.8.8p5/src/plugins/000077500000000000000000000000001325326000200164275ustar00rootroot00000000000000wavesurfer-1.8.8p5/src/plugins/README.txt000066400000000000000000000005271325326000200201310ustar00rootroot00000000000000This directory contains a number of example plug-ins showing how the WaveSurfer plugin API can be used. Move these files to wsurf1.8/plugins/ or to ~/.wavesurfer/1.8/plugins/ in order to use them. example1.plug Simple example that adds a pane showing voicing info. example2.plug Extension of the previous that adds a properties dialog wavesurfer-1.8.8p5/src/plugins/analysis.plug000066400000000000000000002213771325326000200211570ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # wsurf::RegisterPlugin analysis \ -description "This plug-in provides the basic sound analysis and\ visualization capabilities in WaveSurfer. The plug-in adds the pane\ types waveform,\ spectrogram, pitch contour and power plot. The first three support\ real-time preview during recording. There are numerous options to\ configure appearance/analysis parameters in the properties-dialog. \ The dataplot plug-in is used for plotting the actual pitch and power\ values." \ -url "http://www.speech.kth.se/wavesurfer/" \ -addmenuentriesproc analysis::addMenuEntries \ -panecreatedproc analysis::paneCreated \ -panedeletedproc analysis::paneDeleted \ -redrawproc analysis::redraw \ -getboundsproc analysis::getBounds \ -scrollproc analysis::scroll \ -setselectionproc analysis::setSelection \ -cursormovedproc analysis::cursorMoved \ -printproc analysis::print \ -propertiespageproc analysis::propertyPane \ -applypropertiesproc analysis::applyProperties \ -getconfigurationproc analysis::getConfiguration \ -soundchangedproc analysis::soundChanged \ -playproc analysis::play \ -recordproc analysis::record # ----------------------------------------------------------------------------- namespace eval analysis { variable Info set Info(WaveformOptionTable) [list \ -channel channel all \ -fill wavecolor black \ -limit limit -1 \ -predraw preDraw 0 \ -sectfftlength sfftlen 512 \ -sectwintype swintype Hamming \ -sectanalysistype satype FFT \ -sectlpcorder slpcorder 20 \ -sectpreemphasis spreemph 0.0 \ -sectreference sref -110.0 \ -sectrange srange 110.0 \ -sectdoall sall 0 \ -sectexportheader sexphead 0 \ -subsample subsample 1 \ -trimstart trimstart 1 \ -scrollspeed rtpps 250 \ ] set Info(SpectrogramOptionTable) [list \ -channel channel all \ -colormap cmap grey \ -gridtspacing gridtspacing 0 \ -gridfspacing gridfspacing 0 \ -gridcolor gridColor red \ -brightness brightness 0.0 \ -contrast contrast 0.0 \ -fftlength fftlen 512 \ -winlength winlen 64 \ -wintype wintype Hamming \ -preemphasis preemph 0.97 \ -sectfftlength sfftlen 512 \ -sectwintype swintype Hamming \ -sectanalysistype satype FFT \ -sectlpcorder slpcorder 20 \ -sectpreemphasis spreemph 0.0 \ -sectreference sref -110.0 \ -sectrange srange 110.0 \ -sectdoall sall 0 \ -sectexportheader sexphead 0 \ -topfrequency topfr -1 \ -predraw preDraw 0 \ -layer layer top \ -scrollspeed rtpps 250 \ ] set Info(PitchOptionTable) [list \ -method method ESPS \ -maxpitch maxPitch 400 \ -minpitch minPitch 60 \ -shownotescale showScale 0 \ -scalebase scaleBase 65.4064 \ -scalefill scaleColor grey \ -pitchpreview pitchPreview 1 \ -exportheader exportHeader 0 \ -scrollspeed rtpps 250 \ -frameinterval frameInterval 0.01 \ -winlength pwinlen 0.0075 \ ] set Info(PowerOptionTable) [list \ -channel channel all \ -winlength ewinlen 200 \ -frameinterval frameInterval 0.01 \ -wintype ewintype Hamming \ -preemphasis epreemph 0.97 \ -maxpower maxPower 80 \ -minpower minPower 0 \ -exportheader exportHeader 0 \ ] set Info(FormantsOptionTable) [list \ -winlength fwinlen 0.049 \ -frameinterval frameInterval 0.01 \ -wintype fwintype "cos^4" \ -preemphasis fpreemph 0.7 \ -exportheader exportHeader 0 \ -numformants numformants 4 \ -lpcorder lpcorder 12 \ -lpctype lpctype 0 \ -dsfreq dsfreq 10000.0 \ -nomf1freq nomf1freq -10.0 \ ] } # ---------------------------------------------------------------------------- proc analysis::addMenuEntries {w pane m hook x y} { if {[string match query $hook]} { return 1 } if {[string match create $hook]} { $m.$hook add command -label "Waveform" \ -command [namespace code [list createWaveform $w $pane]] $m.$hook add command -label "Spectrogram" \ -command [namespace code [list createSpectrogram $w $pane]] $m.$hook add command -label "Pitch Contour" \ -command [namespace code [list createPitch $w $pane]] $m.$hook add command -label "Power Plot" \ -command [namespace code [list createPower $w $pane]] $m.$hook add command -label "Formant Plot" \ -command [namespace code [list createFormants $w $pane]] } elseif {[string match main $hook]} { upvar [namespace current]::${pane}::var v if {[info exists v(drawSpectrogram)]} { if {$v(drawSpectrogram) || $v(drawWaveform)} { $m add command -label "Spectrum Section..." \ -command [namespace code [list openSectWindow $w $pane]] $m add command -label "LTAS..." \ -command [namespace code [list openSectWindowLTAS $w $pane]] if {$v(drawSpectrogram)} { $m add command -label "Spectrogram Controls..." \ -command [namespace code [list bcControls $w $pane]] } if {$v(drawWaveform)} { $m add command -label "Waveform Blow-up..." \ -command [namespace code [list openBlowUpWindow $w $pane]] $m add command -label "Waveform Controls..." \ -command [namespace code [list waControls $w $pane]] } } } } } proc analysis::paneCreated {w pane} { variable Info namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(drawWaveform) 0 set v(drawSpectrogram) 0 set v(drawPitch) 0 set v(drawPower) 0 set v(drawSection) 0 set v(drawFormants) 0 set v(channel) all set v(sectwinw) 420 set v(sectwinh) 400 set v(sectwinx) 200 set v(sectwiny) 200 set v(rx) -1 set v(blowupwinw) 300 set v(blowupwinh) 200 set v(blowupwinx) 200 set v(blowupwiny) 200 set v(blowuptimewin) 0.01 set Info(debug) $::wsurf::Info(debug) } proc analysis::paneDeleted {w pane} { regsub -all {\.} $pane _ widgetPath catch {destroy .sect$widgetPath} catch {destroy .blowup} catch {destroy .cbctrl$widgetPath} catch {destroy .wactrl$widgetPath} namespace delete [namespace current]::${pane} } # ----------------------------------------------------------------------------- proc analysis::createWaveform {w pane} { set pane [$w addPane -before $pane -height 200 -scrollheight 200 \ -unit ""] addWaveform $w $pane } proc analysis::createSpectrogram {w pane} { set pane [$w addPane -before $pane -height 200 -scrolled 0 -scrollheight 200 \ -unit Hz -stipple gray12 -layer top -showyaxis true] addSpectrogram $w $pane } proc analysis::createPitch {w pane} { set pane [$w addPane -before $pane -height 100 -scrollheight 100 -unit Hz \ -showyaxis true] addPitch $w $pane } proc analysis::createPower {w pane} { set pane [$w addPane -before $pane -height 100 -scrollheight 100 -unit dB \ -showyaxis true] addPower $w $pane } proc analysis::createFormants {w pane} { set pane [$w addPane -before $pane -height 200 -scrollheight 200 -unit Hz \ -showyaxis true] addFormants $w $pane } proc analysis::addWaveform {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(WaveformOptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(WaveformOptionTable) { set v($key) $a($option) } set c [$pane canvas] set s [$w cget -sound] if {[string match {[0-9]} $a(-channel)] && \ $a(-channel) >= [$s cget -channels]} { set chan all } else { set chan $a(-channel) } set v(topfr) [expr {0.5*[$s cget -rate]}] set v(topfr2) [expr {0.5*[$s cget -rate]}] if {[$w getInfo isLinked2File]} { set fileName [$w getInfo fileName] $c create waveform 0 0 -anchor w -sound $s -channel $chan \ -tags [list analysis waveform] -fill $a(-fill) -end 0 \ -limit $v(limit) -trimstart $v(trimstart) \ -shapefile [$w _shapeFilename $fileName] \ -debug $Info(debug) } else { $c create waveform 0 0 -anchor w -sound $s -channel $chan \ -tags [list analysis waveform] -trimstart $v(trimstart) \ -fill $a(-fill) -end 0 -limit $v(limit) \ -debug $Info(debug) } if {[$s cget -channels] > 1} { set v(max) [$s max -channel $v(channel)] set v(min) [$s min -channel $v(channel)] } else { set v(max) [$s max] set v(min) [$s min] } set v(sound) $s set v(drawWaveform) 1 } proc analysis::addSpectrogram {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(SpectrogramOptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(SpectrogramOptionTable) { set v($key) $a($option) } set s [$w cget -sound] set v(grey) " " set v(color) {#000 #001 #002 #003 #004 #005 #006 #007 #008 #009 #00A #00B \ #00C #00D #00E #00F #01F #02F #03F #04F #05F #06F #07F #08F #09F #0AF \ #0BF #0CF #0DF #0EF #0FF #0FE #0FD #0FC #0FB #0FA #0F9 #0F8 #0F7 #0F6 #0F5 \ #0F4 #0F3 #0F2 #0F1 #0F0 #1F0 #2F0 #3F0 #4F0 #5F0 #6F0 #7F0 #8F0 #9F0 #AF0 \ #BF0 #CF0 #DF0 #EF0 #FF0 #FE0 #FD0 #FC0 #FB0 #FA0 #F90 #F80 #F70 #F60 #F50 \ #F40 #F30 #F20 #F10 #F00} set v(color2) {#21004b008282 #0000afafafaf #0000a9a9afaf #0000a3a3afaf #00009d9dafaf #00009797afaf #00009191afaf #00008b8bafaf #00008585afaf #00007979afaf #00007373afaf #00006d6dafaf #00006767afaf #00006161afaf #00005b5bafaf #00005555afaf #00004f4fafaf #00004343afaf #00003d3dafaf #00003737afaf #00003131afaf #00002b2bafaf #00002525afaf #00001f1fafaf #000000008080 #040400007c7c #060600007a7a #080800007878 #0a0a00007676 #0c0c00007474 #0e0e00007272 #101000007070 #121200006e6e #161600006a6a #181800006868 #1a1a00006666 #1c1c00006464 #1e1e00006262 #202000006060 #222200005e5e #242400005c5c #282800005858 #2a2a00005656 #2c2c00005454 #2e2e00005252 #303000005050 #404000004e4e #464600004c4c #4c4c00004a4a #585800004646 #5e5e00004444 #646400004242 #6a6a00004040 #707000003e3e #767600003c3c #7c7c00003a3a #828200003838 #8e8e00003434 #949400003232 #9a9a00003030 #a0a000002e2e #a6a600002c2c #acac00002a2a #b2b200002828 #b8b800002626 #c4c400002222 #caca00002020 #d0d000001e1e #ffff00000000 #ffff0a0a0000 #ffff14140000 #ffff1e1e0000 #ffff28280000 #ffff3c3c0000 #ffff46460000 #ffff50500000 #ffff5a5a0000 #ffff64640000 #ffff6e6e0000 #ffff78780000 #ffff82820000 #ffff96960000 #ffffa0a00000 #ffffaaaa0000 #ffffb4b40000 #ffffbebe0000 #ffffc8c80000 #ffffd2d20000 #ffffdcdc0000 #fffff0f00000 #ffffffff0000 #ffffffff0808 #ffffffff1010 #ffffffff1818 #ffffffff2020 #ffffffff2828 #ffffffff3030 #ffffffff4040 #ffffffff4848 #ffffffff5050 #ffffffff5858 #ffffffff6060 #ffffffff6868 #ffffffff7070 #ffffffff7878 #ffffffff8888 #ffffffff9090 #ffffffff9898 #ffffffffa0a0 #ffffffffa8a8 #ffffffffb0b0 #ffffffffb8b8 #ffffffffc0c0 #ffffffffd0d0 #ffffffffd8d8 #ffffffffffff} set c [$pane canvas] if {[string match {[0-9]} $a(-channel)] && $a(-channel) >= [$s cget -channels]} { set chan all } else { set chan $a(-channel) } if {0.5*[$s cget -rate] < $v(topfr) || $v(topfr) == -1} { set v(topfr2) [expr {0.5*[$s cget -rate]}] } else { set v(topfr2) $v(topfr) } set v(anabw) [expr {int(double([$s cget -rate]) / \ $v(winlen))}] set winlen $v(winlen) if {$winlen < 1} { set winlen 1 } $c create spectrogram 0 0 -sound $s -channel $chan -anchor sw \ -tags [list analysis spectrogram] -end 0 \ -fftlen $v(fftlen) -winlen $winlen \ -windowtype $v(wintype) \ -colormap $v($v(cmap)) \ -gridtspacing $v(gridtspacing) \ -gridfspacing $v(gridfspacing) \ -gridcol $v(gridColor) \ -preemph $v(preemph) -debug $Info(debug) set v(sound) $s set v(drawSpectrogram) 1 } proc analysis::addPitch {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(PitchOptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(PitchOptionTable) { set v($key) $a($option) } set v(drawPitch) 1 set v(computePitch) 0 set v(pitchList) {} _computePitch $w $pane upvar wsurf::dataplot::${pane}::var t if {$t(drawDataPlot) == 0} { wsurf::dataplot::addDataPlot $w $pane -unit Hz -invocation indirect \ -fileextension f0 -stylelist {0 black Dots} -maxvalue $v(maxPitch) \ -frameinterval $v(frameInterval) -minvalue 0.0 -offset [expr {$v(pwinlen)/2}] } set head "File: [$w getInfo fileName]\n" append head "Pitch method: $v(method)\n" append head "Max pitch limit: $v(maxPitch) Hz\n" append head "Min pitch limit: $v(minPitch) Hz\n" append head "Window length: $v(pwinlen) s\n" append head "Frame interval: $v(frameInterval) s" wsurf::dataplot::processData $w $pane $v(pitchList) $v(frameInterval) $head pitch _drawPitch $w $pane } proc analysis::_computePitch {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] $w messageProc "Calculating pitch..." if {[catch {set v(pitchList) [$s pitch \ -method $v(method) \ -maxpitch $v(maxPitch) \ -minpitch $v(minPitch) \ -framelength $v(frameInterval) \ -windowlength $v(pwinlen) \ -progress [$w cget -progressproc]]} ret]} { if {$ret != ""} { $w messageProc "$ret" error "$ret" } set v(pitchList) {} } else { $w messageProc "Pitch calculation finished" } set v(computePitch) 0 } proc analysis::_drawPitch {w pane} { upvar [namespace current]::${pane}::var v $w messageProc "Drawing pitch plot..." update idletasks set c [$pane canvas] set height [$pane cget -scrollheight] set width [$pane getCanvasX [$pane cget -maxtime]] $c delete scale set maxv [$pane cget -maxvalue] set minv [$pane cget -minvalue] if {$maxv == $minv} return if {$v(showScale)} { set v(scale) {} foreach i {0 2 4 5 7 9 11 12 14 16 17 19 21 23 24 26 28 29 31 33 35 36 38 40 41 43 45 47 48 50 52 53 55 57 59 60} { set f [expr {$v(scaleBase) * pow(pow(2,1.0/12),$i)}] lappend v(scale) $f set yc [expr {$height-double($height)/($maxv-$minv)*($f-$minv)}] if {$yc < 0} break $c create line 0 $yc $width $yc \ -fill $v(scaleColor) -tags [list analysis scale] } } $w messageProc "" } proc analysis::addPower {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(PowerOptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(PowerOptionTable) { set v($key) $a($option) } set v(drawPower) 1 set v(computePower) 0 set v(powerList) {} _computePower $w $pane wsurf::dataplot::addDataPlot $w $pane -unit dB -invocation indirect \ -fileextension pwr -frameinterval $v(frameInterval) \ -maxvalue $v(maxPower) -minvalue $v(minPower) set head "File: [$w getInfo fileName]\n" append head "Window type: $v(ewintype)\n" append head "Window length: $v(ewinlen) points\n" append head "Frame interval: $v(frameInterval) s\n" append head "Pre-emphasis: $v(epreemph)\n" append head "Channel: $v(channel)" wsurf::dataplot::processData $w $pane $v(powerList) \ $v(frameInterval) $head power } proc analysis::_computePower {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] $w messageProc "Calculating power..." if {[catch {set v(powerList) [$s power \ -windowlength $v(ewinlen) \ -windowtype $v(ewintype) \ -framelength $v(frameInterval) \ -preemphasis $v(epreemph) \ -channel $v(channel) \ -progress [$w cget -progressproc]]} ret]} { if {$ret != ""} { $w messageProc "$ret" error "$ret" } set v(powerList) {} } else { $w messageProc "Power calculation finished" } set v(computePower) 0 } proc analysis::addFormants {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(FormantsOptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(FormantsOptionTable) { set v($key) $a($option) } set s [$w cget -sound] set v(formantList) {} set v(drawFormants) 1 set v(computeFormants) 0 set invokedFromMenu 0 if {[info exists v(drawSpectrogram)]} { if {$v(drawSpectrogram) == 0} { set invokedFromMenu 1 } } else { set invokedFromMenu 1 } if {$invokedFromMenu} { addSpectrogram $w $pane } _computeFormants $w $pane if {$invokedFromMenu} { wsurf::dataplot::addDataPlot $w $pane -unit Hz \ -invocation indirect -offset [expr {$v(fwinlen)/2}] \ -fileextension frm -minvalue 0.0 \ -stylelist [lrange [list 0 red Line 1 green Line 2 blue Line 3 yellow Line 4 black Line 5 magenta Line 6 cyan Line] 0 [expr 3*($v(numformants))-1]] } set head "File: [$w getInfo fileName]\n" append head "Window type: $v(wintype)\n" append head "Window length: $v(fwinlen) s\n" append head "Frame interval: $v(frameInterval) s\n" append head "Pre-emphasis: $v(fpreemph)\n" append head "Number of formants: $v(numformants)\n" append head "LPC order: $v(lpcorder)\n" append head "LPC type: $v(lpctype)\n" append head "Down-sampling frequency: $v(dsfreq) Hz\n" append head "Nominal F1 frequency: $v(nomf1freq) Hz" wsurf::dataplot::processData $w $pane $v(formantList) \ $v(frameInterval) $head formants # $w _redrawPane $pane } proc analysis::_computeFormants {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] $w messageProc "Calculating formants..." if {[catch {set v(formantList) [$s formant \ -framelength $v(frameInterval) \ -preemphasis $v(fpreemph) \ -numformants $v(numformants) \ -lpcorder $v(lpcorder) \ -windowlength $v(fwinlen) \ -windowtype $v(fwintype) \ -lpctype $v(lpctype) \ -ds_freq $v(dsfreq) \ -nom_f1_freq $v(nomf1freq) \ -progress [$w cget -progressproc]]} ret]} { if {$ret != ""} { $w messageProc "$ret" error "$ret" } set v(formantList) {} } else { $w messageProc "Formants calculation finished" } } proc analysis::redraw {w pane} { upvar [namespace current]::${pane}::var v if {[$w getInfo isRecording]} return set c [$pane canvas] set s [$w cget -sound] if {[string match {[0-9]} $v(channel)] && \ $v(channel) >= [$s cget -channels]} { set chan all } else { set chan $v(channel) } if {$v(drawWaveform)} { set wh [$pane cget -scrollheight] set mid [expr {$wh/2}] if {$v(preDraw) == 0} { foreach {fracLeft fracRight} [[$pane canvas] xview] break # set start [expr {int($fracLeft*[$s length])}] # set end [expr {int($fracRight*[$s length])}] set start [expr {int($fracLeft*[$pane cget -maxtime]*[$s cget -rate]+1.0)}] set end [expr {int($fracRight*[$pane cget -maxtime]*[$s cget -rate]+1.0)}] set len [expr {$end-$start}] if {$v(subsample) && $len > 10000000} { set sub 30 } elseif {$v(subsample) && $len > 1000000} { set sub 10 } else { set sub 1 } set fi [expr {[$c canvasx 0.0] / [$pane cget -pixelspersecond] * \ [$s cget -rate]}] set corr [expr {($fi-int($fi))*[$pane cget -pixelspersecond] / \ [$s cget -rate]}] set xpos [expr {[$c canvasx 0] - $corr}] $c coords waveform $xpos $mid $c itemconfig waveform -fill $v(wavecolor) -channel $chan \ -height $wh -pixelspersecond [$w cget -pixelspersecond] \ -limit $v(limit) -trimstart $v(trimstart) \ -subsample $sub -start $start -end $end } else { $c coords waveform 0 $mid $c itemconfig waveform -fill $v(wavecolor) -channel $chan \ -height $wh -pixelspersecond [$w cget -pixelspersecond] \ -limit $v(limit) -start 0 -end -1 } set yc [$pane yaxis] $yc delete axis $yc create text 0 0 -text $v(max) \ -font [$pane cget -yaxisfont] -anchor nw -tags [list axis max] \ -fill [$pane cget -yaxiscolor] set yh [$pane cget -scrollheight] $yc create text 0 [$pane cget -height] -text $v(min) \ -font [$pane cget -yaxisfont] -anchor sw -tags [list axis min] \ -fill [$pane cget -yaxiscolor] if $v(limit)>1 { $yc itemconfigure max -text $v(limit) $yc itemconfigure min -text [expr -1*$v(limit)] } } if {$v(drawSpectrogram)} { set sh [expr {int([$pane getCanvasY 0]-[$pane getCanvasY $v(topfr2)])}] if {$v(preDraw) == 0} { foreach {fracLeft fracRight} [[$pane canvas] xview] break # set start [expr {int($fracLeft*[$s length])}] # set end [expr {int($fracRight*[$s length])}] set start [expr {int($fracLeft*[$pane cget -maxtime]*[$s cget -rate])}] set end [expr {int($fracRight*[$pane cget -maxtime]*[$s cget -rate])}] $c coords spectrogram [$c canvasx 0] [$pane getCanvasY 0] $c itemconfigure spectrogram -start $start -end $end -channel $chan \ -height $sh -pixelspersecond [$w cget -pixelspersecond] \ -winlen $v(winlen) \ -fftlen $v(fftlen) -topfr $v(topfr2) \ -windowtype $v(wintype) \ -colormap $v($v(cmap)) \ -preemph $v(preemph) \ -brightness $v(brightness) \ -contrast $v(contrast) \ -gridtspacing $v(gridtspacing) \ -gridfspacing $v(gridfspacing) \ -gridcolor $v(gridColor) } else { $c coords spectrogram 0 [$pane getCanvasY 0] $c itemconfigure spectrogram -start 0 -end -1 -channel $chan \ -height $sh -pixelspersecond [$w cget -pixelspersecond] \ -winlen $v(winlen) \ -fftlen $v(fftlen) -topfr $v(topfr2) \ -windowtype $v(wintype) \ -colormap $v($v(cmap)) \ -preemph $v(preemph) \ -brightness $v(brightness) \ -contrast $v(contrast) \ -gridtspacing $v(gridtspacing) \ -gridfspacing $v(gridfspacing) \ -gridcolor $v(gridColor) if {[$c itemcget spectrogram -width] == 32767} { tk_messageBox -icon warning -type ok -message "The spectrogram was cut\ after 32767 pixels. Please turn off pre-drawing to view all of it." } } } if {$v(drawPitch)} { if {$v(computePitch)} { _computePitch $w $pane wsurf::dataplot::processData $w $pane $v(pitchList) $v(frameInterval) "" pitch } _drawPitch $w $pane } if {$v(drawPower)} { if {$v(computePower)} { _computePower $w $pane wsurf::dataplot::processData $w $pane $v(powerList) \ $v(frameInterval) "" power } } if {$v(drawFormants)} { if {$v(computeFormants)} { _computeFormants $w $pane wsurf::dataplot::processData $w $pane $v(formantList) \ $v(frameInterval) "" formants } } if {$v(drawSection)} { drawSect $w $pane } } proc analysis::getBounds {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] if {$v(drawSpectrogram)} { list 0 0 [$s length -unit seconds] $v(topfr2) } elseif {$v(drawWaveform)} { set max [util::max [lindex [$s max] 0] [expr {-[lindex [$s min] 0]}]] set min [util::min [lindex [$s min] 0] [expr {-[lindex [$s max] 0]}]] list 0 $min [$s length -unit seconds] $max # list 0 [lindex [$s min] 0] [$s length -unit seconds] [lindex [$s max] 0] } else { list } } proc analysis::scroll {w pane frac1 frac2} { upvar [namespace current]::${pane}::var v if {$v(drawWaveform) || $v(drawSpectrogram)} { if {$v(preDraw) == 0} { set s [$w cget -sound] set start [expr {int($frac1*[$pane cget -maxtime]*[$s cget -rate]+1.0)}] set end [expr {int($frac2*[$pane cget -maxtime]*[$s cget -rate]+1.0)}] set len [expr {$end-$start}] set c [$pane canvas] if {$v(drawWaveform)} { set fi [expr [$c canvasx 0.0] / [$pane cget -pixelspersecond] * \ [$s cget -rate]] set corr [expr ($fi-int($fi))*[$pane cget -pixelspersecond] / \ [$s cget -rate]] set xpos [expr {[$c canvasx 0] - $corr}] set ymid [expr {[$pane cget -scrollheight]/2}] $c coords waveform $xpos $ymid if {$v(subsample) && $len > 10000000} { set sub 30 } elseif {$v(subsample) && $len > 1000000} { set sub 10 } else { set sub 1 } $c itemconfigure waveform -start $start -end $end -subsample $sub } if {$v(drawSpectrogram)} { $c coords spectrogram [$c canvasx 0] [$pane getCanvasY 0] $c itemconfigure spectrogram -start $start -end $end } } } } proc analysis::setSelection {w pane left right} { drawSect $w $pane } proc analysis::cursorMoved {w pane time value} { upvar [namespace current]::${pane}::var v if {[$w getInfo isPlaying]} return set s [$w cget -sound] if {[string match {[0-9]} $v(channel)] && \ $v(channel) >= [$s cget -channels]} { set v(channel) all } foreach {left right} [$w cget -selection] break if {$left == $right} { set timestr [$w formatTime $time] } else { set timestr \ "from [$w formatTime $left] to [$w formatTime $right] length [$w formatTime [expr {$right-$left}]], [$w formatTime $time]" } if {$v(drawWaveform)} { set start [expr {int($time*[$s cget -rate])}] set end [expr {$start+int([$s cget -rate]/[$w cget -pixelspersecond])}] if {$start >= [$s length]} return if {$end >= [$s length]} return if {$start < 0} { set start 0 } set maxamp [$s max -start $start -end $end -channel $v(channel)] set minamp [$s min -start $start -end $end -channel $v(channel)] $w messageProc [format "Waveform - %s \[%s %s\]" $timestr $maxamp $minamp] \ analysis } if {$v(drawSpectrogram)} { set start [expr {int($time * [$s cget -rate] - $v(fftlen)/2)}] if {$start < 0} return if {$start > [expr {[$s length] - $v(fftlen)}]} return set fft [$s dBPowerSpectrum -windowlength $v(winlen) \ -fftlen $v(fftlen) \ -windowtype $v(wintype) \ -preemph $v(preemph) -start $start \ -channel $v(channel)] set index [expr {int(0.5+$v(fftlen)*0.5*($value-1)/$v(topfr2))}] set db [lindex $fft $index] if {$db != ""} { $w messageProc \ [format "Spectrogram - %s %.0fHz %.2fdB" $timestr $value $db] analysis } regsub -all {\.} $pane _ widgetPath if {[winfo exists .sect$widgetPath]} [list drawSectMarks $w $pane f $value in] } if {$v(drawPitch)} { set i [expr {int($time*100 + .5)}] set pitch [lindex [lindex $v(pitchList) $i] 0] if {$pitch == ""} return if {$pitch < $v(scaleBase) || $v(showScale) == 0} { set note "" } else { for {set i 0} {$i < [llength $v(scale)]} {incr i} { if {$pitch < [lindex $v(scale) $i]} { break } } incr i -1 set notelist [list C1 D1 E1 F1 G1 A2 B2 C2 D2 E2 F2 G2 A3 B3 C3 D3 E3 F3 G3 A4 B4 C4] set note [lindex $notelist $i] } if {$left == $right} { $w messageProc \ [format "Pitch contour - %s %.0fHz %s" $timestr $pitch $note] analysis } else { set tmp [expr {1.0/($right-$left)}] $w messageProc \ [format "Pitch contour - %s %.0fHz %s (%.1f)" $timestr $pitch $note $tmp] \ analysis } } if {$v(drawPower)} { set i [expr {int($time*100 + .5)}] set power [lindex $v(powerList) $i] if {$power == ""} return $w messageProc [format "Power plot - %s %.2fdB" $timestr $power] analysis } foreach {left right} [$w cget -selection] {} if {$time == $right} { set v(boundary) right } else { set v(boundary) left } if {[winfo exists .blowup]} { set start [expr {int([$s cget -rate]*($time-$v(blowuptimewin)))}] set end [expr {int([$s cget -rate]*($time+$v(blowuptimewin)))}] if {$start < 0} { set start 0 } if {$end > [$s lastIndex]} { set end [$s lastIndex] } set maxamp [$s max -start $start -end $end -channel $v(channel)] set minamp [$s min -start $start -end $end -channel $v(channel)] set extreme [util::max $maxamp [expr -$minamp]] set limit [expr {int($extreme)}] .blowup.c itemconfigure waveform -start $start -end $end -limit $limit } } proc analysis::print {w pane c x y} { variable Info upvar [namespace current]::${pane}::var v set vc [$pane yaxis] set yw [winfo width $vc] set height [$pane cget -scrollheight] set width [$pane getCanvasX [$pane cget -maxtime]] set s [$w cget -sound] if {[string match {[0-9]} $v(channel)] && \ $v(channel) >= [$s cget -channels]} { set chan all } else { set chan $v(channel) } if {$v(drawWaveform)} { $c create rectangle [expr {$yw+$x}] $y [expr {$x + $yw + $width}] \ [expr {$y+$height}] -tags [list print tmpPrint] $c create rectangle $x $y [expr {$x + $yw + $width}] \ [expr {$y+$height}] -tags [list print tmpPrint] set start [expr {int($x/[$w cget -pixelspersecond]*[$s cget -rate])}] set end [expr {int(($x+1000)/[$w cget -pixelspersecond]*[$s cget -rate])}] $c create waveform [expr {$yw+$x}] $y -sound $s -fill $v(wavecolor) \ -channel $chan -tags [list print tmpPrint] \ -start $start -end $end \ -height $height -pixelspersecond [$w cget -pixelspersecond] $c create text $x $y -text $v(max) \ -font [$pane cget -yaxisfont] -anchor nw -tags [list axis max] \ -fill [$pane cget -yaxiscolor] set yh [$pane cget -scrollheight] $c create text $x [expr {$y+$height}] -text $v(min) \ -font [$pane cget -yaxisfont] -anchor sw -tags [list axis min] \ -fill [$pane cget -yaxiscolor] } if {$v(drawSpectrogram)} { set brightness [[$pane canvas] itemcget spectrogram -brightness] set contrast [[$pane canvas] itemcget spectrogram -contrast] set start [expr {int($x/[$w cget -pixelspersecond]*[$s cget -rate])}] set end [expr {int(($x+1000)/[$w cget -pixelspersecond]*[$s cget -rate])}] $c create spectrogram [expr {$yw+$x}] $y -sound $s -channel $chan \ -start $start -end $end \ -tags [list print tmpPrint speg] -height $height\ -fftlen $v(fftlen) -winlen $v(winlen)\ -windowtype $v(wintype) \ -colormap $v($v(cmap)) \ -gridtspacing $v(gridtspacing) \ -gridfspacing $v(gridfspacing) \ -gridcolor $v(gridColor) \ -preemph $v(preemph) \ -brightness $brightness \ -contrast $contrast \ -pixelspersecond [$w cget -pixelspersecond] \ -topfr $v(topfr2) -debug $Info(debug) $c create line [expr {$yw+$x}] $y \ [expr {$x + $yw + $width}] $y \ [expr {$x + $yw + $width}] [expr {$y+$height}] \ [expr {$yw+$x}] [expr {$y+$height}] \ [expr {$yw+$x}] $y -tags [list print tmpPrint] $c lower speg } } # ----------------------------------------------------------------------------- proc analysis::propertyPane {w pane} { if {$pane==""} return upvar [namespace current]::${pane}::var v set ret {} if {$v(drawWaveform)} { lappend ret [::util::mc "Waveform"] [namespace code drawWaveformPage] } if {$v(drawSpectrogram)} { lappend ret [::util::mc "Spectrogram"] [namespace code drawSpectrogramPage] } if {$v(drawPitch)} { lappend ret [::util::mc "Pitch contour"] [namespace code drawPitchPage] } if {$v(drawPower)} { lappend ret [::util::mc "Power plot"] [namespace code drawPowerPage] } if {$v(drawFormants)} { lappend ret [::util::mc "Formants"] [namespace code drawFormantsPage] } return $ret } proc analysis::applyProperties {w pane} { if {[string match *wavebar $pane]} return upvar [namespace current]::${pane}::var v if {[info exists v(drawSpectrogram)]} { if {$v(drawSpectrogram)} { bw2pts $w $pane bw2ptsLeave $w $pane foreach var [list fftlen anabw winlen wintype preemph topfr \ brightness contrast \ gridfspacing gridtspacing gridColor cmap channel preDraw] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } foreach var [list rtpps] { set v($var) $v(t,$var) } foreach var [list topfr] { if {0.5*[[$w cget -sound] cget -rate] < $v(topfr) || $v(topfr) == -1} { set v(t,$var) [expr {0.5*[[$w cget -sound] cget -rate]}] } set v(topfr2) $v(t,$var) } if {[info exists doRedraw]} { $w _redrawPane $pane } if {[string compare $v(t,layer) $v(layer)] != 0} { set v(layer) $v(t,layer) $pane configure -layer $v(t,layer) } } } if {[info exists v(drawWaveform)]} { if {$v(drawWaveform)} { foreach var [list wavecolor channel limit subsample trimstart preDraw] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } foreach var [list rtpps] { set v($var) $v(t,$var) } if {[info exists doRedraw]} { $w _redrawPane $pane } } } if {[info exists v(drawPitch)]} { if {$v(drawPitch)} { foreach var [list maxPitch minPitch method frameInterval pwinlen] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set v(computePitch) 1 set doRedraw 1 } } foreach var [list showScale scaleBase scaleColor] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } foreach var [list pitchPreview rtpps exportHeader] { set v($var) $v(t,$var) } if {[info exists doRedraw]} { $w _redrawPane $pane } } } if {[info exists v(drawPower)]} { if {$v(drawPower)} { foreach var [list ewinlen ewintype epreemph frameInterval channel] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set v(computePower) 1 set doRedraw 1 } } foreach var [list maxPower minPower] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } foreach var [list exportHeader] { set v($var) $v(t,$var) } if {[info exists doRedraw]} { $w _redrawPane $pane } } } if {[info exists v(drawFormants)]} { if {$v(drawFormants)} { foreach var [list fwinlen fwintype fpreemph numformants \ frameInterval lpcorder lpctype dsfreq nomf1freq] { if {[string match fwinlen $var]} { upvar wsurf::dataplot::${pane}::var t set t(offset) [expr {$v(t,fwinlen)/2}] } if {[string match numformants $var] && \ [string compare $v(t,$var) $v($var)] != 0} { upvar wsurf::dataplot::${pane}::var t set t(styleList) [lrange [list 0 red Line 1 green Line 2 blue Line 3 yellow Line 4 black Line 5 magenta Line 6 cyan Line] 0 [expr 3*($v(t,numformants))-1]] } if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set v(computeFormants) 1 set doRedraw 1 } } foreach var [list exportHeader] { set v($var) $v(t,$var) } if {[info exists doRedraw]} { $w _redrawPane $pane } } } } proc analysis::drawWaveformPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(WaveformOptionTable) { set v(t,$key) $v($key) } colorPropItem $p.f1 "Waveform color:" 18 \ [namespace current]::${pane}::var(t,wavecolor) stringPropItem $p.f2 "Show channel:" 18 6 \ "(0,1,2,...,left,right,all)" [namespace current]::${pane}::var(t,channel) if {[string match Lin24* [[$w cget -sound] cget -encoding]]} { set max 8388608 } else { set max 32768 } pack [ttk::frame $p.f3] -anchor w -ipady 2 ttk::checkbutton $p.f3.r -text "Auto-scale waveform" -onvalue -1 \ -offvalue $max \ -variable [namespace current]::${pane}::var(t,limit) ttk::label $p.f3.l -text "Value at top:" ttk::entry $p.f3.e -textvar [namespace current]::${pane}::var(t,limit) \ -width 8 ttk::button $p.f3.b -text Control... \ -command [namespace code [list waControls $w $pane]] pack $p.f3.r $p.f3.l $p.f3.e $p.f3.b -side left -padx 3 booleanPropItem $p.f4 "Sub-sample waveform at low resolution" "" \ [namespace current]::${pane}::var(t,subsample) booleanPropItem $p.f5 "Trim waveform endpoints to integer pixels" "" \ [namespace current]::${pane}::var(t,trimstart) stringPropItem $p.f6 "Record scroll speed:" 18 6 \ "pixels/second" [namespace current]::${pane}::var(t,rtpps) booleanPropItem $p.f7 "Pre-draw graphics" "" \ [namespace current]::${pane}::var(t,preDraw) } proc analysis::drawSpectrogramPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(SpectrogramOptionTable) { set v(t,$key) $v($key) } foreach var [list anabw] { set v(t,$var) $v($var) } stringPropItem $p.f1 "FFT window length:" 21 6 \ "points" [namespace current]::${pane}::var(t,fftlen) pack [ttk::frame $p.f2] -anchor w -ipady 2 ttk::label $p.f2.l -text "Analysis window type:" -width 21 -anchor w ttk::combobox $p.f2.cm -textvariable [namespace current]::${pane}::var(t,wintype) -values [list Hamming Hanning Bartlett Blackman Rectangle] -state readonly pack $p.f2.l $p.f2.cm -side left -padx 3 pack [ttk::frame $p.f3] -anchor w -ipady 2 ttk::label $p.f3.l -text "Analysis bandwidth:" -width 21 -anchor w ttk::entry $p.f3.e -textvar [namespace current]::${pane}::var(t,anabw) -wi 6 ttk::label $p.f3.l2 -text "Hz" -anchor w ttk::label $p.f3.l3 -text " Window:" -anchor w ttk::entry $p.f3.e2 -textvar [namespace current]::${pane}::var(t,winlen) -wi 6 ttk::label $p.f3.l4 -text "points" -anchor w pack $p.f3.l $p.f3.e $p.f3.l2 $p.f3.l3 $p.f3.e2 $p.f3.l4 -side left -padx 3 bind $p.f3.e [namespace code [list bw2pts $w $pane]] bind $p.f3.e2 [namespace code [list pts2bw $w $pane]] bind $p.f3.e [namespace code [list bw2ptsLeave $w $pane]] bind $p.f3.e2 [namespace code [list pts2bwLeave $w $pane]] stringPropItem $p.f4 "Pre-emphasis factor:" 21 6 \ "" [namespace current]::${pane}::var(t,preemph) stringPropItem $p.f5 "Cut spectrogram at:" 21 6 \ "Hz" [namespace current]::${pane}::var(t,topfr) pack [ttk::frame $p.f6] -anchor w -ipady 2 pack [ttk::label $p.f6.l -text "Brightness:" -width 21 -anchor w] -sid left -padx 3 pack [ttk::entry $p.f6.e -textvar [namespace current]::${pane}::var(t,brightness)\ -wi 6] -side left -padx 3 pack [ttk::scale $p.f6.s \ -variable [namespace current]::${pane}::var(t,brightness) \ -orient horiz -from -100 -to 100] -side left $p.f6.s set $v(t,brightness) pack [ttk::button $p.f6.b -text Controls... \ -command [namespace code [list bcControls $w $pane]]] -side left pack [ttk::frame $p.f7] -anchor w -ipady 2 pack [ttk::label $p.f7.l -text "Contrast:" -width 21 -anchor w] -side left -padx 3 pack [ttk::entry $p.f7.e -textvar [namespace current]::${pane}::var(t,contrast) \ -wi 6] -side left -padx 3 pack [ttk::scale $p.f7.s -variable [namespace current]::${pane}::var(t,contrast) \ -orient horiz -from -100 -to 100] $p.f7.s set $v(t,contrast) stringPropItem $p.f8 "Grid frequency spacing:" 21 6 \ "Hz" [namespace current]::${pane}::var(t,gridfspacing) stringPropItem $p.f9 "Grid time spacing:" 21 6 \ "s" [namespace current]::${pane}::var(t,gridtspacing) colorPropItem $p.f10 "Grid color:" 21 \ [namespace current]::${pane}::var(t,gridColor) pack [ttk::frame $p.f11] -anchor w -ipady 2 ttk::label $p.f11.l -text "Spectrogram color:" -width 21 -anchor w ttk::combobox $p.f11.cm -textvariable [namespace current]::${pane}::var(t,cmap) -values [list grey color color2] -state readonly pack $p.f11.l $p.f11.cm -side left -padx 3 stringPropItem $p.f12 "Record scroll speed:" 21 6 \ "pixels/second" [namespace current]::${pane}::var(t,rtpps) stringPropItem $p.f13 "Show channel:" 21 6 \ "(0,1,2,...,left,right,all)" [namespace current]::${pane}::var(t,channel) pack [ttk::frame $p.f14] -anchor w -ipady 2 ttk::checkbutton $p.f14.r -text "Draw stippled selection" -onvalue top \ -offvalue bottom -variable [namespace current]::${pane}::var(t,layer) pack $p.f14.r -side left -padx 3 booleanPropItem $p.f15 "Pre-draw graphics" "" \ [namespace current]::${pane}::var(t,preDraw) } proc analysis::drawPitchPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(PitchOptionTable) { set v(t,$key) $v($key) } pack [ttk::frame $p.f1] -anchor w -ipady 2 ttk::label $p.f1.l -text "Pitch method:" -width 21 ttk::combobox $p.f1.cm -textvariable [namespace current]::${pane}::var(t,method) -values [list ESPS AMDF] -state readonly pack $p.f1.l $p.f1.cm -side left -padx 3 stringPropItem $p.f2 "Max pitch value:" 23 6 \ "Hz" [namespace current]::${pane}::var(t,maxPitch) stringPropItem $p.f3 "Min pitch value:" 23 6 \ "Hz" [namespace current]::${pane}::var(t,minPitch) stringPropItem $p.f31 "Analysis window length:" 23 6 \ "s" [namespace current]::${pane}::var(t,pwinlen) stringPropItem $p.f32 "Frame interval:" 23 6 \ "s" [namespace current]::${pane}::var(t,frameInterval) pack [ttk::frame $p.f4] -anchor w -ipady 2 ttk::checkbutton $p.f4.r -text "Show background note scale" \ -variable [namespace current]::${pane}::var(t,showScale) ttk::label $p.f4.l -text "Tuning (C1):" -anchor w ttk::entry $p.f4.e -textvar [namespace current]::${pane}::var(t,scaleBase) -wi 7 ttk::label $p.f4.l2 -text "Hz" -anchor w pack $p.f4.r $p.f4.l $p.f4.e $p.f4.l2 -side left -padx 3 colorPropItem $p.f5 "Scale color:" 21 \ [namespace current]::${pane}::var(t,scaleColor) booleanPropItem $p.f6 "Pitch preview during record" "" \ [namespace current]::${pane}::var(t,pitchPreview) stringPropItem $p.f7 "Record scroll speed:" 23 6 \ "pixels/second" [namespace current]::${pane}::var(t,rtpps) booleanPropItem $p.f8 "Add header in export file" "" \ [namespace current]::${pane}::var(t,exportHeader) } proc analysis::drawPowerPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(PowerOptionTable) { set v(t,$key) $v($key) } stringPropItem $p.f3 "Analysis window length:" 23 6 \ "points" [namespace current]::${pane}::var(t,ewinlen) pack [ttk::frame $p.f4] -anchor w -ipady 2 ttk::label $p.f4.l -text "Analysis window type:" -width 23 -anchor w ttk::combobox $p.f4.cm -textvariable [namespace current]::${pane}::var(t,ewintype) -values [list Hamming Hanning Bartlett Blackman Rectangle] -state readonly pack $p.f4.l $p.f4.cm -side left -padx 3 stringPropItem $p.f5 "Pre-emphasis factor:" 23 6 \ "" [namespace current]::${pane}::var(t,epreemph) stringPropItem $p.f6 "Frame interval:" 23 6 \ "s" [namespace current]::${pane}::var(t,frameInterval) stringPropItem $p.f7 "Show channel:" 23 6 \ "(0,1,2,...,left,right,all)" [namespace current]::${pane}::var(t,channel) stringPropItem $p.f8 "Max power value:" 23 6 \ "dB" [namespace current]::${pane}::var(t,maxPower) stringPropItem $p.f9 "Min power value:" 23 6 \ "dB" [namespace current]::${pane}::var(t,minPower) booleanPropItem $p.f10 "Add header in export file" "" \ [namespace current]::${pane}::var(t,exportHeader) } proc analysis::drawFormantsPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(FormantsOptionTable) { set v(t,$key) $v($key) } stringPropItem $p.f1 "Number of formants:" 23 6 \ "" [namespace current]::${pane}::var(t,numformants) stringPropItem $p.f3 "Analysis window length:" 23 6 \ "s" [namespace current]::${pane}::var(t,fwinlen) pack [ttk::frame $p.f4] -anchor w -ipady 2 ttk::label $p.f4.l -text "Analysis window type:" -width 23 -anchor w ttk::combobox $p.f4.cm -textvariable [namespace current]::${pane}::var(t,fwintype) -values [list Rectangular Hamming Cos^4 Hanning] -state readonly pack $p.f4.l $p.f4.cm -side left -padx 3 stringPropItem $p.f5 "Pre-emphasis factor:" 23 6 \ "" [namespace current]::${pane}::var(t,fpreemph) stringPropItem $p.f6 "Frame interval:" 23 6 \ "s" [namespace current]::${pane}::var(t,frameInterval) stringPropItem $p.f7 "LPC order:" 23 6 \ "" [namespace current]::${pane}::var(t,lpcorder) stringPropItem $p.f8 "LPC type:" 23 6 \ "" [namespace current]::${pane}::var(t,lpctype) stringPropItem $p.f9 "Down-sampling frequency:" 23 6 \ "Hz" [namespace current]::${pane}::var(t,dsfreq) stringPropItem $p.f11 "Nominal F1 frequency:" 23 6 \ "Hz" [namespace current]::${pane}::var(t,nomf1freq) booleanPropItem $p.f10 "Add header in export file" "" \ [namespace current]::${pane}::var(t,exportHeader) } proc analysis::getConfiguration {w pane} { variable Info if {$pane==""} { return {} } upvar [namespace current]::${pane}::var v set result {} if {$v(drawWaveform)} { append result "\$widget analysis::addWaveform \$pane" foreach {option key default} $Info(WaveformOptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } if {$v(drawSpectrogram)} { append result "\$widget analysis::addSpectrogram \$pane" foreach {option key default} $Info(SpectrogramOptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } if {$v(drawPitch)} { append result "\$widget analysis::addPitch \$pane" foreach {option key default} $Info(PitchOptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } if {$v(drawPower)} { append result "\$widget analysis::addPower \$pane" foreach {option key default} $Info(PowerOptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } if {$v(drawFormants)} { append result "\$widget analysis::addFormants \$pane" foreach {option key default} $Info(FormantsOptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } if {$v(drawSection)} { set var [namespace current]::\${pane}::var append result "set ${var}(sectwinw) $v(sectwinw)" "\n" append result "set ${var}(sectwinh) $v(sectwinh)" "\n" append result "set ${var}(sectwinx) $v(sectwinx)" "\n" append result "set ${var}(sectwiny) $v(sectwiny)" "\n" append result "\$widget analysis::openSectWindow \$pane" "\n" } if {[winfo exists .blowup]} { set var [namespace current]::\${pane}::var append result "set ${var}(blowupwinw) $v(blowupwinw)" "\n" append result "set ${var}(blowupwinh) $v(blowupwinh)" "\n" append result "set ${var}(blowupwinx) $v(blowupwinx)" "\n" append result "set ${var}(blowupwiny) $v(blowupwiny)" "\n" append result "set ${var}(blowuptimewin) $v(blowuptimewin)" "\n" append result "\$widget analysis::openBlowUpWindow \$pane" "\n" } regsub -all {\.} $pane _ widgetPath if {[winfo exists .cbctrl$widgetPath]} { append result "analysis::bcControls \$widget \$pane" "\n" } return $result } proc analysis::soundChanged {w flag} { set s [$w cget -sound] foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawWaveform) || $v(drawSpectrogram)} { if {[$s cget -channels] > 1} { set v(max) [$s max -channel $v(channel)] set v(min) [$s min -channel $v(channel)] } else { set v(max) [$s max] set v(min) [$s min] } if {0.5*[$s cget -rate] < $v(topfr) || $v(topfr) == -1} { set v(topfr2) [expr {0.5*[$s cget -rate]}] } else { set v(topfr2) $v(topfr) } # if the sound object has changed due to a $w configure -sound if {$v(sound) != $s} { set c [$pane canvas] $c itemconfigure waveform -sound $s $c itemconfigure spectrogram -sound $s } $w _redrawPane $pane } if {$v(drawPitch)} { after cancel [namespace code [list _updateRecord $w]] update _computePitch $w $pane wsurf::dataplot::processData $w $pane $v(pitchList) $v(frameInterval) "" pitch _drawPitch $w $pane } if {$v(drawPower)} { update _computePower $w $pane wsurf::dataplot::processData $w $pane $v(powerList) \ $v(frameInterval) "" power } if {$v(drawFormants)} { update _computeFormants $w $pane wsurf::dataplot::processData $w $pane $v(formantList) \ $v(frameInterval) "" formants } } } # ----------------------------------------------------------------------------- proc analysis::play {w} { after 200 [namespace code [list _updatePlay $w]] } proc analysis::_updatePlay {w} { if {[winfo exists $w] == 0} return set s [$w cget -sound] foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawSection)} { drawSect $w $pane } } if {[$w getInfo isPlaying]} { after 50 [namespace code [list _updatePlay $w]] } } proc analysis::record {w} { $w xscroll moveto 0.0 foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v set c [$pane canvas] if {[info exists v(drawWaveform)]} { if {$v(drawWaveform)} { $c itemconfigure waveform -width [winfo width $c] \ -pixelspersecond $v(rtpps) -end -1 } } if {[info exists v(drawSpectrogram)]} { if {$v(drawSpectrogram)} { $c itemconfigure spectrogram -width [winfo width $c] \ -pixelspersecond $v(rtpps) -end -1 } $c delete dataplot } if {$v(drawPitch) && $v(pitchPreview)} { set v(samplePos) 0 set v(ox) 0 set v(oy) 0 $c delete dataplot set s [$w cget -sound] sound _pitchTmp -rate [$s cget -rate] } } $w configure -selection [list 0 0] after 200 [namespace code [list _updateRecord $w]] } proc analysis::_updateRecord {w} { if {[winfo exists $w] == 0} return set s [$w cget -sound] $w messageProc "Recorded: [format "%.1f" [$s length -unit seconds]]s" analysis foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawWaveform)} { if {[$w getInfo isLinked2File]} { set v(max) [$s max] set v(min) [$s min] } else { set v(max) [$s max -channel $v(channel)] set v(min) [$s min -channel $v(channel)] } set yc [$pane yaxis] $yc itemconfigure max -text $v(max) $yc itemconfigure min -text $v(min) } if {$v(drawPitch) && $v(pitchPreview)} { set length [$s length] set c [$pane canvas] set chunkSize [expr {int(400 + 2.5 * [$s cget -rate] / $v(minPitch))}] while {$v(samplePos) < $length - $chunkSize} { _pitchTmp copy $s -start $v(samplePos) \ -end [expr {$v(samplePos) + $chunkSize - 1}] set pitch [lindex [_pitchTmp pitch -minpitch $v(minPitch) \ -maxpitch $v(maxPitch)] 2] if {$pitch == ""} { set pitch 0.0 } $c move pitch [expr -0.01 * $v(rtpps)] 0 set x [expr {$v(ox) + 0.01 * $v(rtpps)}] set x [winfo width $c] set y [expr {[winfo height $c]*(($v(maxPitch)-$pitch)/$v(maxPitch))}] if {$v(oy) == 0} { set v(oy) $y } if {$pitch > 0.0 && abs($v(oy)-$y) < 10} { $c create oval [expr {$x-1}] [expr {$y-1}] \ [expr {$x+1}] [expr {$y+1}] -tags [list analysis pitch dataplot] \ -outline black } incr v(samplePos) 160 set v(ox) $x set v(oy) $y } } } # set progressproc [$w cget -progressproc] # if {$progressproc != ""} { # $progressproc "Play" 0.9 # } update idletasks if {[$w getInfo isRecording]} { after 50 [namespace code [list _updateRecord $w]] } } # ----------------------------------------------------------------------------- # Plug-in internal stuff proc analysis::bcControls {w pane} { upvar [namespace current]::${pane}::var v if $v(preDraw) { tk_messageBox -message "This function is not available in pre-draw mode." } regsub -all {\.} $pane _ widgetPath catch {destroy .cbctrl$widgetPath} set p [toplevel .cbctrl$widgetPath] wm title $p "Image Controls" set c [$pane canvas] pack [ttk::frame $p.f] -fill both -expand true pack [ttk::label $p.f.lc -text Contrast] -side left pack [canvas $p.f.c -width 100 -height 100 -bd 1 -relief raised] pack [ttk::label $p.f.lb -text Brightness] if {[info exists v(t,brightness)] == 0} { set v(t,brightness) $v(brightness) } if {[info exists v(t,contrast)] == 0} { set v(t,contrast) $v(contrast) } if {[info exists v(t,fftlen)] == 0} { set v(t,fftlen) $v(fftlen) } if {[info exists v(t,winlen)] == 0} { set v(t,winlen) $v(winlen) } set x [expr 0.5 * (100.0 + $v(t,brightness))] set y [expr -0.5 * ($v(t,contrast) - 100.0)] $p.f.c create rectangle [expr $x-3.0] [expr $y-3.0] \ [expr $x+3.0] [expr $y+3.0] -fill black bind $p.f.c <1> [namespace code [list initDrag $w $pane $p.f.c %x %y]] bind $p.f.c [namespace code [list Drag $w $pane $p.f.c %x %y]] pack [ttk::label $p.f.l -text "Analysis window length:"] -expand true -fill x pack [ttk::scale $p.f.s -orient horiz \ -variable [namespace current]::${pane}::var(t,winlen) \ -from 32 -to $v(t,fftlen) \ -command [namespace code [list setAnaWinLen $pane $c]]] -expand true -fill x $p.f.s set $v(t,winlen) } proc analysis::setAnaWinLen {pane c args} { upvar [namespace current]::${pane}::var v set v(t,winlen) [expr int($args)] $c itemconfigure spectrogram -winlength [expr int($args)] } proc analysis::waControls {w pane} { upvar [namespace current]::${pane}::var v regsub -all {\.} $pane _ widgetPath catch {destroy .wactrl$widgetPath} set p [toplevel .wactrl$widgetPath] wm title $p "Waveform Amplitude Zoom" if {[string match Lin24* [[$w cget -sound] cget -encoding]]} { set max 8388608 } else { set max 32768 } if {[info exists v(t,limit)] == 0} { set v(t,limit) $v(limit) } if {$v(t,limit) == -1} { set v(t,limit) $max } pack [ttk::scale $p.s -variable [namespace current]::${pane}::var(t,limit) \ -from 1 -to $max -length 150 -orient horizontal \ -command [namespace code [list waZoom $w $pane]]] -expand 1 -fill x $p.s set $v(t,limit) focus $p.s pack [ttk::entry $p.e -textvariable [namespace current]::${pane}::var(t,limit) \ -width 8] bind $p.e [namespace code [list waZoom $w $pane]] } proc analysis::waZoom {w pane args} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set $v(t,limit) [expr int($v(t,limit))] $c itemconfigure waveform -limit $v(t,limit) set yc [$pane yaxis] $yc itemconfigure max -text $v(t,limit) $yc itemconfigure min -text [expr -1*$v(t,limit)] if {[winfo exists .blowup]} { .blowup.c itemconfigure waveform -limit $v(t,limit) } } proc analysis::bw2pts {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set rate [$s cget -rate] catch { set v(t,winlen) [expr {int($rate / $v(t,anabw))}] } if {$v(t,winlen) < 1} { set v(t,winlen) 1 } if {$v(t,winlen) > $v(t,fftlen)} { set v(t,winlen) $v(t,fftlen) } } proc analysis::bw2ptsLeave {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set rate [$s cget -rate] set v(t,anabw) [expr {double($rate) / $v(t,winlen)}] } proc analysis::pts2bw {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set rate [$s cget -rate] catch { set v(t,anabw) [expr {double($rate) / $v(t,winlen)}] } } proc analysis::pts2bwLeave {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set rate [$s cget -rate] if {$v(t,winlen) < 1} { set v(t,winlen) 1 } if {$v(t,winlen) > $v(t,fftlen)} { set v(t,winlen) $v(t,fftlen) } catch { set v(t,anabw) [expr {double($rate) /$v(t,winlen)}] } } proc analysis::initDrag {w pane cc x y} { upvar [namespace current]::${pane}::var v set v(ox) [$cc canvasx $x] set v(oy) [$cc canvasy $y] } proc analysis::Drag {w pane cc x y} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set x [$cc canvasx $x] set y [$cc canvasy $y] if {$x < 0} { set x 0} if {$y < 0} { set y 0} if {$x > 100} { set x 100} if {$y > 100} { set y 100} $cc move current [expr $x - $v(ox)] [expr $y - $v(oy)] set v(ox) $x set v(oy) $y set v(t,brightness) [expr 2*$x-100.0] set v(t,contrast) [expr 100.0-2*$y] $c itemconfigure spectrogram \ -brightness $v(t,brightness) \ -contrast $v(t,contrast) } proc analysis::openSectWindowLTAS {w pane} { SelectAll openSectWindow $w $pane } proc analysis::openSectWindow {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] regsub -all {\.} $pane _ widgetPath catch {destroy .sect$widgetPath} set e [toplevel .sect$widgetPath -width $v(sectwinw) \ -height $v(sectwinh)] wm geometry .sect$widgetPath +$v(sectwinx)+$v(sectwiny) wm title $e "Spectrum Section Plot: [file tail [$w getInfo fileName]]" if {$::tcl_platform(platform) == "windows"} { wm attributes $e -topmost 1 } pack propagate $e 0 set v(sectTopLevel) $e set v(drawSection) 1 foreach {left right} [$w cget -selection] break if {$left == $right} { set v(sall) 0 } else { set v(sall) 1 } pack [ttk::frame $e.f] -side bottom -fill x label $e.f.lab -width 1 -relief sunken -bd 1 pack $e.f.lab -side left -expand yes -fill x # pack [button $e.f.exitB -text Close -command [list destroy $e]] -side left pack [ttk::frame $e.f1] -fill x ttk::label $e.f1.l1 -text "Analysis:" ttk::combobox $e.f1.m1 -textvariable [namespace current]::${pane}::var(satype) -values [list FFT LPC] -state readonly bind $e.f1.m1 <> [namespace code [list drawSect $w $pane]] # for {set n 0} {$n < 2} {incr n} { # $e.f1.m1.menu entryconfigure $n \ # -command [namespace code [list drawSect $w $pane]] # } ttk::label $e.f1.l2 -text "Order:" ttk::entry $e.f1.e -width 3 \ -textvariable [namespace current]::${pane}::var(slpcorder) set v(slpcorder2) $v(slpcorder) ttk::scale $e.f1.s -variable [namespace current]::${pane}::var(slpcorder2) \ -from 1 -to 40 -orient horiz -length 80 \ -command [namespace code [list setVar $w $pane slpcorder slpcorder2]] $e.f1.s set $v(slpcorder) bind $e.f1.s [namespace code [list drawSect $w $pane]] pack $e.f1.l1 $e.f1.m1 -side left pack [ttk::separator $e.f1.s1 -orient vertical] -side left -fill y -padx 10 pack $e.f1.l2 $e.f1.e $e.f1.s -side left pack [ttk::frame $e.f2] -anchor w -fill x ttk::label $e.f2.l1 -text "Window:" ttk::combobox $e.f2.m1 -textvariable [namespace current]::${pane}::var(swintype) -values [list Hamming Hanning Bartlett Blackman Rectangle] -state readonly bind $e.f2.l1 <> [namespace code [list drawSect $w $pane]] # for {set n 0} {$n < 5} {incr n} { # $e.f2.m1.menu entryconfigure $n \ # -command [namespace code [list drawSect $w $pane]] # } ttk::label $e.f2.l2 -text "FFT points:" -anchor w ttk::combobox $e.f2.m2 -textvariable [namespace current]::${pane}::var(sfftlen) -values [list 64 128 256 512 1024 2048 4096 8192 16384 32768 65536] -state readonly bind $e.f2.m2 <> [namespace code [list drawSect $w $pane]] # for {set n 0} {$n < 11} {incr n} { # $e.f2.m2.menu entryconfigure $n \ # -command [namespace code [list drawSect $w $pane]] # } pack $e.f2.l1 $e.f2.m1 -side left pack [ttk::separator $e.f2.s1 -orient vertical] -side left -fill y -padx 10 pack $e.f2.l2 $e.f2.m2 -side left pack [ttk::frame $e.f3] -fill x pack [ttk::label $e.f3.l1 -text "Reference:" -anchor w] -side left pack [ttk::entry $e.f3.e1 -textvar [namespace current]::${pane}::var(sref) \ -wi 6] -side left pack [ttk::label $e.f3.u1 -text "dB" -anchor w] -side left pack [ttk::separator $e.f3.s1 -orient vertical] -side left -fill y -padx 10 pack [ttk::label $e.f3.l2 -text "Range:" -anchor w] -side left pack [ttk::entry $e.f3.e2 -textvar [namespace current]::${pane}::var(srange) \ -wi 5] -side left pack [ttk::label $e.f3.u2 -text "dBfs" -anchor w] -side left pack [ttk::separator $e.f3.s2 -orient vertical] -side left -fill y -padx 10 pack [ttk::label $e.f3.l3 -text "Pre-emphasis:" -anchor w] -side left pack [ttk::entry $e.f3.e3 -textvar [namespace current]::${pane}::var(spreemph) \ -wi 6] -side left pack [ttk::frame $e.f4] -fill x pack [ttk::checkbutton $e.f4.cb -text "Average of selection" \ -variable [namespace current]::${pane}::var(sall) \ -command [namespace code [list drawSect $w $pane]]] -side left # pack [button $e.f4.lockB -text Lock -command [namespace code [list lockSection $w $pane]]] -side left pack [ttk::separator $e.f4.s1 -orient vertical] -side left -fill y -padx 10 ttk::menubutton $e.f4.mb -text "Snapshot" -menu $e.f4.mb.m menu $e.f4.mb.m -tearoff 0 # label $e.f4.l1 -text "Snapshot:" set titles "" foreach q $::wsurf::Info(widgets) { lappend titles [$q cget -title] } lappend titles Clear # pack $e.f4.l1 $e.f4.snap -side left for {set n 0} {$n <= [llength $::wsurf::Info(widgets)]} {incr n} { set label [lindex $titles $n] set widget [lindex $::wsurf::Info(widgets) $n] $e.f4.mb.m add command -label $label \ -command [namespace code [list lockSection $w $pane $widget]] # $e.f4.snap.menu entryconfigure $n \ # -command [namespace code [list lockSection $w $pane $widget]] } pack $e.f4.mb -side left pack [ttk::separator $e.f4.s2 -orient vertical] -side left -fill y -padx 10 pack [ttk::checkbutton $e.f4.cb2 -text "Add file header" \ -variable [namespace current]::${pane}::var(sexphead)] -side left pack [ttk::separator $e.f4.s3 -orient vertical] -side left -fill y -padx 10 pack [ttk::button $e.f4.exportB -text Export... -command [namespace code [list exportSpectrum $w $pane]]] -side left pack [canvas $e.c -closeenough 5 -cursor draft_small -height 20] -fill both \ -before $e.f1 -expand true update idletasks drawSect $w $pane bind $e [namespace code [list drawSect $w $pane]] bind $e [namespace code [list drawSect $w $pane]] bind $e.c [namespace code [list drawSectCursor $w $pane %x %y up]] bind $e.c [namespace code [list drawSectCursor $w $pane %x %y down]] bind $e.c [namespace code [list drawSectMarks $w $pane %x %y in]] bind $e.c [namespace code [list drawSectMarks $w $pane %x %y out]] bind $e [namespace code [list set v(drawSection) 0]] bind $pane [namespace code [list raiseWindow $w $pane section]] if {[string match macintosh $::tcl_platform(platform)] || \ [string match Darwin $::tcl_platform(os)]} { bind $e.c \ [namespace code [list popupMenu $e %X %Y $w]] } else { bind $e.c \ [namespace code [list popupMenu $e %X %Y $w]] } $e.f.lab config -text "Use popup menu to copy data values" } proc analysis::openBlowUpWindow {w pane} { upvar [namespace current]::${pane}::var v regsub -all {\.} $w _ widgetPath catch {destroy .blowup} set e [toplevel .blowup -width $v(blowupwinw) \ -height $v(blowupwinh)] wm geometry .blowup +$v(blowupwinx)+$v(blowupwiny) wm title $e "Waveform Blow-up: [file tail [$w getInfo fileName]]" if {$::tcl_platform(platform) == "windows"} { wm attributes $e -topmost 1 } set v(blowUpParent) $w pack [ttk::label $e.l -text "Adjust selection with arrow-keys"] \ -fill x pack [canvas $e.c -height 100] -expand 1 -fill both pack [ttk::frame $e.f] -anchor w -fill x ttk::label $e.f.l -text [::util::mc "Time window:"] -anchor w ttk::entry $e.f.e \ -textvar [namespace current]::${pane}::var(blowuptimewin) -wi 10 ttk::label $e.f.l2 -text "s" -anchor w pack $e.f.l $e.f.e $e.f.l2 -side left -fill x -expand true pack propagate $e 0 set snd [$w cget -sound] set t [$pane cget -cursorpos] if {$t == ""} { set t 0.0 } $e.c create waveform 0 0 -height 200 -width 300 -sound $snd \ -start [expr {int([$snd cget -rate]*($t-$v(blowuptimewin)))}] \ -end [expr {int([$snd cget -rate]*($t+$v(blowuptimewin)))}] \ -tags waveform -channel $v(channel) $e.c create line 150 0 150 200 -fill [$w cget -cursorcolor] -tags cursor bind .[lindex [split $w .] 1] [namespace code [list adjustSelection $w $pane 1.0]] bind .[lindex [split $w .] 1] [namespace code [list adjustSelection $w $pane -1.0]] bind $e.c [namespace code [list adjustSelection $w $pane 0.0]] bind $pane [namespace code [list raiseWindow $w $pane blowup]] set v(boundary) right } proc analysis::adjustSelection {w pane dir} { upvar [namespace current]::${pane}::var v if {[info exists v(blowUpParent)] == 0} return if {[string match $v(blowUpParent) [wsurf::GetCurrent]] == 0} return foreach {left right} [$w cget -selection] {} set s [$w cget -sound] if {$v(boundary) == "right"} { set right [expr {$right+$dir/[$s cget -rate]}] set t $right } else { set left [expr {$left+$dir/[$s cget -rate]}] set t $left } $w configure -selection [list $left $right] regsub -all {\.} $w _ widgetPath if {[winfo exists .blowup]} { set geom [lindex [split [wm geometry .blowup] +] 0] set v(blowupwinw) [lindex [split $geom x] 0] set v(blowupwinh) [lindex [split $geom x] 1] set v(blowupwinx) [lindex [split [wm geometry .blowup] +] 1] set v(blowupwiny) [lindex [split [wm geometry .blowup] +] 2] set width [winfo width .blowup.c] set height [winfo height .blowup.c] .blowup.c itemconfigure waveform \ -start [expr {int([$s cget -rate]*($t-$v(blowuptimewin)))}] \ -end [expr {int([$s cget -rate]*($t+$v(blowuptimewin)))}] \ -width $width \ -height [winfo height .blowup.c] .blowup.c coords cursor [expr {$width/2}] 0 [expr {$width/2}] $height } } proc analysis::setVar {w pane v1 v2 args} { upvar [namespace current]::${pane}::var v set v($v1) [expr int($v($v2))] } proc analysis::raiseWindow {w pane window} { upvar [namespace current]::${pane}::var v if {[string match "Darwin" $::tcl_platform(os)]} return if {[string compare $window section] == 0} { regsub -all {\.} $pane _ widgetPath if {[winfo exists .sect$widgetPath]} { raise .sect$widgetPath [winfo toplevel $w] } } if {[string compare $window blowup] == 0} { if {[winfo exists .blowup]} { raise .blowup [winfo toplevel $w] } } } proc analysis::lockSection {w pane widget} { upvar [namespace current]::${pane}::var v regsub -all {\.} $pane _ widgetPath set e .sect$widgetPath set v(snapo) "" if {$widget == ""} { $e.c delete sectsnap } else { set snd [$widget cget -sound] foreach {left right} [$widget cget -selection] break set start [expr {int($left*[$snd cget -rate])}] if {$v(sall) && [string compare FFT $v(satype)] == 0} { set end [expr {int($right*[$snd cget -rate])}] set end [util::min $end [expr {[$snd length]-1}]] } else { set end [expr {int($left*[$snd cget -rate])}] } $e.c create section 25 0 -sound $snd \ -height $v(secth)\ -width $v(sectw) -maxval [expr 10.0*$v(top)] \ -minval [expr 10.0*$v(bot)] \ -start $start -end $end \ -tags sectsnap \ -fftlen $v(sfftlen) \ -winlen $v(sfftlen) \ -windowtype $v(swintype) \ -analysistype $v(satype) \ -lpcorder $v(slpcorder) \ -channel $v(channel) -fill red \ -topfr $v(topfr2) \ -preemph $v(spreemph) } } proc analysis::exportSpectrum {w pane} { upvar [namespace current]::${pane}::var v set snd [$w cget -sound] set ps [$snd dBPowerSpectrum -start $v(start) \ -end $v(end) -fftlen $v(sfftlen) \ -windowlen $v(sfftlen) -channel $v(channel) \ -windowtype $v(swintype) \ -analysistype $v(satype) \ -lpcorder $v(slpcorder) \ -preemph $v(spreemph)] set file [tk_getSaveFile -title "Export Spectral Data" -initialfile spectrum.txt] if {$file == ""} return if {[catch {open $file w} out]} { return $out } else { set df [expr {double([$snd cget -rate]) / $v(sfftlen)}] set freq [expr {$df / 2.0}] if {$v(sexphead)} { puts $out "File: [$w getInfo fileName]" puts $out "Analysis type: $v(satype)" if [string match LPC $v(satype)] { puts $out "Analysis order: $v(slpcorder)" } puts $out "Window type: $v(swintype)" puts $out "Window length: $v(sfftlen) points" puts $out "Channel: $v(channel)" puts $out "Pre-emphasis: $v(spreemph)" puts $out "Range: $v(start)-$v(end)" puts $out "--- End of header ---" } foreach e $ps { puts $out [format "%f\t%f" $freq $e] set freq [expr {$freq + $df}] } close $out } } proc analysis::drawSectCursor {w pane x y flag} { upvar [namespace current]::${pane}::var v if {[string match up $flag]} { set v(rx) $x set v(ry) $y set c $v(sectTopLevel).c $c coords relmark 0 0 0 0 $c coords df -10 -10 $c coords db -10 -10 } else { set v(rx) -1 } } proc analysis::drawSect {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawSection) == 0} return set snd [$w cget -sound] set e $v(sectTopLevel) if {[winfo exists $e]} { set geom [lindex [split [wm geometry $e] +] 0] set v(sectwinw) [lindex [split $geom x] 0] set v(sectwinh) [lindex [split $geom x] 1] set v(sectwinx) [lindex [split [wm geometry $e] +] 1] set v(sectwiny) [lindex [split [wm geometry $e] +] 2] set v(sectw) [expr {[winfo width $e.c] - 25}] set v(secth) [expr {[winfo height $e.c] - 20}] set v(sectcw) [winfo width $e.c] set v(sectch) [winfo height $e.c] if {[$w getInfo isPlaying]} { set left [$pane cget -cursorpos] set right [$pane cget -cursorpos] } else { foreach {left right} [$w cget -selection] break } if {$left == ""} return set v(start) [expr {int($left*[$snd cget -rate])}] if {$v(sall) && [string compare FFT $v(satype)] == 0} { set v(end) [expr {int($right*[$snd cget -rate])}] set v(end) [util::min $v(end) \ [expr {[$snd length]-1}]] } else { set v(end) [expr {int($left*[$snd cget -rate])}] } $e.c delete sect catch {set v(top) [expr int(($v(sref) + \ $v(srange)) / 10.0)]} catch {set v(bot) [expr int($v(sref) / 10.0 )]} if {[string is double $v(spreemph)] == 0 || $v(spreemph) == ""} { set v(spreemph) 0.0 } $e.c create section 25 0 -sound $snd -height $v(secth) \ -width $v(sectw) -maxval [expr 10.0*$v(top)] \ -minval [expr 10.0*$v(bot)] \ -start $v(start) -end $v(end) \ -tags sect -fftlen $v(sfftlen) \ -winlen $v(sfftlen) \ -windowtype $v(swintype) \ -analysistype $v(satype) \ -lpcorder $v(slpcorder) \ -channel $v(channel) -frame 1 \ -topfr $v(topfr2) \ -preemph $v(spreemph) $e.c create text -10 -10 -text df: -font [$pane cget -yaxisfont] \ -tags df -fill blue $e.c create text -10 -10 -text "0 db" -font [$pane cget -yaxisfont] \ -tags db -fill red set pps [expr {int(double($v(sectw))/($v(topfr2)/1000.0) + .5)}] snack::timeAxis $e.c 25 $v(secth) \ $v(sectw) 20 $pps -tags sect \ -font [$pane cget -yaxisfont] for {set i $v(top)} {$i > $v(bot)} {incr i -1} { set lab [expr 10 * $i] $e.c create text 0 [expr ($i - $v(top)) * $v(secth)/($v(bot) - $v(top))] \ -text $lab -tags sect -font [$pane cget -yaxisfont] -anchor w } $e.c create text 2 2 -text dB -font [$pane cget -yaxisfont] \ -tags sect -anchor nw $e.c create text [expr {$v(sectw)+25}] [expr {$v(secth)+20}] \ -text kHz -font [$pane cget -yaxisfont] -tags sect -anchor se regsub -all {\.} $pane _ widgetPath if [winfo exists .sect$widgetPath] { if {$v(satype) != "LPC"} { .sect$widgetPath.f1.e configure -state disabled } else { .sect$widgetPath.f1.e configure -state normal } } } } proc analysis::drawSectMarks {w pane x y flag} { upvar [namespace current]::${pane}::var v set snd [$w cget -sound] set e $v(sectTopLevel) if {[string match in $flag]} { if {[$e.c find withtag sm] == ""} { if {$::tcl_platform(platform) == "windows"} { $e.c create line 0 0 0 $v(sectch) -width 1 -tags [list sx sm] $e.c create line 0 0 $v(sectcw) 0 -width 1 -tags [list sy sm] $e.c create line 0 0 0 0 -width 1 -tags [list relmark] } else { $e.c create line 0 0 0 $v(sectch) -width 1 -stipple gray50 -tags [list sx sm] $e.c create line 0 0 $v(sectcw) 0 -width 1 -stipple gray50 -tags [list sy sm] $e.c create line 0 0 0 0 -width 1 -stipple gray50 -tags [list relmark relmarkux] -arrow both } } if {$x != "f"} { set xc [$e.c canvasx $x] set yc [$e.c canvasx $y] } else { set xc [expr {25+int($v(sectw) * $y / $v(topfr2))}] set yc [lindex [$e.c coords sy] 1] } set f [expr {int($v(topfr2) * ($xc-25) / $v(sectw))}] if {$f < 0} { set f 0 } if {$v(start) == -1 || [$snd length] == 0 || \ $v(start) >= [$snd length] - $v(sfftlen)} return set fft [$snd dBPowerSpectrum -start $v(start) \ -end $v(end) -windowlength $v(sfftlen) \ -fftlen $v(sfftlen) \ -windowtype $v(swintype) \ -analysistype $v(satype) \ -lpcorder $v(slpcorder) \ -preemph $v(spreemph) \ -channel $v(channel)] set index [expr {int($v(sfftlen)*(double($f)/[$snd cget -rate]))}] set db [lindex $fft $index] if {$db == ""} return set dbyc [expr {($db-10.0*$v(top))*$v(secth) \ / (10.0 * ($v(bot) - $v(top)))}] $e.c coords sx $xc 0 $xc $v(sectch) $e.c coords sy 0 $dbyc $v(sectcw) $dbyc set db [format "%.1f" $db] if {$v(rx) != -1} { set rx [$e.c canvasx $v(rx)] set ry [$e.c canvasy $v(ry)] $e.c coords relmark $rx $ry $xc $yc $e.c coords df [expr {$rx + ($xc-$rx)/2}] $ry $e.c coords db $rx [expr {$ry + ($yc-$ry)/2}] set df [expr {abs(int($v(topfr2) * ($rx - $xc)/ $v(sectw)))}] $e.c itemconfigure df -text "df: $df" set ddb [format "%.1f" [expr {-double($v(srange)) \ * ($ry - $yc) / $v(secth)}]] $e.c itemconfigure db -text "db: $ddb" } $e.f.lab config -text "Frequency: $f Hz, amplitude: $db dB" } else { $e.c coords sx -1 -1 -1 -1 $e.c coords sy -1 -1 -1 -1 } } proc analysis::popupMenu {e X Y w} { set m $e.popup if {[winfo exists $m]} {destroy $m} menu $m -tearoff 0 set text [$e.f.lab cget -text] foreach {left right} [$w cget -selection] break append text ", time: $left s\n" $m add command -label [::util::mc "Append point"] \ -command [list clipboard append $text] $m add command -label [::util::mc "Clear points"] \ -command [list clipboard clear] # post the menu if {[string match macintosh $::tcl_platform(platform)]} { tk_popup $e.popup $X $Y 0 } else { tk_popup $e.popup $X $Y } } wavesurfer-1.8.8p5/src/plugins/dataplot.plug000066400000000000000000001162021325326000200211320ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # wsurf::RegisterPlugin dataplot \ -description "This plug-in is used to plot tabulated numerical ASCII data.\ The data values contained in a file are supposed to be formated in rows\ with one or more\ columns to be plotted. One row for each point in time, starting with the\ first row at 0.0 seconds and equally spaced according to the frame interval\ option.\ It is usually practical to create a special configuration for a certain\ combination of sound and data files, specifying file properties such as\ filename extension, file header size, file path, and column delimiter.\ Optionally a spectrogram or a waveform can be drawn as a backdrop." \ -addmenuentriesproc dataplot::addMenuEntries \ -panecreatedproc dataplot::paneCreated \ -panedeletedproc dataplot::paneDeleted \ -redrawproc dataplot::redraw \ -getboundsproc dataplot::getBounds \ -cursormovedproc dataplot::cursorMoved \ -printproc dataplot::print \ -propertiespageproc dataplot::propertyPane \ -applypropertiesproc dataplot::applyProperties \ -getconfigurationproc dataplot::getConfiguration \ -openfileproc dataplot::openFile \ -savefileproc dataplot::saveFile \ -needsaveproc dataplot::needSave \ -cutproc dataplot::cut \ -copyproc dataplot::copy \ -pasteproc dataplot::paste \ -before analysis namespace eval dataplot { variable Info set Info(OptionTable) [list \ -backdrop backdrop None \ -datadirectory dataDir "" \ -delimiter delimiter " " \ -stylelist styleList {0 black Line 1 red Line \ 2 blue Line 3 green Line \ 4 yellow Line 5 magenta Line} \ -fileextension fileExt ".txt" \ -frameinterval frameInterval 0.01 \ -invocation invocation direct \ -locked locked 0 \ -saveselection saveSelection 0 \ -skiplines skipLines 0 \ -unit unit "" \ -maxvalue maxVal "" \ -minvalue minVal "" \ -offset offset 0.0 \ -dataspacingmode dataSpacingMode fixedtime \ -framerate frameRate 100 \ -timecolumn timeColumn 0 \ -onlywarnmanualmods onlyWarnManualMods 1 \ ] set Info(script) [info script] set Info(path) "" } proc dataplot::addMenuEntries {w pane m hook x y} { if {[string match create $hook]} { $m.$hook add command -label "Data Plot" \ -command [namespace code [list createDataPlot $w $pane]] } elseif {[string length $hook] == 0} { if {$pane==""} return upvar [namespace current]::${pane}::var v if {[info exists v(drawDataPlot)]} { if {$v(drawDataPlot)} { $m add command -label "Statistics..." \ -command [namespace code [list statWin $w $pane]] $m add command -label "Open Data File..." \ -command [namespace code [list getOpenDataFile $w $pane]] $m add command -label "Save Data File..." \ -command [namespace code [list getSaveDataFile $w $pane]] } } } } proc dataplot::paneCreated {w pane} { namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(plotlist) "" set v(maxtime) 0 set v(drawDataPlot) 0 set v(changed) 0 } proc dataplot::paneDeleted {w pane} { namespace delete [namespace current]::${pane} } proc dataplot::minmax {points} { foreach {x y} $points { util::setmin min $y util::setmax max $y } if {![info exists min]} { set min 0.0 set max 0.0 } list $min $max } proc dataplot::getBounds {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot) == 0} return foreach g $v(plotlist) { #<< "column $g, min:$v($g,min), max:$v($g,max)" #<< "minmax:[minmax $v($g,points)]" util::setmin ymin $v($g,min) util::setmax ymax $v($g,max) } if {$v(maxVal) != ""} { set ymax $v(maxVal) } if {$v(minVal) != ""} { set ymin $v(minVal) } if {$v(maxVal) == ""} { set eps 1e-12 if {![info exists ymin]} {set ymin 0} if {![info exists ymax]} {set ymax 0} if {$ymax-$ymin<$eps} { set ymax [expr {$ymin+$eps}] } set scale [expr {pow(10,floor(log10($ymax-$ymin)))}] set ymax2 [expr {$scale*(ceil($ymax/$scale)+1)}] #<< "ymin = $ymin, ymax = $ymax, scale = $scale" } else { set ymax2 $ymax } if {$v(minVal) == ""} { set eps 1e-12 if {![info exists ymin]} {set ymin 0} if {![info exists ymax]} {set ymax 0} if {$ymax-$ymin<$eps} { set ymax [expr {$ymin+$eps}] } set scale [expr {pow(10,floor(log10($ymax-$ymin)))}] set ymin2 [expr {$scale*(floor($ymin/$scale)-1)}] #<< "ymin = $ymin, ymax = $ymax, scale = $scale" #<< "returning \{0 $ymin2 $v(maxtime) $ymax2\}" } else { set ymin2 $ymin } list 0 $ymin2 $v(maxtime) $ymax2 } proc dataplot::cursorMoved {w pane time value} { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot)} { set str "" if {[string equal $v(dataSpacingMode) "variable"] == 0} { set i [expr {1+2*int(($time - $v(offset))/$v(frameInterval) + .5)}] } foreach g $v(plotlist) { if {[string equal $v(dataSpacingMode) "variable"]} { set i 0 while {[lindex $v($g,points) $i] != "" && $time > [lindex $v($g,points) $i]} { incr i 2 } incr i } if {$i > 0 && $i < [llength $v($g,points)]} { set elem [lindex $v($g,points) $i] append str [format "%.2f " $elem] } } set filename [file tail $v(fileName)] $w messageProc \ [format "%s: %s, %s" $filename [$w formatTime $time] $str] \ dataplot } } proc dataplot::importWizard w { variable wiz set z .dataPlotWizard toplevel $z wm title $z "Data Plot Import Wizard" if {[info exists wiz]} {unset wiz} array set wiz { timedata implicit timestep 1/100 timecolumn 0 } ttk::radiobutton $z.r0 -text "Constant time step" -value implicit \ -variable [namespace current]::wiz(timedata) -anchor w ttk::entry $z.e0 -textvariable [namespace current]::wiz(timestep) ttk::radiobutton $z.r1 -text "Time data in column" -value column \ -variable [namespace current]::wiz(timedata) -anchor w ttk::entry $z.e1 -textvariable [namespace current]::wiz(timecolumn) ttk::button $z.ok -text OK -command [list destroy $z] grid $z.r0 $z.e0 -sticky news grid $z.r1 $z.e1 -sticky news grid $z.ok -columnspan 2 -padx 20 grab $z tkwait window $z list timestep [expr {1.0*$wiz(timestep)}] timedata $wiz(timedata) timecolumn $wiz(timecolumn) } proc dataplot::getOpenDataFile {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(dataDir) == ""} { set path [file dirname $v(fileName)] } else { set path $v(dataDir) } } if {[string match Darwin $::tcl_platform(os)]} { if {[file exists $file] == 0} { set file "." } } set fileName [tk_getOpenFile -title "Load Data" -initialfile $file \ -initialdir $path -defaultextension $v(fileExt)] if {$fileName == ""} return if {[string compare $path [file dirname $fileName]] != 0} { set Info(path) [file dirname $fileName] } openDataFile $w $pane $fileName datafile # $w _redrawPane $pane } proc dataplot::openFile {w soundFileName} { foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot)} { openDataFile $w $pane $soundFileName soundfile } } return 0 } proc dataplot::saveFile {w soundFileName} { foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot) && $v(changed)} { saveDataFile $w $pane } } return 0 } proc dataplot::openDataFile {w pane fn type} { variable Info upvar [namespace current]::${pane}::var v set fileName "" if {[string match soundfile $type]} { set path [file dirname $fn] set pathlist [file split $path] set rootname [file tail [file rootname $fn]] set name $rootname.[string trim $v(fileExt) .] # Try to locate the corresponding label file if {$v(dataDir) != ""} { # 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(dataDir) $name]]} { set fileName [file join $v(dataDir) $name] } elseif {[llength $pathlist] > 1 && \ [file readable [eval file join [lreplace $pathlist \ end end $v(dataDir)] $name]]} { set fileName [eval file join [lreplace $pathlist \ end end $v(dataDir)] $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 # array set conf [importWizard $w] # set v(minVal) "" # set v(maxVal) "" foreach key [array names v col#*,*] { unset v($key) } set v(plotlist) "" set v(linesRead) 0 if {[catch {open $fileName} in]} { $w messageProc $in dataplot return } $w messageProc "Reading data..." dataplot fconfigure $in -translation binary -encoding binary set data [read $in] close $in # try different format handlers if {[format::dat-bin::read $w $pane $data]} { #<< "chosen format handler: dat-bin" } else { format::generic-ascii::read $w $pane $data #<< "chosen format handler: generic-ascii" } $w messageProc "" dataplot set v(changed) 0 } proc dataplot::processData {w pane data frameInterval header tag} { upvar [namespace current]::${pane}::var v set v(frameInterval) $frameInterval set v(header) $header set v(maxtime) 0 set row 0 set nrows [llength $data] foreach key [lsort [array names v *,points]] { set v($key) {} } set progressproc [$w cget -progressproc] if {$progressproc != ""} { $progressproc "Processing data..." 0.0 } set lineno 0 if {[llength $data] == 1} { lappend data [lindex $data 0] } foreach line $data { #<< "processing line $row" if {$progressproc != "" && $row % 20 == 19} { if [catch {$progressproc "Processing data..." [expr {1.0*$row/$nrows}]}] { return } } set elements [split [string trim $line] "\t ,"] set col 0 switch $v(dataSpacingMode) { fixedtime { set t [expr {$row*$v(frameInterval)}] } fixedrate { set t [expr {1.0*$row/$v(frameRate)}] } variable { set t [lindex $elements $v(timeColumn)] } } foreach elem $elements { if {$elem != ""} { #<< "processing element $elem" if {[string is double $elem] == 0} { tk_messageBox -message "Non-numerical entry encountered on line: $v(linesRead)!" if {$progressproc != ""} { $progressproc "Processing data..." 1.0 } return } util::setmin v(col#$col,min) $elem util::setmax v(col#$col,max) $elem lappend v(col#$col,points) $t $elem incr col } } #<< "maxtime $v(maxtime)" set v(maxtime) [util::max $t $v(maxtime)] incr row incr v(linesRead) } draw $w $pane $tag if {$progressproc != ""} { $progressproc "Processing data..." 1.0 } if {$v(onlyWarnManualMods) == 0} { set v(changed) 1 } } proc dataplot::draw {w pane tag} { upvar [namespace current]::${pane}::var v set c [$pane canvas] $c delete dataplot set v(plotlist) "" foreach {column color style} $v(styleList) { #<< "column=$column, color=$color, style=$style" if {$column == -1} continue set plot col#$column if {[info exists v($plot,points)] == 0} continue lappend v(plotlist) $plot $c create line 0 0 0 0 -fill $color \ -tags [list $plot dataplot top $tag ${plot}_$pane] util::canvasbind $c $plot [namespace code [list event $w $pane $plot leave]] util::canvasbind $c $plot [namespace code [list event $w $pane $plot press]] util::canvasbind $c $plot [namespace code [list event $w $pane $plot release]] util::canvasbind $c $plot [namespace code [list doodle $w $pane %x %y]] # bind $c [namespace code [list doodle $w $pane %x %y]] } #<< "plotlist=$v(plotlist)" set oldMaxTime [$pane cget -maxtime] $w updateBounds noraise # If the data file is longer than any current displayed pane, update them all if {$oldMaxTime < [$pane cget -maxtime]} { $w _redraw } else { _redraw $w $pane $c 0 0 } } proc dataplot::getSaveDataFile {w pane} { upvar [namespace current]::${pane}::var v set file [file root [file tail $v(fileName)]]$v(fileExt) if {$v(dataDir) == ""} { set path [file dirname $v(fileName)] } else { set path $v(dataDir) } set fileName [tk_getSaveFile -title "Save Data File" -initialfile $file \ -initialdir $path -defaultextension $v(fileExt)] if {$fileName == ""} return set v(fileName) $fileName set v(fileExt) [file extension $fileName] if {$v(fileExt)==".dat"} { set f [open $v(fileName) w] fconfigure $f -translation binary puts -nonewline $f [format::dat-bin::write $w $pane] close $f } else { saveDataFile $w $pane } } proc dataplot::saveDataFile {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] if {$v(saveSelection)} { foreach {left right} [$w cget -selection] break if {$left == $right} { $w configure -selection [list 0.0 [$s length -unit seconds]] foreach {left right} [$w cget -selection] break } } else { set left 0.0 set right [$s length -unit seconds] } set start [util::max 1 \ [expr {1+2*int(($left - $v(offset))/$v(frameInterval) + .5)}]] set end [util::min \ [expr {3+2*int(($right - $v(offset))/$v(frameInterval) + .5)}] \ [llength $v([lindex $v(plotlist) 0],points)]] if {$v(fileName) == $v(fileExt)} { set v(fileName) [file tail [file rootname [$w getInfo fileName]]]$v(fileExt) } set f [open $v(fileName) w] upvar ::wsurf::analysis::${pane}::var av if {[info exists av(exportHeader)] && $av(exportHeader)} { puts $f $v(header) puts $f "Range: [util::formatTime $left $left %.3f]-[util::formatTime $right $right %.3f] hms.d" puts $f "--- End of header ---" } for {set i $start} {$i < $end} {incr i 2} { set values {} foreach key [lsort [array names v *,points]] { set col [lindex [split $key ,] 0] lappend values [lindex $v($col,points) $i] } puts $f [join $values $v(delimiter)] } close $f set v(changed) 0 } proc dataplot::doodle {w pane x y} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set x [$c canvasx $x] set y [$c canvasy $y] set plot $v(doodlePlot) if {$plot == ""} return set n [lindex [split $plot #] 1] set style [lindex $v(styleList) [expr {3*$n+2}]] set time [expr {[$pane getTime $x] - $v(offset)}] set index [expr {int([llength $v($plot,points)] * $time / $v(maxtime) / 2.0)}] set index [util::max [expr {$index*2+1}] 1] if {$index >= [llength $v($plot,points)]} { set index [expr {[llength $v($plot,points)]-1}] } set currentValue [$pane getValue $y] if {$v(lastIndex) == -1} { set start $index set v(lastIndex) $index set v(lastValue) $currentValue } else { set start $v(lastIndex) incr start 2 } set tmp "" if {$start > $index} { set tmp $start set start $index set index [util::max [expr {$tmp - 1}] 1] foreach {v(lastValue) currentValue} [list $currentValue $v(lastValue)] break } if {$v(maxVal) != ""} { set maxValue $v(maxVal) } else { set maxValue [$pane getValue 0] } if {$v(minVal) != ""} { set minValue $v(minVal) } else { set minValue [$pane getValue [$pane cget -scrollheight]] } for {set i $start} {$i <= $index} {incr i 2} { if {$index == $start} { set value $currentValue } else { set value [expr {$v(lastValue)+($currentValue-$v(lastValue))*\ ($i-$start)/($index-$start)}] } if {$value > $maxValue} { set value $maxValue } if {$value < $minValue} { set value $minValue } set v($plot,points) [lreplace $v($plot,points) $i $i $value] if {[string match Line $style] == 0} { set x [$pane getCanvasX [lindex $v($plot,points) [expr {$i-1}]]] set y [$pane getCanvasY $value] $c coords o$i [expr {$x-1}] [expr {$y-1}] [expr {$x+1}] [expr {$y+1}] } # util::setmin v($plot,min) $value # util::setmax v($plot,max) $value } if {$tmp == ""} { set v(lastIndex) [expr {$index-2}] set v(lastValue) $currentValue } else { set v(lastIndex) $start } if {[string match Line $style]} { _redraw $w $pane $c 0 0 } set v(changed) 1 cursorMoved $w $pane [$pane getTime $x] $currentValue } proc dataplot::event {w pane plot event} { upvar [namespace current]::${pane}::var v switch $event { enter { if [info exists v($plot,name)] { set nn $v($plot,name) } else { set nn $plot } [$pane canvas] itemconfigure $plot -width 2 $w messageProc "$nn" [namespace current] } leave { [$pane canvas] itemconfigure $plot -width 1 $w messageProc "" [namespace current] } press { set v(doodlePlot) $plot set v(lastIndex) -1 } release { set v(doodlePlot) "" set v(lastIndex) -1 } } } proc dataplot::createDataPlot {w pane} { set pane [$w addPane -before $pane -height 150 -closeenough 3 -showyaxis true] addDataPlot $w $pane } proc dataplot::addDataPlot {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(OptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(OptionTable) { set v($key) $a($option) } set v(fileExt) .[string trim $v(fileExt) .] set v(fileName) "" set v(linesRead) 0 set v(doodlePlot) "" set v(drawDataPlot) 1 $pane configure -unit $v(unit) switch $v(backdrop) { None { } Spectrogram { wsurf::analysis::addSpectrogram $w $pane } Waveform { wsurf::analysis::addWaveform $w $pane } } if {[string match direct $v(invocation)] && [$w getInfo fileName] != ""} { openDataFile $w $pane [$w getInfo fileName] soundfile } else { set v(fileName) [file tail [file rootname [$w getInfo fileName]]]$v(fileExt) } if {$::tcl_version > 8.2 && $v(locked)} { set c [$pane canvas] if $v(locked) { $c configure -state disabled } else { $c configure -state normal } } } proc dataplot::redraw {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot) == 0} return set c [$pane canvas] foreach g $v(plotlist) { set n [lindex [split $g #] 1] foreach {col color style} $v(styleList) {if {$col==$n} {break}} if {$col!=$n} continue #<< "$g: n=$n,style=$style" if {[string match Line $style] == 0} { #<< "deleting $g from plot" $c delete $g } } _redraw $w $pane $c 0 0 } proc dataplot::print {w pane c x y} { upvar [namespace current]::${pane}::var v if {$v(drawDataPlot) == 0} return set vc [$pane yaxis] set yw [winfo width $vc] set height [$pane cget -scrollheight] set width [$pane getCanvasX [$pane cget -maxtime]] $c create rectangle [expr {$yw+$x}] $y [expr {$x + $yw + $width}] \ [expr {$y+$height}] -tags print foreach {column color style} $v(styleList) { if {$column == -1} continue set plot col#$column if {[info exists v($plot,points)] == 0} continue if {[string match Line $style]} { $c create line 0 0 0 0 -fill $color \ -tags [list $plot dataplot top print ${plot}_$pane] } } set yaxisWidth [winfo width [$pane yaxis]] _redraw $w $pane $c $yaxisWidth $y } proc dataplot::_redraw {w pane c xo yo} { upvar [namespace current]::${pane}::var v set needscaling 0 #<< "plotlist =$v(plotlist)" #<< "stylelist=$v(styleList)" foreach g $v(plotlist) { set n [lindex [split $g #] 1] foreach {col color style} $v(styleList) {if {$col==$n} {break}} if {$col!=$n} continue if {[string match Line $style]} { #<< "g=$g, #coords = [llength $v($g,points)]" #<< "points = [lrange $v($g,points) 0 19]..." if {$::tcl_version > 8.2 && [llength $v($g,points)] > 0} { $c coords ${g}_$pane $v($g,points) } else { eval $c coords ${g}_$pane $v($g,points) } set needscaling 1 } else { set i 1 foreach {t val} $v($g,points) { set x [expr {$xo + [$pane getCanvasX $t] + [$pane getCanvasX $v(offset)]}] set y [expr {$yo + [$pane getCanvasY $val]}] $c create oval [expr {$x-1}] [expr {$y-1}] [expr {$x+1}] [expr {$y+1}]\ -fill $color -tags [list $g dataplot top o$i] incr i 2 } } } if $needscaling { set x0 [$pane getCanvasX 0] set y0 [$pane getCanvasY 0] set x1 [$pane getCanvasX 1] set y1 [$pane getCanvasY 1] set xs [expr {$x1-$x0}] if {$xs==0.0} {set xs 1.0} set ys [expr {$y1-$y0}] if {$ys==0.0} {set ys 1.0} #<< "x0=$x0, x1=$x1, y0=$y0, y1=$y1" #<< "$c scale dataplot 0 0 $xs $ys" #<< "$c move dataplot $x0 $y0" foreach g $v(plotlist) { $c scale ${g}_$pane 0 0 $xs $ys $c move ${g}_$pane [expr {$xo + $x0 + [$pane getCanvasX $v(offset)]}] \ [expr {$yo + $y0}] } } $c raise dataplot } proc dataplot::cut {w start end} { edit $w cut $start $end } proc dataplot::copy {w start end} { edit $w copy $start $end } proc dataplot::paste {w start end} { return [edit $w paste $start $end] } proc dataplot::edit {w op start end} { variable clipboard set done 0 foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {[info exists v(drawDataPlot)]} { if {$v(drawDataPlot)} { switch $op { paste { if {![info exists clipboard]} {return 0} foreach plot $clipboard(plotlist) { set i 0 foreach {x y} $v($plot,points) { if {$x>=$start} {break} incr i } set p1 [lrange $v($plot,points) 0 [expr {$i-1}]] set p2 $clipboard($plot,points) set p3 [lrange $v($plot,points) $i end] set $v($plot,points) $p1 foreach {x y} $p2 { lappend d($plot,points) [expr {$x+$start}] $y } foreach {x y} $p3 { lappend d($plot,points) [expr {$x+$clipboard($plot,length)}] $y } set done 0 } } cut - copy { if [info exists clipboard] {unset clipboard} foreach plot $v(plotlist) { set p1 "" set p2 "" set p3 "" foreach {x y} $v($plot,points) { if {$x<$start-$v(offset)} { lappend p1 $x $y } elseif {$x>=$start-$v(offset) && $x<$end-$v(offset)} { lappend p2 [expr {$x-$start}] $y lappend xy($x) $y } else { lappend p3 [expr {$x-$end+$start}] $y } } if {$op=="cut"} { set d($plot,points) [concat $p1 $p3] } set clipboard($plot,points) $p2 set clipboard($plot,length) [expr {$end-$start}] } set xyStr "" foreach t [lsort -real [array names xy]] { append xyStr "[expr $t+$v(offset)]\t[join $xy($t) \t]\n" } unset -nocomplain xy clipboard append $xyStr set clipboard(plotlist) "" foreach key [array names clipboard *,points] { set plot [lindex [split $key ,] 0] lappend clipboard(plotlist) $plot } } } } catch { parray clipborad } } } return $done } proc dataplot::propertyPane {w pane} { upvar [namespace current]::${pane}::var v if {$pane==""} return if {$v(drawDataPlot)} { return [list "Data Plot" [namespace code drawDataplotPage]] } } proc dataplot::applyProperties {w pane} { if {[string match *wavebar $pane]} return upvar [namespace current]::${pane}::var v if {[info exists v(drawDataPlot)]} { if {$v(drawDataPlot)} { foreach var [list backdrop] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set changeBackdrop 1 } } foreach var [list unit] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) $pane configure -unit $v(t,$var) } } if {[info exists changeBackdrop]} { set wsurf::analysis::${pane}::var(drawWaveform) 0 set wsurf::analysis::${pane}::var(drawSpectrogram) 0 set c [$pane canvas] $c delete analysis [$pane yaxis] delete all switch $v(backdrop) { None { $pane configure -unit "" -stipple "" -layer bottom -showyaxis true } Spectrogram { $pane configure -unit "" -stipple gray12 -layer top -showyaxis true wsurf::analysis::addSpectrogram $w $pane } Waveform { $pane configure -unit "" -stipple "" -layer bottom -showyaxis true wsurf::analysis::addWaveform $w $pane } } $w _redrawPane $pane wsurf::_remeberPropertyPage $w $pane wsurf::_drawPropertyPages $w $pane } foreach var [list fileExt dataDir skipLines frameInterval dataSpacingMode frameRate timeColumn] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) if {$v(changed)} { if {[string match no [tk_messageBox -message "This operation will cause the data file to be re-read from disk and you have unsaved changes.\nDo you want to continue?" -type yesno -icon question]]} { return } } if {[string match direct $v(invocation)] && [$w getInfo fileName] != ""} { openDataFile $w $pane [$w getInfo fileName] soundfile } } } foreach var [list locked] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $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 } } } set tmp {} for {set i 0} {$i < [llength $v(styleList)]/3} {incr i} { lappend tmp $v(t,column$i) $v(t,color$i) $v(t,style$i) } if {[string compare $tmp $v(styleList)] != 0} { set v(styleList) $tmp if {$v(plotlist) != ""} { set doRedraw 1 } } foreach var [list saveSelection delimiter onlyWarnManualMods] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) } } foreach var [list maxVal minVal offset] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } if {[info exists doRedraw]} { draw $w $pane dataplot } } } } proc dataplot::drawDataplotPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(OptionTable) { set v(t,$key) $v($key) } stringPropItem $p.f1 "Data filename extension:" 26 10 "" \ [namespace current]::${pane}::var(t,fileExt) pack [ttk::frame $p.f2] -anchor w -ipady 2 ttk::label $p.f2.l -text "Data file path:" -width 26 -anchor w ttk::entry $p.f2.e -textvar [namespace current]::${pane}::var(t,dataDir) -wi 16 pack $p.f2.l $p.f2.e -side left -padx 3 if {[info command tk_chooseDirectory] != ""} { ttk::button $p.f2.b -text Choose... \ -command [namespace code [list chooseDirectory $w $pane]] pack $p.f2.b -side left -padx 3 } stringPropItem $p.f3 "Number of header lines to skip:" 26 10 "" \ [namespace current]::${pane}::var(t,skipLines) pack [ttk::frame $p.f4] -anchor w -ipady 2 ttk::label $p.f4.l -text "Column delimiter:" -width 26 -anchor w ttk::radiobutton $p.f4.b1 -text space \ -variable [namespace current]::${pane}::var(t,delimiter) -value " " ttk::radiobutton $p.f4.b2 -text tab \ -variable [namespace current]::${pane}::var(t,delimiter) -value "\t" ttk::radiobutton $p.f4.b3 -text Comma \ -variable [namespace current]::${pane}::var(t,delimiter) -value "," pack $p.f4.l $p.f4.b1 $p.f4.b2 $p.f4.b3 -side left -padx 3 if {[string match direct $v(invocation)]} { pack [ttk::frame $p.f5] -anchor w -ipady 2 ttk::label $p.f5.l -text "Data spacing:" -anchor w ttk::radiobutton $p.f5.b1 -text fixed(s) \ -variable [namespace current]::${pane}::var(t,dataSpacingMode) -value "fixedtime" ttk::entry $p.f5.e1 -textvariable [namespace current]::${pane}::var(t,frameInterval) -width 4 ttk::radiobutton $p.f5.b2 -text fixed(Hz) \ -variable [namespace current]::${pane}::var(t,dataSpacingMode) -value "fixedrate" ttk::entry $p.f5.e2 -textvariable [namespace current]::${pane}::var(t,frameRate) -width 3 ttk::radiobutton $p.f5.b3 -text "from col" \ -variable [namespace current]::${pane}::var(t,dataSpacingMode) -value "variable" ttk::entry $p.f5.e3 -textvariable [namespace current]::${pane}::var(t,timeColumn) -width 2 pack $p.f5.l $p.f5.b1 $p.f5.e1 $p.f5.b2 $p.f5.e2 $p.f5.b3 $p.f5.e3 -side left # stringPropItem $p.f5 "Frame interval:" 26 10 s \ \# [namespace current]::${pane}::var(t,frameInterval) stringPropItem $p.f6 "Y-axis unit:" 26 10 "" \ [namespace current]::${pane}::var(t,unit) } pack [ttk::frame $p.f7] -anchor w -ipady 2 ttk::label $p.f7.l -text "Backdrop type:" -width 26 -anchor w ttk::combobox $p.f7.cm -textvariable [namespace current]::${pane}::var(t,backdrop) -values [list None Spectrogram Waveform] -state readonly pack $p.f7.l $p.f7.cm -side left set i 0 set f 0 foreach {column color style} $v(styleList) { set v(t,column$i) $column set v(t,color$i) $color set v(t,style$i) $style pack [ttk::frame $p.e$f] -anchor w ttk::label $p.e$f.l1 -text "Plot column:" -width 12 -anchor w ttk::entry $p.e$f.e -textvar [namespace current]::${pane}::var(t,column$i) -wi 3 ttk::label $p.e$f.l2 -text "using" -anchor w ttk::entry $p.e$f.e2 -textvar [namespace current]::${pane}::var(t,color$i) -wi 10 label $p.e$f.l3 -text " " -bg $v(t,color$i) ttk::button $p.e$f.b -text [::util::mc Choose...] \ -command [list util::chooseColor [namespace current]::${pane}::var(t,color$i) $p.e$f.l3] ttk::combobox $p.e$f.cm -textvariable [namespace current]::${pane}::var(t,style$i) -values [list Line Dots] -state readonly pack $p.e$f.l1 $p.e$f.e $p.e$f.l2 $p.e$f.e2 $p.e$f.l3 $p.e$f.b $p.e$f.cm -side left incr i incr f } if {$::tcl_version > 8.2} { booleanPropItem $p.f8 "Lock data plot" "" \ [namespace current]::${pane}::var(t,locked) } booleanPropItem $p.f9 "Save only data values for current selection" "" \ [namespace current]::${pane}::var(t,saveSelection) pack [ttk::frame $p.f10] -anchor w -ipady 2 ttk::label $p.f10.l -text "Plot value bounds:" -width 26 -anchor w ttk::label $p.f10.l2 -text "min" -anchor w ttk::entry $p.f10.e1 -textvar [namespace current]::${pane}::var(t,minVal) -wi 8 ttk::label $p.f10.l3 -text "max" -anchor w ttk::entry $p.f10.e2 -textvar [namespace current]::${pane}::var(t,maxVal) -wi 8 pack $p.f10.l $p.f10.l2 $p.f10.e1 $p.f10.l3 $p.f10.e2 -side left stringPropItem $p.f11 "Start time offset:" 26 10 "" \ [namespace current]::${pane}::var(t,offset) booleanPropItem $p.f12 "Only warn for unsaved manual data modifications" "" \ [namespace current]::${pane}::var(t,onlyWarnManualMods) } # This procedure returns the code needed to re-create this pane. proc dataplot::getConfiguration {w pane} { variable Info upvar [namespace current]::${pane}::var v set result {} if {$pane != "" && $v(drawDataPlot)} { append result "\$widget dataplot::addDataPlot \$pane" foreach {option key default} $Info(OptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } append result "\n" } return $result } proc dataplot::needSave {w pane} { upvar [namespace current]::${pane}::var v if {[info exists v(drawDataPlot)]} { if {$v(drawDataPlot)} { if {$v(changed)} { return 1 } } } return 0 } proc dataplot::chooseDirectory {w pane} { upvar [namespace current]::${pane}::var v set dir $v(t,dataDir) if {$dir == ""} { set dir . } set res [tk_chooseDirectory -initialdir $dir -mustexist 1] if {$res != ""} { set v(t,dataDir) $res } } proc dataplot::statWin {w pane} { upvar [namespace current]::${pane}::var v regsub -all {\.} $pane _ tmp set paneNo [expr [lsearch [$w _getPanes] $pane] + 1] set v(statWinTL) .statwin$tmp catch {destroy .statwin$tmp} set p [toplevel .statwin$tmp] wm title $p "Statistics for data in pane $paneNo" if {[info exists v(ignoreZero)] == 0} { set v(ignoreZero) 1 } pack [ ttk::frame $p.f2] -fill both -expand true pack [ scrollbar $p.f2.scroll -command "$p.f2.list yview"] -side right \ -fill y text $p.f2.text -yscroll "$p.f2.scroll set" -height 7 -width 65 pack $p.f2.text -side left -expand true -fill both pack [ttk::checkbutton $p.cb \ -text "Ignore data points with value 0.0 when computing statistics" \ -variable [namespace current]::${pane}::var(ignoreZero)] -fill x -expand true pack [ ttk::frame $p.f3] -ipady 10 -fill x pack [ ttk::button $p.f3.b1 -text Compute -command [namespace code [list compute $w $pane $p]]] -side left -padx 20 pack [ ttk::button $p.f3.b2 -text Copy -command [namespace code [list statCopy $w $pane $p]]] -side left -padx 20 pack [ ttk::button $p.f3.b3 -text Close -command "destroy $p"] -side right -padx 20 # Compute statistics set s [$w cget -sound] foreach {left right} [$w cget -selection] break if {$left == $right} { $w configure -selection [list 0.0 [$s length -unit seconds]] } compute $w $pane $p } proc dataplot::compute {w pane p} { upvar [namespace current]::${pane}::var v $p.f2.text delete 0.0 end foreach {left right} [$w cget -selection] break if {[string equal $v(dataSpacingMode) "variable"] == 0} { set start [expr {3+2*int(($left - $v(offset))/$v(frameInterval))}] set end [expr {3+2*int(($right - $v(offset))/$v(frameInterval))}] } foreach g $v(plotlist) { set n 0 if {[string equal $v(dataSpacingMode) "variable"]} { set start 0 while {[lindex $v($g,points) $start] != "" && $left>[lindex $v($g,points) $start]} { incr start 2 } incr start } set i $start set tot 0.0 while {$i > 0 && $i < $end && $i < [llength $v($g,points)]} { set value [lindex $v($g,points) $i] if {$value != 0.0 || $v(ignoreZero) == 0} { set tot [expr $tot + $value] incr n } incr i 2 } if {$n > 0} { set m [expr double($tot)/$n] } else { set m 0 } set i $start set tot 0.0 while {$i > 0 && $i < $end && $i < [llength $v($g,points)]} { set value [lindex $v($g,points) $i] if {$value != 0.0 || $v(ignoreZero) == 0} { set tot [expr {$tot + ($value-$m) * ($value-$m)}] } incr i 2 } if {$n > 0} { set sd [expr sqrt($tot / $n)] } else { set sd 0 } set str [format "Column [lindex [split $g \#] end] mean: %f sd: %f\n" $m $sd] $p.f2.text insert end $str } $p.f2.text insert end "----\n" $p.f2.text insert end "Statistics computed between $left and $right\n" $p.f2.text insert end "(n=$n)" } proc dataplot::statCopy {w pane p} { upvar [namespace current]::${pane}::var v clipboard clear clipboard append [$p.f2.text get 0.0 end] } #------------------------------------------------------------------------------ # Data format handlers #------------------------------------------------------------------------------ # # each format handler should define theese procedures: # # dataplot::format::$formatName::read w pane data # # input: data string # result: true if successful, false if failed # side effects: the following fields of the panes var-array are filled: # v(header) # v(col#..,min) # v(col#..,max) # v(col#..,points) # v(maxtime) # # dataplot::format::$formatName::write w pane # # input: none # output: formatted data, converted from the internal representation # side effects: none # # # # fileds to be added?: # v(col#..,plotflag) # v(col#..,label) # v(col#..,color) # v(col#..,style) # v(col#..,editable) namespace eval dataplot::format {} namespace eval dataplot::format::generic-ascii {} proc dataplot::format::generic-ascii::read {w pane data} { set ns [namespace parent [namespace parent]] upvar ${ns}::${pane}::var v set lines [split [string trim $data] \n] ${ns}::processData $w $pane [lrange $lines $v(skipLines) end] $v(frameInterval) "" dataplot } # ---------------- # dat-ascii format # ---------------- namespace eval dataplot::format::dat-ascii {} proc dataplot::format::dat-ascii::read {w pane data} { set ns [namespace parent [namespace parent]] upvar ${ns}::${pane}::var v set h [lindex $data 0] set v(frameStep) .01 set v(header) $h if {[lindex $h 0] > 0} { # not a proper dat-file return 0 } foreach key [lsort [array names v *,points]] { set v($key) {} } set col 0 foreach elem [lrange $h 2 end] { set v(col#$col,name) $elem incr col } set row 0 foreach line [lrange $data 1 end] { #<< "processing line $row" set elements [lrange $line 2 end] set col 0 set t [expr {$row*$v(frameStep)}] foreach elem $elements { if {$elem != ""} { util::setmin v(col#$col,min) $elem util::setmax v(col#$col,max) $elem #<< "processing line $elem" lappend v(col#$col,points) $t $elem incr col } } #<< "maxtime $v(maxtime)" set v(maxtime) [util::max $t $v(maxtime)] incr row } ${ns}::draw $w $pane dataplot # $progressproc "" 1.0 return 1 } proc dataplot::format::dat-ascii::write {w pane} { set ns [namespace parent [namespace parent]] upvar ${ns}::${pane}::var v set data [list] set header [list "" ""] foreach key [lsort [array names v *,points]] { set col [lindex [split $key ,#] 1] if [info exists v(col#$col,name)] { lappend header [string range $v(col#$col,name) 0 1] } else { lappend header [string range $col 0 1] } } lappend data $header set llen [llength $v(col#0,points)] set fnr 0 for {set i 1} {$i < $llen} {incr i 2} { set frame [list $fnr " "] foreach key [lsort [array names v *,points]] { lappend frame [expr {int([lindex $v($key) $i])}] } lappend data $frame incr fnr } return $data } # ---------------- # dat-bin format # ---------------- namespace eval dataplot::format::dat-bin {} proc dataplot::format::dat-bin::read {w pane data} { upvar [namespace parent [namespace parent]]::${pane}::var v if {[catch {dat2list $data} out]} { return 0 } else { return [[namespace parent]::dat-ascii::read $w $pane $out] } } proc dataplot::format::dat-bin::write {w pane} { upvar [namespace parent [namespace parent]]::${pane}::var v list2dat [[namespace parent]::dat-ascii::write $w $pane] } proc dataplot::format::dat-bin::dat2list {data} { set negn 1 binary scan $data S negn if {$negn>0} { error "Bad input. Not a dat-file?" } set frmsz [expr {-2*$negn}] lappend head $negn "" binary scan $data a4a[expr {$frmsz-4}]S* junk hh shorts foreach {c1 c2} [split $hh ""] {lappend head ${c1}${c2}} lappend out $head for {set pos 0} {$pos<[llength $shorts]} {incr pos [expr -$negn]} { set fnr [lindex $shorts $pos] set labnum [lindex $shorts [expr $pos+1]] set lab [format %c%c [expr $labnum/256] [expr $labnum%256]] set val [lrange $shorts [expr $pos+2] [expr $pos-$negn-1]] lappend out [concat $fnr [list $lab] $val] } return $out } proc dataplot::format::dat-bin::list2dat {l} { set frmsz [llength [lindex $l 0]] set data [binary format S [expr -$frmsz]] append data [binary format c2 {0 0}] foreach var [lrange [lindex $l 0] 2 end] { if {[string length $var] > 2} { error "bad header: variable names can only be 2 characters: \"$var\" (line 1)" } append data [binary format a2 $var] } set fnr 1 foreach frame [lrange $l 1 end] { if {[llength $frame]!=$frmsz} { error "bad frame: line has not the same length as header (line [expr $fnr+1])" } set values {} foreach val [lrange $frame 2 end] {lappend values [expr {round($val)}]} set lab [lindex $frame 1] if {[string length $lab] > 2} { error "bad frame: labels can only be 2 characters: \"$lab\" (line [expr $fnr+1])" } append data [binary format Sa2S[expr $frmsz-2] $fnr $lab $values] incr fnr } return $data } wavesurfer-1.8.8p5/src/plugins/example1.plug000066400000000000000000000135751325326000200210470ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # ----------------------------------------------------------------------------- # This is a sample plugin showing how to use the WaveSurfer plugin API. # It certainly does not claim to compute voiced segments, only to be used # as a source code example. Put this file in ~/.wavesurfer/1.8/plugins/ # # Register plug-in with the callbacks we want to use. wsurf::RegisterPlugin example1 \ -description "Example plug-in no 1, marks voiced speech segments" \ -addmenuentriesproc example1::addMenuEntries \ -panecreatedproc example1::paneCreated \ -panedeletedproc example1::paneDeleted \ -redrawproc example1::redraw \ -getboundsproc example1::getBounds \ -getconfigurationproc example1::getConfiguration # ----------------------------------------------------------------------------- # Create own namespace in which to keep all procedures and variables, global, # widget-specific, or pane-specific. namespace eval example1 { variable Info set Info(OptionTable) [list \ -voicedcolor onColor red \ -unvoicedcolor offColor green \ ] } # ----------------------------------------------------------------------------- # Add the entry "Example 1" to the "Create Pane" popup-menu, # with the command example1::createExample1 proc example1::addMenuEntries {w pane m hook x y} { if {[string match create $hook]} { $m.$hook add command -label "Example 1" \ -command [namespace code [list createExample1 $w $pane]] } } # ----------------------------------------------------------------------------- # This procedure is called when a new pane is created. # Note that we don't know at this point what will be rendered in this pane, # so we assume that this plug-in won't handle this pane and keep track of # that information in a variable. proc example1::paneCreated {w pane} { namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(drawExample1) 0 } # ----------------------------------------------------------------------------- # This procedure is called when a pane is deleted, allowing # the plug-in to clean-up resources used for the pane. # The procedure deletes the pane's local namespace, which contains all # variables allocated for the pane. proc example1::paneDeleted {w pane} { namespace delete [namespace current]::${pane} } # Create a new pane and add graphics to it showing voicing info proc example1::createExample1 {w pane} { set pane [$w addPane -before $pane -height 20 -scrollheight 20 \ -unit "" -fillcolor lightyellow -framecolor blue] addExample1Stuff $w $pane } # Compute and draw voicing info in a given pane. proc example1::addExample1Stuff {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(OptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(OptionTable) { set v($key) $a($option) } set v(pitchList) {} _computeExample1 $w $pane _drawExample1 $w $pane } # Compute voicing info in a given pane. proc example1::_computeExample1 {w pane} { upvar [namespace current]::${pane}::var v set snd [$w cget -sound] $w messageProc "Calculating voiced segments..." if {[catch {set v(pitchList) [$snd pitch \ -progress [$w cget -progressproc]]} ret]} { # User probably aborted this computation (or an error occurred) if {$ret != ""} { $w messageProc "$ret" error "$ret" } set v(pitchList) {} } else { $w messageProc "Done calculating voiced segments" } } # Draw voicing info in a given pane. proc example1::_drawExample1 {w pane} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set height [$pane cget -scrollheight] $c delete example1 set i 0 # Frame interval is 10ms, get corresponding delta-x set dx [$pane getCanvasX 0.01] foreach val $v(pitchList) { if {$val == 0.0} { set color $v(offColor) } else { set color $v(onColor) } $c create rectangle [expr {$i * $dx}] 0 [expr {($i + 1) * $dx}] $height \ -fill $color -outline "" -tags [list example1] incr i } $c lower example1 $c create text 0 0 -text "This is an example plugin" -anchor nw # We have now rendered plug-in specific stuff in this pane. # Remember that this plug-in will handle this pane from now on. set v(drawExample1) 1 } # ----------------------------------------------------------------------------- # This procedure is called whenever the widget needs to redraw all panes. # For example, when the user zooms. proc example1::redraw {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawExample1)} { _drawExample1 $w $pane } } # ----------------------------------------------------------------------------- # This procedure is called whenever the widget needs to know the limits # of the information this plug-in shows in this particular pane. # Typically returns a list: start_time min_value end_time max_value proc example1::getBounds {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawExample1)} { set snd [$w cget -sound] list 0 0 [$snd length -unit seconds] 0 } else { list } } # ----------------------------------------------------------------------------- # This procedure returns the code needed to re-create this pane. proc example1::getConfiguration {w pane} { variable Info upvar [namespace current]::${pane}::var v set result {} if {$pane != "" && $v(drawExample1)} { append result "\$widget example1::addExample1Stuff \$pane" foreach {option key default} $Info(OptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } } append result "\n" return $result } wavesurfer-1.8.8p5/src/plugins/example2.plug000066400000000000000000000210001325326000200210260ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # ----------------------------------------------------------------------------- # This is a sample plugin showing how to use the WaveSurfer plugin API. # It certainly does not claim to compute voiced segments, only to be used # as a source code example. Put this file in ~/.wavesurfer/1.8/plugins/ # Register plug-in with the callbacks we want to use. wsurf::RegisterPlugin example2 \ -description "Example plug-in no 2, marks voiced speech segments" \ -addmenuentriesproc example2::addMenuEntries \ -panecreatedproc example2::paneCreated \ -panedeletedproc example2::paneDeleted \ -redrawproc example2::redraw \ -getboundsproc example2::getBounds \ -cursormovedproc example2::cursorMoved \ -propertiespageproc example2::propertyPane \ -applypropertiesproc example2::applyProperties \ -getconfigurationproc example2::getConfiguration \ -soundchangedproc example2::soundChanged # ----------------------------------------------------------------------------- # Create own namespace in which to keep all procedures and variables, global, # widget-specific, or pane-specific. namespace eval example2 { variable Info set Info(OptionTable) [list \ -voicedcolor onColor red \ -unvoicedcolor offColor green \ ] } # ----------------------------------------------------------------------------- # Add the entry "Example 2" to the "Create Pane" popup-menu, # with the command example2::createExample2 proc example2::addMenuEntries {w pane m hook x y} { if {[string match create $hook]} { $m.$hook add command -label "Example 2" \ -command [namespace code [list createExample2 $w $pane]] } } # ----------------------------------------------------------------------------- # This procedure is called when a new pane is created. # Note that we don't know at this point what will be rendered in this pane, # so we assume that this plug-in won't handle this pane and keep track of # that information in a variable. proc example2::paneCreated {w pane} { namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(drawExample2) 0 } # ----------------------------------------------------------------------------- # This procedure is called when a pane is deleted, allowing # the plug-in to clean-up resources used for the pane. # The procedure deletes the pane's local namespace, which contains all # variables allocated for the pane. proc example2::paneDeleted {w pane} { namespace delete [namespace current]::${pane} } # Create a new pane and add graphics to it showing voicing info proc example2::createExample2 {w pane} { set pane [$w addPane -before $pane -height 20 -scrollheight 20 \ -unit "" -fillcolor lightyellow -framecolor blue] addExample2Stuff $w $pane } # Compute and draw voicing info in a given pane. proc example2::addExample2Stuff {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(OptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(OptionTable) { set v($key) $a($option) } set v(pitchList) {} _computeExample2 $w $pane _drawExample2 $w $pane } # Compute voicing info in a given pane. proc example2::_computeExample2 {w pane} { upvar [namespace current]::${pane}::var v set snd [$w cget -sound] $w messageProc "Calculating voiced segments..." if {[catch {set v(pitchList) [$snd pitch \ -progress [$w cget -progressproc]]} ret]} { # User probably aborted this computation (or an error occurred) if {$ret != ""} { $w messageProc "$ret" error "$ret" } set v(pitchList) {} } else { $w messageProc "Done calculating voiced segments" } } # Draw voicing info in a given pane. proc example2::_drawExample2 {w pane} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set height [$pane cget -scrollheight] $c delete example2 set i 0 # Frame interval is 10ms, get corresponding delta-x set dx [$pane getCanvasX 0.01] foreach val $v(pitchList) { if {$val == 0.0} { set color $v(offColor) } else { set color $v(onColor) } $c create rectangle [expr {$i * $dx}] 0 [expr {($i + 1) * $dx}] $height \ -fill $color -outline "" -tags [list example2] incr i } $c lower example2 $c create text 0 0 -text "This is an example plugin" -anchor nw # We have now rendered plug-in specific stuff in this pane. # Remember that this plug-in will handle this pane from now on. set v(drawExample2) 1 } # ----------------------------------------------------------------------------- # This procedure is called whenever the widget needs to redraw all panes. # For example, when the user zooms. proc example2::redraw {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawExample2)} { _drawExample2 $w $pane } } # ----------------------------------------------------------------------------- # This procedure is called whenever the widget needs to know the limits # of the information this plug-in shows in this particular pane. # Typically returns a list: start_time min_value end_time max_value proc example2::getBounds {w pane} { upvar [namespace current]::${pane}::var v if {$v(drawExample2)} { set snd [$w cget -sound] list 0 0 [$snd length -unit seconds] 0 } else { list } } # ----------------------------------------------------------------------------- # This procedure is called whenever the cursor is moved within the widget. proc example2::cursorMoved {w pane time value} { upvar [namespace current]::${pane}::var v if {$v(drawExample2)} { set i [expr {int($time*100 + .5)}] set pitch [lindex $v(pitchList) $i] if {$pitch == ""} return if {$pitch != 0.0} { set str "voiced segment" } else { set str "unvoiced segment" } $w messageProc [format "Example2 - %s %s" [$w formatTime $time] $str] } } # ----------------------------------------------------------------------------- # This procedure is called whenever the properties dialog is opened for # this pane. It adds the tab "Example2" and calls example2::drawExample2Page # to render the properties notebook-page. proc example2::propertyPane {w pane} { upvar [namespace current]::${pane}::var v if {$pane==""} return if {$v(drawExample2)} { return [list "Example2" [namespace code drawExample2Page]] } } # This procedure is called when the user clicks "OK" or "Apply" in the # "Example2" notebook-page. proc example2::applyProperties {w pane} { if {[string match *wavebar $pane]} return upvar [namespace current]::${pane}::var v if {[info exists v(drawExample2)]} { if {$v(drawExample2)} { foreach var [list onColor offColor] { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } if {[info exists doRedraw]} { $w _redrawPane $pane } } } } # This procedure draws the properties notebook-page for the "Example2" tab. proc example2::drawExample2Page {w pane p} { upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach var [list onColor offColor] { set v(t,$var) $v($var) } colorPropItem $p.f1 "Voiced segment color:" 23 \ [namespace current]::${pane}::var(t,onColor) colorPropItem $p.f2 "Unvoiced segment color:" 23 \ [namespace current]::${pane}::var(t,offColor) } # ----------------------------------------------------------------------------- # This procedure returns the code needed to re-create this pane. proc example2::getConfiguration {w pane} { variable Info upvar [namespace current]::${pane}::var v set result {} if {$pane != "" && $v(drawExample2)} { append result "\$widget example2::addExample2Stuff \$pane" foreach {option key default} $Info(OptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } } append result "\n" return $result } # ----------------------------------------------------------------------------- # This procedure is called whenever the sound of this widget has changed. # For example, after a record operation. proc example2::soundChanged {w flag} { foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawExample2)} { _computeExample2 $w $pane _drawExample2 $w $pane } } } wavesurfer-1.8.8p5/src/plugins/ogg.plug000066400000000000000000000150021325326000200200720ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (C) 2000-2002 Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://www.speech.kth.se/wavesurfer/ # # Ogg Vorbis plug-in for WaveSurfer # # ----------------------------------------------------------------------------- if [info exists snack::snackogg] return if [info exists ::wsurf::Info(CurrentPluginPath)] { set dir [file dirname $::wsurf::Info(CurrentPluginPath)] } else { set dir [file dirname [info script]] } set shlib [file join $dir libsnackogg[info sharedlibextension]] if {[catch {load $shlib}] != 0} { catch {package require snackogg 1.3} } if [info exists snack::snackogg] { wsurf::RegisterPlugin ogg \ -description "This plug-in adds support for the Ogg Vorbis audio\ file format.\ Ogg Vorbis is a completely open, patent-free, professional\ audio encoding and streaming technology with all the benefits\ of Open Source, see http://www.vorbis.com/ for more information.\ The Preferences dialog contains an OGG tab with options for writing\ ogg files. In order to save a file in the ogg format simply specify the\ filename extension .ogg"\ -url http://www.vorbis.com/ \ -savefileproc ogg::saveFile \ -sounddescriptionproc ogg::soundDescription if {![info exists ::surf(extTypes)]} { set ::surf(extTypes) {} } if {![info exists ::surf(loadTypes)]} { set ::surf(loadTypes) {} } if {![info exists ::surf(loadKeys)]} { set ::surf(loadKeys) {} } if {![info exists ::surf(saveTypes)]} { set ::surf(saveTypes) {} } if {![info exists ::surf(saveKeys)]} { set ::surf(saveKeys) {} } set ::surf(extTypes) [concat $::surf(extTypes) \ [list {OGG .ogg}]] set ::surf(loadTypes) [concat $::surf(loadTypes) \ [list {{OGG Files} {.ogg .OGG}}]] set ::surf(loadKeys) [concat $::surf(loadKeys) [list OGG]] set ::surf(saveTypes) [concat $::surf(saveTypes) \ [list {{OGG Files} {.ogg .OGG}}]] set ::surf(saveKeys) [concat $::surf(saveKeys) [list OGG]] } else { wsurf::RegisterPlugin ogg \ -description "Not functional. Could not find the snackogg library." } # ----------------------------------------------------------------------------- namespace eval ogg { variable Info set Info(quality) -1.0 set Info(nombr) 128000 set Info(maxbr) -1 set Info(minbr) -1 set Info(com) "" set Info(query) 1 wsurf::AddPreferencePage Ogg \ [namespace code PreferencesPage] \ [namespace code ApplyPreferences] \ [namespace code GetPreferences] \ [namespace code DefaultPreferences] } proc ogg::saveFile {w soundFileName} { variable Info if {[string match -nocase *.ogg $soundFileName]} { if {$Info(query)} { ParametersDialog Continue tkwait window .ogg } set s [$w cget -sound] if {[catch {$s write $soundFileName -progress ::progressCallback \ -nominalbitrate $Info(nombr) -maxbitrate $Info(maxbr) \ -minbitrate $Info(minbr) -quality $Info(quality) \ -comment $Info(com)} ret]} { if {$ret!=""} { setMsg "$ret" return 1 } } if {[$w getInfo isLinked2File]} { $s configure -file $fileName } return 1 } return 0 } proc ogg::ParametersDialog {text} { variable Info set w .ogg catch {destroy $w} toplevel $w wm title $w "Ogg Vorbis Parameters" pack [frame $w.f0] -anchor w pack [label $w.f0.l -text "Quality:" -widt 16 -anchor w] -side left pack [entry $w.f0.e -textvar [namespace current]::Info(quality) -width 7] \ -side left pack [frame $w.f1] -anchor w pack [label $w.f1.l -text "Nominal bitrate:" -widt 16 -anchor w] -side left pack [entry $w.f1.e -textvar [namespace current]::Info(nombr) -width 7] \ -side left pack [frame $w.f2] -anchor w pack [label $w.f2.l -text "Max bitrate:" -width 16 -anchor w] -side left pack [entry $w.f2.e -textvar [namespace current]::Info(maxbr) -width 7] \ -side left pack [frame $w.f3] -anchor w pack [label $w.f3.l -text "Min bitrate:" -width 16 -anchor w] -side left pack [entry $w.f3.e -textvar [namespace current]::Info(minbr) -width 7] \ -side left pack [frame $w.f4] -anchor w pack [label $w.f4.l -text "Comment:" -width 16 -anchor w] -side left pack [entry $w.f4.e -textvar [namespace current]::Info(com) -width 40] \ -side left pack [frame $w.f5] -anchor w pack [checkbutton $w.f5.b -text "Query parameters before saving" \ -variable [namespace current]::Info(query) -anchor w] -side left pack [frame $w.fb] -side bottom -fill x pack [button $w.fb.cb -text $text -command "destroy $w"] -side top } proc ogg::PreferencesPage {p} { variable Info foreach f [winfo children $p] { destroy $f } foreach var [list quality nombr maxbr minbr com query] { set Info(t,$var) $Info($var) } pack [label $p.l -text "Ogg/Vorbis encoding parameters" -anchor w] stringPropItem $p.f1 "Quality:" 16 7 "" [namespace current]::Info(t,quality) stringPropItem $p.f2 "Nominal bitrate:" 16 7 "" [namespace current]::Info(t,nombr) stringPropItem $p.f3 "Max bitrate:" 16 7 "" [namespace current]::Info(t,maxbr) stringPropItem $p.f4 "Min bitrate:" 16 7 "" [namespace current]::Info(t,minbr) stringPropItem $p.f5 "Comment:" 16 40 "" [namespace current]::Info(t,com) booleanPropItem $p.f6 "Query parameters before saving" "" \ [namespace current]::Info(t,query) } proc ogg::ApplyPreferences {} { variable Info foreach var [list quality nombr maxbr minbr com query] { if {[string compare $Info($var) $Info(t,$var)] != 0} { set Info($var) $Info(t,$var) } } } proc ogg::GetPreferences {} { variable Info set result {} append result "if {\[info exists snack::snackogg\]} {" foreach item [list quality nombr maxbr minbr com query] { append result " set wsurf::ogg::Info($item) \{$Info($item)\}" "\n" } append result "}" return $result } proc ogg::DefaultPreferences {} { variable Info set Info(t,quality) -1.0 set Info(t,nombr) 128000 set Info(t,maxbr) -1 set Info(t,minbr) -1 set Info(t,com) "" set Info(t,query) 1 } proc ogg::soundDescription {w pane} { variable Info set l {} if {[string match OGG [lindex [[$w cget -sound] info] 6]]} { set l [list "Ogg/Vorbis bitrate: [[$w cget -sound] config -nominalbitrate]"] lappend l "Encoded by: [[$w cget -sound] configure -vendor]" lappend l "Comment: [lindex [[$w cget -sound] configure -comment] 0]" lappend l "Comment: [lindex [[$w cget -sound] configure -comment] 1]" lappend l "Comment: [lindex [[$w cget -sound] configure -comment] 2]" } return $l } wavesurfer-1.8.8p5/src/plugins/timeaxis.plug000066400000000000000000000166671325326000200211630ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # wsurf::RegisterPlugin timeaxis \ -description "This plug-in is used to create time axis panes." \ -addmenuentriesproc timeaxis::addMenuEntries \ -panecreatedproc timeaxis::paneCreated \ -panedeletedproc timeaxis::paneDeleted \ -redrawproc timeaxis::redraw \ -getboundsproc timeaxis::getBounds \ -scrollproc timeaxis::scroll \ -cursormovedproc timeaxis::cursorMoved \ -printproc timeaxis::print \ -propertiespageproc timeaxis::propertyPane \ -applypropertiesproc timeaxis::applyProperties \ -getconfigurationproc timeaxis::getConfiguration \ -soundchangedproc timeaxis::soundChanged # ----------------------------------------------------------------------------- namespace eval timeaxis { variable Info set Info(OptionTable) [list \ -color color black \ -timeformat timeFormat time \ -starttime startTime 0.0 \ ] if {[string match unix $::tcl_platform(platform)] } { lappend Info(OptionTable) -font font {Courier 10} } else { lappend Info(OptionTable) -font font {Courier 8} } } # ----------------------------------------------------------------------------- proc timeaxis::addMenuEntries {w pane m hook x y} { if {[string match create $hook]} { $m.$hook add command -label "Time Axis" \ -command [namespace code [list createTimeAxis $w $pane]] } } proc timeaxis::paneCreated {w pane} { namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(drawTimeAxis) 0 } proc timeaxis::paneDeleted {w pane} { namespace delete [namespace current]::${pane} } proc timeaxis::createTimeAxis {w {pane ""}} { set pane [$w addPane -before $pane -height 20 -minheight 20 -maxheight 20] addTimeAxis $w $pane } proc timeaxis::addTimeAxis {w pane args} { variable Info upvar [namespace current]::${pane}::var v foreach {option key default} $Info(OptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(OptionTable) { set v($key) $a($option) } set v(soundLength) 0.0 set v(drawTimeAxis) 1 } proc timeaxis::redraw {w pane} { upvar [namespace current]::${pane}::var v set c [$pane canvas] $c delete axis if {$v(drawTimeAxis)} { redrawTimeAxis $w $pane } } proc timeaxis::redrawTimeAxis {w pane} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set c [$pane canvas] set h [$pane cget -height] set width [expr {[$pane cget -maxtime]*[$pane cget -pixelspersecond]}] snack::timeAxis $c 0 0 $width $h [$w cget -pixelspersecond] \ -tags {timeAxis axis} -fill $v(color) -starttime $v(startTime) \ -font $v(font) -drawvisible 1 -format $v(timeFormat) set unit $v(timeFormat) set vc [$pane yaxis] set yw [winfo width $vc] [$pane yaxis] delete axis [$pane yaxis] create text 0 [expr {$h/2}] -text $unit \ -font $v(font) -tags axis \ -fill $v(color) -anchor w set v(soundLength) [$s length -unit sec] } proc timeaxis::scroll {w pane frac1 frac2} { upvar [namespace current]::${pane}::var v if {$v(drawTimeAxis)} { set c [$pane canvas] $c delete axis set h [$pane cget -height] set width [expr {[$pane cget -maxtime]*[$pane cget -pixelspersecond]}] snack::timeAxis $c 0 0 $width $h [$w cget -pixelspersecond] \ -tags {timeAxis axis} -fill $v(color) -starttime $v(startTime) \ -font $v(font) -drawvisible 1 -format $v(timeFormat) } } proc timeaxis::print {w pane c x y} { upvar [namespace current]::${pane}::var v set s [$w cget -sound] set h [$pane cget -height] set vc [$pane yaxis] set yw [winfo width $vc] if {$v(drawTimeAxis)} { set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] $c create rectangle $x $y [expr {$x+$width+$yw}] [expr {$y+$h}] \ -fill white -tags print -outline black snack::timeAxis $c $yw $y $width $h \ [$w cget -pixelspersecond] -tags print -starttime $v(startTime) \ -fill $v(color) -font $v(font) -format $v(timeFormat) $c create rectangle [expr {$x+1}] [expr {$y+1}] [expr {$x+$yw-1}] \ [expr {$y+$h-1}] -fill white -tags print -outline $v(color) # [expr {$x+[font measure $v(font) $unit]-2}] # [expr {$y+4+[font metrics $v(font) -linespace]}] set unit $v(timeFormat) set vc [$pane yaxis] set yw [winfo width $vc] $c create text [expr {2+$x}] [expr {$y+5}] -text $unit \ -fill $v(color) -anchor w\ -font $v(font) -tags print } } proc timeaxis::getBounds {w pane} { list } proc timeaxis::propertyPane {w pane} { if {$pane==""} return upvar [namespace current]::${pane}::var v if {$v(drawTimeAxis)} { list TimeAxis [namespace code drawPage] } } proc timeaxis::applyProperties {w pane} { if {[string match *wavebar $pane]} return upvar [namespace current]::${pane}::var v if {[info exists v(drawTimeAxis)]} { if {$v(drawTimeAxis)} { foreach var {color font timeFormat startTime} { if {[string compare $v(t,$var) $v($var)] != 0} { set v($var) $v(t,$var) set doRedraw 1 } } if {[info exists doRedraw]} { $w _redrawPane $pane } } } } proc timeaxis::drawPage {w pane p} { variable Info upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach {option key default} $Info(OptionTable) { set v(t,$key) $v($key) } colorPropItem $p.f1 "Color:" 20 \ [namespace current]::${pane}::var(t,color) stringPropItem $p.f2 "Font:" 20 16 \ "" [namespace current]::${pane}::var(t,font) pack [frame $p.f3] -anchor w label $p.f3.l -text [::util::mc "Time display format:"] -width 20 \ -anchor w ttk::combobox $p.f3.om -textvariable [namespace current]::${pane}::var(t,timeFormat) -value [list time seconds "10ms frames" "PAL frames" "NTSC frames"] -state readonly pack $p.f3.l $p.f3.om -side left -padx 3 stringPropItem $p.f4 "Start time offset:" 20 10 \ "" [namespace current]::${pane}::var(t,startTime) } proc timeaxis::cursorMoved {w pane time value} { upvar [namespace current]::${pane}::var v if {$v(drawTimeAxis)} { switch -- $v(timeFormat) { "samples" { set s [$w cget -sound] set paneTime [expr {int($time*[$s cget -rate])}] } "seconds" { set paneTime [format "%.3f" $time]s } "10ms frames" { set s [$w cget -sound] set paneTime [expr {int($time*100)}] } "PAL frames" { set s [$w cget -sound] set paneTime [expr {int($time*25)}] } "NTSC frames" { set s [$w cget -sound] set paneTime [expr {int($time*30)}] } default {set widgetTime [$w formatTime $time] set paneTime [$w formatTime $time] } } set widgetTime [$w formatTime $time] $w messageProc [format "Time axis - %s (%s)" $paneTime $widgetTime] timeaxis } } proc timeaxis::soundChanged {w flag} { set s [$w cget -sound] foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawTimeAxis)} { if {$v(soundLength) < [$s length -unit sec]} { $w _redrawPane $pane } } } } proc timeaxis::getConfiguration {w pane} { variable Info upvar [namespace current]::${pane}::var v set result {} if {$pane==""} {return {}} if {$v(drawTimeAxis)} { append result "\$widget timeaxis::addTimeAxis \$pane" foreach {option key default} $Info(OptionTable) { if {$v($key) != $default} { append result " $option \"$v($key)\"" } } } append result "\n" return $result } wavesurfer-1.8.8p5/src/plugins/transcription.plug000066400000000000000000002366661325326000200222420ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/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(OptionTable) [list \ -alignment alignment e \ -labelcolor labColor black \ -boundarycolor bdColor black \ -backgroundcolor bgColor white \ -extension labext ".lab" \ -format format WaveSurfer \ -labeldirectory labdir "" \ -fileencoding encoding "" \ -adjustleftevent adjustLeftEvent Control-l \ -adjustrightevent adjustRightEvent Control-r \ -playlabelevent playLabelEvent Control-space \ -nextlabelevent nextLabelEvent Key-Up \ -prevlabelevent prevLabelEvent Key-Down \ -locked locked 0 \ -quickenter quickenter 1 \ -quickentertolerance quicktol 20 \ -extendboundaries extBounds 0 \ -linkboundaries linkBounds 0 \ -zeroxboundaries zeroXBounds 0 \ -playhighlight highlight 0 \ -autodetectformat autodetect 1 \ -hidelabels hide "" \ ] if {[string match unix $::tcl_platform(platform)] } { lappend Info(OptionTable) -font font {Courier 10} } else { lappend Info(OptionTable) -font font {Courier 8} } if {[string match Darwin $::tcl_platform(os)]} { lappend Info(OptionTable) -labelmenuevent labelMenuEvent Shift-ButtonPress-1 lappend Info(OptionTable) -labelmenu dummy {1 6 lab1 lab2 lab3 lab4 lab5 lab6} } else { lappend Info(OptionTable) -labelmenuevent labelMenuEvent Shift-ButtonPress-3 lappend Info(OptionTable) -labelmenu dummy \ {2 7 lab1 lab2 lab3 lab4 lab5 lab6 lab7 lab8 {} {} {} {} {} {}} } set Info(path) "" } # ----------------------------------------------------------------------------- proc trans::addMenuEntries {w pane m hook x y} { # puts [info level 0] 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 "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 command -label "Convert..." \ -command [namespace code [list convert $w $pane]] # $m add separator $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 All 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 "Transcription" \ -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 } } } regsub -all {\.} $pane _ tmp catch {destroy .browse$tmp} namespace delete [namespace current]::${pane} } proc trans::createTranscription {w pane} { set pane [$w addPane -before $pane -height 24 -closeenough 3 \ -minheight 24 -maxheight 24] addTranscription $w $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)]] } } if {[string match Darwin $::tcl_platform(os)]} { if {[file exists $file] == 0} { set file "." } } 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)]] } } if {[string match Darwin $::tcl_platform(os)]} { if {[file exists $file] == 0} { set file "." } } 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::transcriptionFromList {w pane transList} { variable Info upvar [namespace current]::${pane}::var v set fileName "" set Info(path) "" set i 0 set v(t1,start) 0.0 set map {} foreach {end label} $transList { set v(t1,$i,end) $end 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 foreach {option key default} $Info(OptionTable) { set a($option) $default } array set a $args foreach {option key default} $Info(OptionTable) { set v($key) $a($option) } set v(labext) .[string trim $v(labext) .] set v(menuNcols) [lindex $a(-labelmenu) 0] set v(menuNrows) [lindex $a(-labelmenu) 1] 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) "" set v(matchCase) 0 list { set v(lastTag) "" set v(hidden) "" } event add <> <$v(labelMenuEvent)> event add <> <$v(adjustLeftEvent)> event add <> <$v(adjustRightEvent)> event add <> <$v(playLabelEvent)> event add <> <$v(nextLabelEvent)> event add <> <$v(prevLabelEvent)> 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] util::canvasbind $c bound \ [namespace code [list MoveBoundary $w $pane %x]] util::canvasbind $c bound "" # bind $c \ # [namespace code [list handleEvents PlayLabel %x %y]] $c bind bound [list $c configure \ -cursor sb_h_double_arrow] $c bind bound [list $c configure -cursor {}] $c bind text [list $c configure -cursor xterm] $c bind text [list $c configure -cursor {}] util::canvasbind $c text [namespace code \ [list textB1Move $w $pane %W %x %y]] util::canvasbind $c text "" util::canvasbind $c text [namespace code \ [list textClick $w $pane %W %x %y]] util::canvasbind $c bg [namespace code \ [list boxClick $w $pane %W %x %y]] # bind $c [namespace code [list InsertLabel $w $pane %x %y]] bind $c [namespace code [list handleAnyKey $w $pane %W %x %y %A]] bind $c [namespace code [list handleBackspace $w $pane %W]] bind $c { %W insert current insert "" %W focus {} } bind $c [namespace code [list handleEnterLeave $w $pane 1]] bind $c [namespace code [list handleEnterLeave $w $pane 0]] bind [winfo toplevel $c] <> \ [namespace code [list handleEvents AdjustLabel %x %y right]] bind [winfo toplevel $c] <> \ [namespace code [list handleEvents AdjustLabel %x %y left]] util::canvasbind $c text <> "" util::canvasbind $c text <> "" bind $c <> \ [namespace code [list handleEvents PlayLabel %x %y]] bind [winfo toplevel $c] <> \ [namespace code [list handleEvents PlayLabel %x %y]] bind $c <> "[namespace code [list handleDelete $w $pane %W]];break" bind $c "[namespace code [list handleCtrlDelete $w $pane %W]];break" bind $c "[namespace code [list handleCtrlInsert $w $pane %W]];break" bind $c "[namespace code [list $w _redrawPane $pane]];break" bind $c "[namespace code [list handleMultiKey $w $pane %W]];break" bind $c "[namespace code [list handleSpace $w $pane %W]];break" bind $c "[namespace code [list FindNextLabel $w $pane]];break" $c bind text [namespace code [list handleKeyRight $w $pane %W]] $c bind text [namespace code [list handleKeyLeft $w $pane %W]] $c bind text \ [namespace code [list kbPlayLabel $w $pane %W this]] $c bind text \ [namespace code [list kbPlayLabel $w $pane %W next]] $c bind text \ [namespace code [list kbAdjustLeftRight $w $pane %W right]] $c bind text \ [namespace code [list kbAdjustLeftRight $w $pane %W left]] util::canvasbind $c text <> "[namespace code [list Cursor2NextLabel $w $pane %W next]];break" util::canvasbind $c text <> "[namespace code [list Cursor2NextLabel $w $pane %W prev]]" 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} { # puts [info level 0] 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} { # puts [info level 0] 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} { # puts [info level 0] upvar [namespace current]::${pane}::var v if {[string length $A] == 0} return if {[string is print $A] == 0} return # retrieve x & y from vtcanvas since x,y event fields for keypress # (on tclkit 8.5.9 for OSX) are garbage... set x [$pane getCurX] set y [$pane getCurY] set c [$pane canvas] # puts focus=[$W focus],hidden=$v(hidden) 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::handleCtrlDelete {w pane W} { if {[$W focus] != {}} { set tag [$W focus] Cursor2NextLabel $w $pane $W next set c [$pane canvas] DeleteLabelFromTags $w $pane [$c gettags $tag] } } 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::handleMultiKey {w pane W} { upvar [namespace current]::${pane}::var v set v(multiKeyPressed) 1 } proc trans::handleSpace {w pane W} { upvar [namespace current]::${pane}::var v set c [$pane canvas] if {[$W focus] != {}} { $W select clear if {[info exists v(multiKeyPressed)]} { $W insert [$W focus] insert ` } else { $W insert [$W focus] insert _ } SetLabelText $w $pane [lindex [$c gettags [$W focus]] 0] \ [$c itemcget [$W focus] -text] } unset -nocomplain v(multiKeyPressed) } proc trans::kbPlayLabel {w pane W flag} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set width [expr {[$pane cget -maxtime] * [$pane cget -pixelspersecond]}] if {[$W focus] != {}} { set i [lindex [$c gettags [$W focus]] 0] if {$flag == "next"} { 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::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::kbAdjustLeftRight {w pane W dir} { upvar [namespace current]::${pane}::var v set c [$pane canvas] set tagno [lindex [$c gettags [$W focus]] 0] if {$tagno == "End"} return if {$tagno != ""} { if {$dir == "right"} { set t [expr $v(t1,$tagno,end) + 0.005] } else { set t [expr $v(t1,$tagno,end) - 0.005] } } if {$v(zeroXBounds)} { set s [$w cget -sound] set length [$s length] set start [expr {int($t*[$s cget -rate])}] if {$start > $length} { set start $length } set leftmost [expr {$start-600}] if {$leftmost < 0} { ;# to fill sample buffer with leftmost $s sample 0 } else { $s sample [expr {$start-600}] } for {set i 0} {$i < 600} {incr i} { if {$dir == "right"} { set j [expr {$start + $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} { break } } } else { set j [expr {$start - $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} { break } } } } set t [expr double($j)/[$s cget -rate]] } set start [$pane getCanvasX [GetStartByIndex $w $pane $tagno]] set oldTime $v(t1,$tagno,end) # Place this label set co [$c coords b$tagno] set xc [$pane getCanvasX $t] PlaceLabel $w $pane $tagno $co $start $xc set v(t1,$tagno,end) $t # Place next label PlaceNextLabel $w $pane $tagno $xc changed $w $pane 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) $t PlaceLabel $w $otherpane $tag $co $start $xc changed $w $otherpane break } } } } } $w messageProc [format "Transcription - %s" [$w formatTime $t]] } 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::checkTranscriptionFile {w pane} { variable Info upvar [namespace current]::${pane}::var v if {[file readable $v(fileName)] == 0} return set fd [open $v(fileName)] # the transcription file may be empty set rows {} foreach row [split [read -nonewline $fd] \n] { if {$row != ""} { lappend rows $row } } close $fd foreach {format loadProc saveProc testProc} $Info(formats) { set res [[namespace parent]::$testProc $w $pane $rows] #puts $format,$res if {$res != ""} { set v(format) $res return } } set v(format) WaveSurfer } proc trans::openFile {w soundFileName} { variable Info foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawTranscription)} { openTranscriptionFile $w $pane $soundFileName 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(fullName) $fn set v(nLabels) 0 set v(map) {} set v(labext) [file extension $fileName] if {$v(autodetect)} { checkTranscriptionFile $w $pane } foreach {format loadProc saveProc testProc} $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::validateTranscription {w pane} { upvar [namespace current]::${pane}::var v set okStress [list \ a2: a2. a2 ä2: ä2. ä2 e2: e2 i2: i2. i2 \ å2: å2. å2 u2: u2. u2 \ ö2: ö2. ö2 o2: o2. o2 y2: y2. y2 \ au. au eu. eu ö3: ö3. ö3 ä3: ä3. ä3 \ a: a. a ä: ä. ä e. e i. i å. å u. u ö. ö o: o. o y: y. y \ e3 u3 u3. o3 i3 i3. an: an en: en on a3: u4: u4 öw ë] set noStress [list \ b: b. b d: d. d rd: rd. rd f: f. f g: g. g h: h. h j: j. j \ k: k. k l: l. l rl: rl. rl m: m. m n: n. n ng: ng. ng \ rn: rn. rn p: p. p r: r. r s: s. s rs: rs. rs sj: sj. sj \ t: t. t tj: tj. tj rt: rt. rt v: v. v w: w. w sj3: sj3 \ j3 j3: z rs3 tj3 tj3: th: th dh: dh r3 r3: r4 \ tcl pcl kcl bcl dcl gcl rtc rdc sil] for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set label $v(t1,$ind,label) set label [string trim $label {+,-}] set unStrL [string trim $label {\"\'\`+,}] if {$v(labext) == ".lab"} { if {[lsearch $okStress $unStrL] == -1 && [lsearch $noStress $label] == -1} { tk_messageBox -message [::util::mc "Bad label: $label"] } } if {$v(labext) == ".ord"} { if {[string match <*> $label] && $label != ""} { tk_messageBox -message [::util::mc "Bad label: $label"] } } } } proc trans::saveTranscriptionFile {w pane} { variable Info upvar [namespace current]::${pane}::var v #validateTranscription $w $pane 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 testProc} $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) if {[lsearch $v(hide) $label] >= 0} { set 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] # Make sure labels don't get drawn off left side of screen if {$v(alignment) == "e" && $tx < [font measure $v(font) $label]} { set tx [font measure $v(font) $label] } if {$v(alignment) == "c" && $tx < [font measure $v(font) $label]/2.0} { set tx [expr [font measure $v(font) $label] / 2.0] } set bgColor $v(bgColor) if {$label == "ons"} { set bgColor green } if {$label == "nuc"} { set bgColor red } $c create rectangle [expr {$x+$lx}] $y \ [expr {$x+$rx}] [expr {$y+$height-4}] -outline "" \ -tags [list g$ind obj bg tran] -fill $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 -scrollheight] $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 -scrollheight] $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]] if {$ind == ""} { set ind [lindex $v(map) [expr $i-2]] } 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 -scrollheight] $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 } if {$v(zeroXBounds)} { set length [$s length] set start [expr {int([$pane getTime $xc]*[$s cget -rate])}] set leftmost [expr {$start-200}] if {$leftmost < 0} { ;# to fill sample buffer with leftmost $s sample 0 } else { $s sample [expr {$start-200}] } for {set i 0} {$i < 200} {incr i} { set j [expr {$start + $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} { break } } set j [expr {$start - $i}] if {$j > 0 && $j < $length} { set s1 [lindex [$s sample $j] 0] set s0 [lindex [$s sample [expr {$j-1}]] 0] if {[expr {$s1*$s0}] <= 0 && $s1 >= 0.0} { break } } } set xc [$pane getCanvasX [expr double($j)/[$s cget -rate]]] } 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 changed $w $otherpane break } } } } } changed $w $pane if {$v(lastmoved) != $i} { 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} { # puts [info level 0] 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 ""}} { # puts [info level 0] 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::xxxhandleCtrlInsert {w pane W} { upvar [namespace current]::${pane}::var v if {[$W focus] != {}} { set tag [$W focus] #Cursor2NextLabel $w $pane $W next set c [$pane canvas] set tags [$c gettags $tag] set tagno [string trim [lindex $tags 0] gb] set i [lsearch -exact $v(map) $tagno] if {$i == -1} return # Create label with a randomly chosen tag number set n [clock clicks] set v(t1,$n,end) $v(t1,$tagno,end) set v(t1,$n,label) "" set v(t1,$n,rest) "" set v(map) [linsert $v(map) [expr $i+1] $n] incr v(nLabels) # Deduct some time from current label set v(t1,$tagno,end) [expr $v(t1,$tagno,end)-0.04] set start [$pane getCanvasX [GetStartByIndex $w $pane $i]] set cx [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+1]]] set cx2 [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+2]]] # Draw inserted label DrawLabel $w $pane $c $n $i 0 0 $cx $cx2 "" # Place next label #if {$i < 0} { incr i } #incr i -1 PlaceNextLabel $w $pane $i $start PlaceNextLabel $w $pane [expr $i+1] $cx PlaceNextLabel $w $pane [expr $i+2] $cx2 changed $w $pane return $n } } proc trans::handleCtrlInsert {w pane W} { upvar [namespace current]::${pane}::var v if {[$W focus] != {}} { set tag [$W focus] #Cursor2NextLabel $w $pane $W next set c [$pane canvas] set tags [$c gettags $tag] set tagno [string trim [lindex $tags 0] gb] set i [lsearch -exact $v(map) $tagno] if {$i == -1} return # Create label with a randomly chosen tag number set n [clock clicks] set v(t1,$n,end) [expr $v(t1,$tagno,end)-0.04] set v(t1,$n,label) $v(t1,$tagno,label) set v(t1,$n,rest) "" set v(map) [linsert $v(map) $i $n] incr v(nLabels) #foreach qq {3 4 5 6} { # set qqq [lindex $v(map) $qq] # puts "\t$qqq $v(t1,$qqq,label) $v(t1,$qqq,end)" #} #set v(t1,$tagno,label) "" ; #fungerar inte # 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]] } set cx [$pane getCanvasX [GetStartByIndex $w $pane [expr $i+1]]] # Draw inserted label DrawLabel $w $pane $c $n $i 0 0 $start $cx $v(t1,$n,label) # Place next label if {$i < 0} { incr i } PlaceNextLabel $w $pane $i $cx # Display cursor if label is empty if {1} { focus [$pane canvas] [$pane canvas] focus lab$tagno [$pane canvas] icursor lab$tagno 0 } 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]]] DeleteLabelFromTags $w $pane $tags } proc trans::DeleteLabelFromTags {w pane tags} { upvar [namespace current]::${pane}::var v set c [$pane canvas] 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} { # puts [info level 0] 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 set oldTime $v(t1,$tagno,end) 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 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) $t PlaceLabel $w $otherpane $tag $co $start $xc changed $w $otherpane break } } } } } $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 length [[$w cget -sound] length -unit seconds] foreach {left right} [$w cget -zoomfracs] break set mid [expr ($right - $left) / 2.0] $w xscroll moveto [expr ($start - $mid)/ $length] $w play $start $end set delay [expr 500 + int(1000 * ($end - $start))] after $delay [namespace code [list FindNextLabel $w $pane]] } proc trans::Cursor2NextLabel {w pane W dir} { upvar [namespace current]::${pane}::var v # move insertion cursor to next label set c [$pane canvas] set ti [lindex [$c gettags [$W focus]] 0] set i [lsearch -exact $v(map) $ti] if {$dir == "next"} { set __focus [lindex $v(map) [expr {$i+1}]] } else { set __focus [lindex $v(map) [expr {$i-1}]] } $W focus lab$__focus $W icursor lab$__focus 0 set start [GetStartByIndex $w $pane [lsearch -exact $v(map) $__focus]] set end $v(t1,$__focus,end) $w play $start $end # center label in view if {$dir == "next"} { set i [expr {$i+2}] } else { set i [expr {$i-1}] } set start [GetStartByIndex $w $pane $i] set length [[$w cget -sound] length -unit seconds] foreach {left right} [$w cget -zoomfracs] break set mid [expr ($right - $left) / 2.0] $w xscroll moveto [expr ($start - $mid)/ $length] } proc trans::Cursor2FirstLabel {w} { foreach p [$w _getPanes] { upvar ::wsurf::trans::${p}::var v if {$v(drawTranscription)} break } set c [$p canvas] if {[$c focus] == ""} { focus $c set __focus [lindex $v(map) 0] $c focus lab$__focus $c icursor lab$__focus 0 Cursor2NextLabel $w $p $c next } } 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 ttk::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 $c delete bg ;# sometimes characters seem to have been obscured by the bg } proc trans::cursorMoved {w pane time value} { upvar [namespace current]::${pane}::var v if {$v(drawTranscription)} { set v(currentX) [$pane getCanvasX $time] set v(currentY) [$pane getCanvasY $value] $w messageProc \ [format "%s: %s | $v(labelMenuEvent): Label menu" $v(fileName) [$w formatTime $time]] } } proc trans::soundChanged {w flag} { 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 nextLabelEvent \ locked quickenter quicktol hide \ extBounds linkBounds highlight autodetect zeroXBounds} { if {[string compare $v(t,$var) $v($var)] !=0} { if [string match labelMenuEvent $var] { event delete <> <$v($var)> event add <> <$v(t,$var)> } if [string match adjustLeftEvent $var] { event delete <> <$v($var)> event add <> <$v(t,$var)> } if [string match adjustRightEvent $var] { event delete <> <$v($var)> event add <> <$v(t,$var)> } if [string match playLabelEvent $var] { event delete <> <$v($var)> event add <> <$v(t,$var)> } if [string match nextLabelEvent $var] { event delete <> <$v($var)> event add <> <$v(t,$var)> } if {$::tcl_version > 8.2 && [string match locked $var] == 1} { set c [$pane canvas] if $v(t,$var) { $c configure -state disabled } else { $c configure -state normal } } if {[string match 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) set oldFormat $v(format) openTranscriptionFile $w $pane [$w getInfo fileName] soundfile set doRedraw 1 if {$oldFormat != $v(format)} { set formatChanged 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 hide $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 hide \ font locked quickenter quicktol extBounds linkBounds zeroXBounds} { set v(t,$var) $v($var) } pack [ttk::frame $path.f1] -anchor w ttk::label $path.f1.l -text "Label file format:" -width 25 -anchor w foreach {format loadProc saveProc testProc} $Info(formats) { lappend tmp $format } ttk::combobox $path.f1.om -textvariable [namespace current]::${pane}::var(t,format) -values $tmp -state readonly pack $path.f1.l $path.f1.om -side left -padx 3 pack [ttk::frame $path.f2] -anchor w ttk::label $path.f2.l -text "Label alignment:" -width 25 -anchor w ttk::combobox $path.f2.om -textvariable [namespace current]::${pane}::var(t,alignment) -values [list e c w] -state readonly 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 [ttk::frame $path.f4] -anchor w ttk::label $path.f4.l -text "Label file path:" -width 25 -anchor w ttk::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) stringPropItem $path.f10 "Hide labels:" 25 16 "" \ [namespace current]::${pane}::var(t,hide) if {$::tcl_version > 8.2} { booleanPropItem $path.f11 "Lock transcription" "" \ [namespace current]::${pane}::var(t,locked) } booleanPropItem $path.f12 "Quick transcribe" "" \ [namespace current]::${pane}::var(t,quickenter) stringPropItem $path.f13 "Max cursor movement for current label:" 34 4 \ pixels [namespace current]::${pane}::var(t,quicktol) booleanPropItem $path.f14 "Extend boundaries into waveform and spectrogram panes" "" \ [namespace current]::${pane}::var(t,extBounds) booleanPropItem $path.f15 "Move coinciding boundaries in other transcription panes" "" \ [namespace current]::${pane}::var(t,linkBounds) booleanPropItem $path.f16 "Constrain boundaries to zero crossings" "" \ [namespace current]::${pane}::var(t,zeroXBounds) } 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 [ttk::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 [ttk::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 \ nextLabelEvent menuNrows menuNcols highlight autodetect} { 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) booleanPropItem $path.f00 "Auto-detect transcription file format" "" \ [namespace current]::${pane}::var(t,autodetect) 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.f31 "Move to next label event:" 28 25 "" \ [namespace current]::${pane}::var(t,nextLabelEvent) stringPropItem $path.f4 "Label menu event:" 28 25 "" \ [namespace current]::${pane}::var(t,labelMenuEvent) pack [ttk::frame $path.f5] -anchor w pack [ttk::label $path.f5.l -text "Label menu pane:" -width 25 -anchor w] -padx 3 pack [ttk::frame $path.f6] -anchor w pack [ttk::label $path.f6.lc -text "Columns:" -anchor w] -side left -padx 3 pack [ttk::entry $path.f6.ec -width 2 -textvar \ [namespace current]::${pane}::var(t,menuNcols)] -side left pack [ttk::label $path.f6.lr -text "Rows:" -anchor w] -side left pack [ttk::entry $path.f6.er -width 2 -textvar \ [namespace current]::${pane}::var(t,menuNrows)] -side left pack [button $path.f6.b -text Update \ -command [namespace code [list confPage $w $pane $path]]] -side left \ -padx 3 bind $path.f6.ec [namespace code [list confPage $w $pane $path]] bind $path.f6.er [namespace code [list confPage $w $pane $path]] for {set i 0} {$i < $v(t,menuNrows)} {incr i } { pack [ttk::frame $path.fl$i] -anchor w for {set j 0} {$j < $v(t,menuNcols)} {incr j } { pack [ttk::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} { variable Info 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" foreach {option key default} $Info(OptionTable) { if {$v($key) != $default && $option != "-labelmenu"} { append result " $option \"$v($key)\"" } if {$option == "-labelmenu" && $labmenu != $default} { 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 } else { if {[llength $v(map)] == 0} continue # Skip labels before $t 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 labels $dt to the left set ind [lindex $v(map) $i] while {$ind != ""} { set v(t1,$ind,end) [expr {$v(t1,$ind,end)+$length}] incr i set ind [lindex $v(map) $i] } changed $w $pane $w _redrawPane $pane } } } } proc trans::find {w pane} { upvar [namespace current]::${pane}::var v set p $v(browseTL) set v(nMatch) 0 $p.b.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.b.f2.list insert end $tmp incr v(nMatch) } incr i } } proc trans::listSelect {w pane} { upvar [namespace current]::${pane}::var v set p $v(browseTL) set cursel [$p.b.f2.list curselection] if {$cursel == ""} return set start [lindex [$p.b.f2.list get [lindex $cursel 0]] end-1] set end [lindex [$p.b.f2.list get [lindex $cursel end]] end] if {$v(selectMode) == "start"} { $w configure -selection [list $start $start] } else { $w configure -selection [list $start $end] } set length [[$w cget -sound] length -unit seconds] foreach {left right} [$w cget -zoomfracs] break set mid [expr ($right - $left) / 2.0] $w xscroll moveto [expr ($start - $mid)/ $length] # Mark word in text widget foreach ind $v(map) { if {$start < $v(t1,$ind,end)} break } $p.f.t tag configure $ind -background [$w cget -cursorcolor] $p.f.t see [$p.f.t index ${ind}.first] $p.f.t tag configure $v(oldHighlight) -background "" set v(oldHighlight) $ind } 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: $v(fileName)" if {[info exists v(pattern)] == 0} { set v(pattern) "" } if {[info exists v(selectMode)] == 0} { set v(selectMode) start } if {[info exists v(breakAtLab)] == 0} { set v(breakAtLab) } if {[info exists v(breakAtLen)] == 0} { set v(breakAtLen) 1.0 } pack [ ttk::frame $p.f] -fill both -expand true pack [ text $p.f.t -yscrollcommand [list $p.f.sb set] -font {Courier 16} \ -height 8] -side left -expand true -fill both pack [ scrollbar $p.f.sb -orient vert -command [list $p.f.t yview]] -side left -fill y pack [ ttk::frame $p.b] -fill both -expand true pack [ ttk::frame $p.b.f0] pack [ ttk::radiobutton $p.b.f0.r1 -text [::util::mc "Select start"] -value start \ -variable [namespace current]::${pane}::var(selectMode) \ -command [namespace code [list listSelect $w $pane]]] -side left pack [ ttk::radiobutton $p.b.f0.r2 -text [::util::mc "Select word"] -value word \ -variable [namespace current]::${pane}::var(selectMode) \ -command [namespace code [list listSelect $w $pane]]] \ -padx 20 -side left pack [ ttk::label $p.b.f0.l1 -text "Insert line break at label:"] -side left pack [ ttk::entry $p.b.f0.e1 -width 15 \ -textvar [namespace current]::${pane}::var(breakAtLab)] -side left pack [ ttk::label $p.b.f0.l2 -text "longer than"] -side left pack [ ttk::entry $p.b.f0.e2 -width 4 \ -textvar [namespace current]::${pane}::var(breakAtLen)] -side left pack [ ttk::label $p.b.f0.l3 -text "s"] -side left pack [ ttk::frame $p.b.f1] -pady 20 pack [ ttk::entry $p.b.f1.e -textvar [namespace current]::${pane}::var(pattern)] \ -side left pack [ button $p.b.f1.l -text Find \ -command [namespace code [list find $w $pane]]] -side left pack [ ttk::checkbutton $p.b.f1.cb -text "Match case" \ -variable [namespace current]::${pane}::var(matchCase)] pack [ ttk::label $p.b.l -text "Results:"] pack [ ttk::frame $p.b.f2] -fill both -expand true pack [ scrollbar $p.b.f2.scroll -command "$p.b.f2.list yview"] -side right \ -fill y listbox $p.b.f2.list -yscroll "$p.b.f2.scroll set" -setgrid 1 \ -selectmode extended -height 6 -width 40 pack $p.b.f2.list -side left -expand true -fill both pack [ ttk::frame $p.b.f3] -pady 10 -fill x -expand true pack [ button $p.b.f3.b1 -image $::wsurf::Info(Img,play) \ -command "$w play"] -side left pack [ button $p.b.f3.b2 -image $::wsurf::Info(Img,stop) -command "$w stop"] \ -side left pack [ button $p.b.f3.b3 -text Close -command "destroy $p"] -side right bind $p.b.f1.e [namespace code [list find $w $pane]] bind $p.b.f0.e1 [namespace code [list insertBrowseText $w $pane]] bind $p.b.f0.e2 [namespace code [list insertBrowseText $w $pane]] bind $p.b.f2.list [namespace code [list listSelect $w $pane]] if {$v(pattern) != ""} { find $w $pane } bind $p.b.f2.list "$w play" focus $p.b.f1.e insertBrowseText $w $pane bind $p.f.t [namespace code [list textSelect $w $pane]] } proc trans::insertBrowseText {w pane} { upvar [namespace current]::${pane}::var v set p $v(browseTL) $p.f.t delete 0.0 end foreach ind $v(map) { set label $v(t1,$ind,label) if {[lsearch $v(hide) $label] >= 0} { set label "" } set last [$p.f.t index end-1c] $p.f.t insert end "$label " $p.f.t tag add $ind $last [$p.f.t index end-1c] set v(oldHighlight) "" if {$v(t1,$ind,label) == $v(breakAtLab)} { set start [GetStartByIndex $w $pane $ind] if {$v(t1,$ind,end) - $start > $v(breakAtLen)} { $p.f.t insert end "\n" } # $p.f.t tag add $ind [$p.f.t index end-2c] [$p.f.t index end-1c] # continue } } } proc trans::textSelect {w pane} { upvar [namespace current]::${pane}::var v set p $v(browseTL) set tag [lindex [$p.f.t tag names [$p.f.t index current]] 0] $p.f.t tag configure $tag -background [$w cget -cursorcolor] $p.f.t tag configure $v(oldHighlight) -background "" set v(oldHighlight) $tag foreach ind $v(map) { if {$tag == $ind} { set start [GetStartByIndex $w $pane $ind] set end $v(t1,$ind,end) if {$v(selectMode) == "start"} { $w configure -selection [list $start $start] } else { $w configure -selection [list $start $end] } set length [[$w cget -sound] length -unit seconds] foreach {left right} [$w cget -zoomfracs] break set mid [expr ($right - $left) / 2.0] $w xscroll moveto [expr ($start - $mid)/ $length] } } } 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 [ ttk::label $p.l1 -text "Current transcription file format: $v(format)"] set v(t,format) $v(format) pack [ttk::frame $p.f1] -anchor w ttk::label $p.f1.l -text "New transcription file format:" -anchor w foreach {format loadProc saveProc testProc} $Info(formats) { lappend fmtlist $format } ttk::combobox $p.f1.om -textvariable [namespace current]::${pane}::var(t,format) -values $fmtlist -state readonly pack $p.f1.l $p.f1.om -side left -padx 3 pack [ttk::frame $p.f] pack [ ttk::button $p.f.b1 -text OK -command [namespace code [list doConvert $w $pane]]\n[list destroy $p]] -side left -padx 3 pack [ ttk::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)} { set v(playIndex) 0 set v(oldHighlight) 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)} { $c itemconf g$v(oldHighlight) -fill $v(bgColor) } } } return } set s [$w cget -sound] foreach pane [$w _getPanes] { upvar [namespace current]::${pane}::var v if {$v(drawTranscription) && ($v(highlight) || [info exists v(browseTL)])} { set cursorpos [$pane cget -cursorpos] set c [$pane canvas] set ind [lindex $v(map) $v(playIndex)] while (1) { set ind [lindex $v(map) $v(playIndex)] if {$ind == ""} return if {$cursorpos < $v(t1,$ind,end)} break incr v(playIndex) } if {$ind != "" && $v(oldHighlight) != $ind} { if {$v(highlight)} { $c itemconf g$ind -fill [$w cget -cursorcolor] $c itemconf g$v(oldHighlight) -fill $v(bgColor) } if {[info exists v(browseTL)] && [winfo exists $v(browseTL)]} { set p $v(browseTL) $p.f.t tag configure $ind -background [$w cget -cursorcolor] $p.f.t see [$p.f.t index ${ind}.first] $p.f.t tag configure $v(oldHighlight) -background "" } set v(oldHighlight) $ind } } } 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] set start 0 set basefn [$w getInfo fileName] if {$basefn!=""} { set dir $basefn.split file mkdir $dir } else { set dir $::env(HOME) } set ii 0 foreach ind $v(map) { set end [expr {int($v(t1,$ind,end) * [$s cget -rate])}] $s write $dir/[util::zpad $ii 6]$v(t1,$ind,label).wav -start $start -end $end set start $end incr ii } } wavesurfer-1.8.8p5/src/plugins/transcription_format_htk.plug000066400000000000000000000233751325326000200244470ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # # wsurf::RegisterPlugin transcription_format_htk \ -description "HTK transcription format handler\ used by the transcription plug-in. Note that there are special options\ available for handling HTK master label files. See the HTK pane in the\ properties dialog." \ -panecreatedproc transcription_format_htk::paneCreated \ -panedeletedproc transcription_format_htk::paneDeleted \ -propertiespageproc transcription_format_htk::propertyPane \ -applypropertiesproc transcription_format_htk::applyProperties \ -getconfigurationproc transcription_format_htk::getConfiguration \ -getoptproc transcription_format_htk::getopt \ -before transcription # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) HTK \ transcription_format_htk::load \ transcription_format_htk::save \ transcription_format_htk::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_htk { variable Info set Info(mlfs) {} } proc transcription_format_htk::paneCreated {w pane} { variable Info namespace eval [namespace current]::${pane} { variable var } upvar [namespace current]::${pane}::var v set v(mlf) "" set v(matchComponents) 1 set v(level) 1 set v(alternative) 1 set v(hideQuotes) 1 set v(hideTriphoneContext) 1 } proc transcription_format_htk::paneDeleted {w pane} { namespace delete [namespace current]::${pane} } proc transcription_format_htk::load {w pane} { variable Info upvar ::wsurf::trans::${pane}::var v upvar [namespace current]::${pane}::var t set map {} set header "" set labelfile "" set end 0 if {$Info(mlfs) != ""} { set paneNo -1 foreach pane [$w _getPanes] { upvar ::wsurf::trans::${pane}::var u if {$u(drawTranscription)} { if {$u(format) == "HTK"} { incr paneNo } } } if {[lindex $Info(mlfs) $paneNo] != ""} { set t(mlf) [lindex $Info(mlfs) $paneNo] } } # First try reading label file if it exists if {[file readable $v(fileName)] && \ [file isfile $v(fileName)]} { if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in } } elseif {$t(mlf) != ""} { # Otherwise, if an MLF has been specified, search it # If it seems to be a pipe proceed to open it, otherwise make sure it # is a readable file if {[string match {|*} $t(mlf)] == 0} { if {!([file readable $t(mlf)] && \ [file isfile $t(mlf)])} { return } } if {[catch {open $t(mlf)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } gets $in head if {[string match -nocase "#!MLF!#" $head] == 0} { close $in return "$t(mlf) is not a valid MLF file" } if {$t(matchComponents) == 1} { set fn *$v(fileName) } else { set fn [$w getInfo fileName] set tmp [file split $fn] if {$t(matchComponents) >= [llength $tmp]} { set tmp [file join [file dirname $fn] $v(fileName)] } else { set idx [expr [llength $tmp] - $t(matchComponents)] set tmp [eval file join [lrange $tmp $idx end-1] $v(fileName)] } set fn "*$tmp" } gets $in row while {[eof $in] == 0} { set row [string trim $row " \t\""] if {[string match [file join "." $fn] $row] \ || [string match $fn $row]} { break } gets $in row } gets $in row set labelfile "" while {[string match . [string trim $row]] == 0 && [eof $in] == 0} { append labelfile "$row\n" gets $in row } if {[string match {|*} $t(mlf)] == 1} { while {[eof $in] == 0} { gets $in row } } close $in } } # Format decoding loop set alt 1 set i 0 foreach row [split $labelfile \n] { if {[regexp {///} $row dummy]} { incr alt } if {$t(alternative) != $alt} continue set rest "" if {$t(level) == 1} { if {[scan $row {%f %f %s %s} start end label rest] >= 3} { set end [expr {$end/10000000.0}] set v(t1,$i,end) $end if {$t(hideQuotes)} { set label [string trim $label \"] } if {$t(hideTriphoneContext)} { regexp {^(.+)\-(.+)$} $label dummy dummy label regexp {^(.+)\+(.+)$} $label dummy label dummy } set v(t1,$i,label) $label set v(t1,$i,rest) $rest lappend map $i if {$i == 0} { set v(t1,start) [expr {$start/10000000.0}] } incr i } } else { set n [scan $row {%d %d %s %s} start end junk label] if {$n >= 3} { set end [expr {$end/10000000.0}] } if {$n == 4} { set v(t1,$i,end) $end set v(t1,$i,label) $label set v(t1,$i,rest) "" lappend map $i if {$i == 0} { set v(t1,start) [expr {$start/10000000.0}] } incr i } elseif {$n == 3} { set v(t1,[expr $i-1],end) $end } } } set v(t1,end) $end set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) HTK } proc transcription_format_htk::save {w pane} { upvar ::wsurf::trans::${pane}::var v if {[catch {open $v(fileName) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} set start [expr {$v(t1,start)*10000000.0}] for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [expr {$v(t1,$ind,end)*10000000.0}] set label $v(t1,$ind,label) set rest $v(t1,$ind,rest) if {$rest != ""} { puts $out [format "%.0f %.0f %s %s" $start $end $label $rest] } else { puts $out [format "%.0f %.0f %s" $start $end $label] } set start $end } close $out } set v(headerFmt) HTK $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_htk::test {w pane rows} { set lastrow [lindex $rows end] if {[regexp {\s*(\d+)\s+(\d+)\s+\S+} $lastrow a b c] == 1} { if {[info exists c] && $c > 3500000} { return HTK } } } proc transcription_format_htk::propertyPane {w pane} { upvar ::wsurf::trans::${pane}::var v if {$pane==""} return if {$v(drawTranscription)} { if {$v(format) == "HTK"} { return [list "HTK" [namespace code drawHTKPage]] } } } proc transcription_format_htk::applyProperties {w pane} { if {[string match *wavebar $pane]} return upvar [namespace current]::${pane}::var t upvar ::wsurf::trans::${pane}::var v if {[info exists v(drawTranscription)]} { if {$v(drawTranscription)} { foreach var [list mlf matchComponents level alternative hideQuotes \ hideTriphoneContext] { if {[info exists t(t,$var)]} { if {[string compare $t(t,$var) $t($var)]!=0} { set doReload 1 set t($var) $t(t,$var) } } } if {[info exists doReload]} { ::wsurf::trans::openTranscriptionFile $w $pane [$w getInfo fileName] soundfile ::wsurf::_redrawPane $w $pane } } } } proc transcription_format_htk::drawHTKPage {w pane p} { upvar [namespace current]::${pane}::var v foreach f [winfo children $p] { destroy $f } foreach var [list mlf matchComponents level alternative hideQuotes \ hideTriphoneContext] { set v(t,$var) $v($var) } pack [frame $p.f1] -anchor w label $p.f1.l -text "Master Label File:" -anchor w entry $p.f1.e -textvariable [namespace current]::${pane}::var(t,mlf) -wi 25 button $p.f1.b -text Browse... -command \ [namespace code [list browseMLF $w $pane mlf]] pack $p.f1.l $p.f1.e $p.f1.b -side left -padx 3 pack [frame $p.f2] -anchor w label $p.f2.l -text "Number of filename components in pattern match:" \ -anchor w ttk::combobox $p.f2.om -textvariable [namespace current]::${pane}::var(t,matchComponents) -values {1 2} -state readonly pack $p.f2.l $p.f2.om -side left -padx 3 pack [frame $p.f3] -anchor w label $p.f3.l -text "Read label level:" -anchor w -width 23 ttk::combobox $p.f3.om -textvariable [namespace current]::${pane}::var(t,level) -values {1 2} pack $p.f3.l $p.f3.om -side left -padx 3 stringPropItem $p.f4 "Read label alternative:" 23 5 \ "" [namespace current]::${pane}::var(t,alternative) booleanPropItem $p.f5 "Hide quotes in labels" "" \ [namespace current]::${pane}::var(t,hideQuotes) booleanPropItem $p.f6 "Hide triphone context in labels" "" \ [namespace current]::${pane}::var(t,hideTriphoneContext) } proc transcription_format_htk::browseMLF {w pane prop} { upvar [namespace current]::${pane}::var v set file [file tail $v(mlf)] set path [file dirname $v(mlf)] set types { {{HTK MLF Files} {.mlf}} {{All Files} * } } set fileName [tk_getOpenFile -title "Choose MLF" -initialfile $file \ -initialdir $path -filetypes $types] if {$fileName != ""} { set v(t,$prop) $fileName } } proc transcription_format_htk::getConfiguration {w pane} { upvar [namespace current]::${pane}::var v upvar ::wsurf::trans::${pane}::var u set var [namespace current]::\${pane}::var set result {} if {$pane != "" && $u(drawTranscription)} { append result \ "set ${var}(matchComponents) $v(matchComponents)" "\n" \ "set ${var}(level) $v(level)" "\n" \ "set ${var}(mlf) \"$v(mlf)\"" "\n" \ "set ${var}(hideQuotes) $v(hideQuotes)" "\n" \ "set ${var}(hideTriphoneContext) $v(hideTriphoneContext)" "\n" \ "set ${var}(alternative) $v(alternative)" "\n" } return $result } proc transcription_format_htk::getopt {arglistVar} { variable Info upvar 1 $arglistVar argv while {1} { if {[cmdline::getopt argv {mlf.arg} opt arg] == 1} { lappend Info(mlfs) $arg continue } break } } wavesurfer-1.8.8p5/src/plugins/transcription_format_isis.plug000066400000000000000000000065061325326000200246250ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (C) 2001 Erhard Rank # # This file is part of the WaveSurfer package. # The latest version can be found at http://www.speech.kth.se/wavesurfer/ # # ----------------------------------------------------------------------------- wsurf::RegisterPlugin transcription_format_isis \ -description "ISIS transcription format handler\ used by the transcription plug-in." # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) ISIS \ transcription_format_isis::load \ transcription_format_isis::save \ transcription_format_isis::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_isis { } proc transcription_format_isis::load {w pane} { upvar ::wsurf::trans::${pane}::var v set map {} set i 0 set header "" set rate [[$w cget -sound] cget -rate] set end 0 if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in # Format decoding loop set getHead 1 foreach row [split $labelfile \n] { if {$getHead == 1} { set header [lappend header $row] if {[regexp -line -- {FE:\s*(\d+)\s*} $row all frate]} { if { $frate != "" } { set rate $frate } set getHead 0 } continue } set label "" set rest "" if {[regexp -nocase -expanded -line -- \ {(\d*)\s+([^\s]*)\s*(.*)} $row \ all end label rest]} { set v(t1,$i,end) [expr {double($end)/double($rate)}] set v(t1,$i,label) $label set v(t1,$i,rest) $rest lappend map $i incr i } } } if {$i == 0} { set header "" } set v(t1,end) [expr {double($end)/double($rate)}] set v(t1,start) 0.0 set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) ISIS } proc transcription_format_isis::save {w pane} { upvar ::wsurf::trans::${pane}::var v if {[catch {open $v(fileName) w} out]} { return $out } else { set rate [[$w cget -sound] cget -rate] if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} if {[string compare $v(format) $v(headerFmt)] == 0 && $v(header) != ""} { puts $out [join $v(header) \n] regexp -- {\s*FE:\s*(\d*)\s*} $v(header) all frate if { $frate != "" } { set rate $frate } } else { set name [file tail [file rootname $v(fileName)]] puts $out "PTS:LABEL" puts $out "FE: $rate" } for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [expr {round($v(t1,$ind,end)*double($rate))}] set label $v(t1,$ind,label) if {[info exists v(t1,$ind,rest)] && $v(t1,$ind,rest) != "" } { set rest " $v(t1,$ind,rest)" } else { set rest "" } puts $out [format "%d $label$rest" $end] } close $out } set v(headerFmt) ISIS $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_isis::test {w pane rows} { if {[string equal "PTS:LABEL" [lindex $rows 0]]} { return ISIS } } wavesurfer-1.8.8p5/src/plugins/transcription_format_phondat.plug000066400000000000000000000073221325326000200253100ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # wsurf::RegisterPlugin transcription_format_phondat \ -description "PHONDAT/BOSS transcription formats handler\ used by the transcription plug-in." # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) PHONDAT \ transcription_format_phondat::load \ transcription_format_phondat::save \ transcription_format_phondat::test \ BOSS \ transcription_format_phondat::load \ transcription_format_phondat::save \ transcription_format_phondat::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_phondat { } proc transcription_format_phondat::load {w pane} { upvar ::wsurf::trans::${pane}::var v set map {} set i 0 set header "" set rate [[$w cget -sound] cget -rate] set end 0 set lastlabel "" set lastrest "" if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in # Format decoding loop if {[string match BOSS $v(format)]} { set getHead 0 } else { set getHead 1 } set first 0 foreach row [split $labelfile \n] { if {$getHead == 1} { set header [lappend header $row] if {[string match hend $row]} { set getHead 0 } continue } set rest "" if {[scan $row {%d %s %s} start label rest] >= 2} { if {$first == 0} { set v(t1,start) [expr {$start/double($rate)}] set lastlabel $label set lastrest $rest set first 1 continue } set end [expr {$start/double($rate)}] set v(t1,$i,end) $end set v(t1,$i,label) $lastlabel set v(t1,$i,rest) $lastrest set lastlabel $label set lastrest $rest lappend map $i incr i } } incr i set v(t1,$i,end) [[$w cget -sound] length -unit seconds] set v(t1,$i,label) $lastlabel set v(t1,$i,rest) $lastrest lappend map $i } if {$i == 0} { set header "" } set v(t1,end) $end set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) $v(format) } proc transcription_format_phondat::save {w pane} { upvar ::wsurf::trans::${pane}::var v set rate [[$w cget -sound] cget -rate] if {[catch {open $v(fileName) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} if {[string match PHONDAT $v(format)]} { if {[string compare $v(format) $v(headerFmt)] == 0 && $v(header) != ""} { puts $out [join $v(header) \n] } else { puts $out "hend" } } set start [expr {int($v(t1,start)*double($rate)+.5)}] for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [expr {int($v(t1,$ind,end)*double($rate)+.5)}] set label $v(t1,$ind,label) if {[info exists v(t1,$ind,rest)]} { puts $out "$start $label $v(t1,$ind,rest)" } else { puts $out "$start $label" } set start $end } close $out } set v(headerFmt) $v(format) $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_phondat::test {w pane rows} { if {[regexp {^(\d+)\t.*$} [lindex $rows 0] a b] == 1} { if {[info exists b]} { return BOSS } } for {set i 0} {$i < [llength $rows]} {incr i} { if {[string equal "hend" [lindex $rows $i]]} { return PHONDAT } } } wavesurfer-1.8.8p5/src/plugins/transcription_format_timit.plug000066400000000000000000000053131325326000200247770ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # wsurf::RegisterPlugin transcription_format_timit \ -description "TIMIT transcription format handler\ used by the transcription plug-in." # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) TIMIT \ transcription_format_timit::load \ transcription_format_timit::save \ transcription_format_timit::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_timit { } proc transcription_format_timit::load {w pane} { upvar ::wsurf::trans::${pane}::var v set map {} set i 0 set header "" set rate [[$w cget -sound] cget -rate] set end 0 if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in # Format decoding loop foreach row [split $labelfile \n] { set rest "" if {[scan $row {%d %d %s %s} start end label rest] >= 3} { set end [expr {$end/double($rate)}] set v(t1,$i,end) $end set v(t1,$i,label) $label set v(t1,$i,rest) $rest lappend map $i if {$i == 0} { set start [expr {$start/double($rate)}] set v(t1,start) $start } incr i } } } set v(t1,end) $end set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) TIMIT } proc transcription_format_timit::save {w pane} { upvar ::wsurf::trans::${pane}::var v set rate [[$w cget -sound] cget -rate] if {[catch {open $v(fileName) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} set start [expr {int($v(t1,start)*double($rate)+.5)}] for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [expr {int($v(t1,$ind,end)*double($rate)+.5)}] set label $v(t1,$ind,label) set rest $v(t1,$ind,rest) if {$rest != ""} { puts $out "$start $end $label $rest" } else { puts $out "$start $end $label" } set start $end } close $out } set v(headerFmt) TIMIT $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_timit::test {w pane rows} { set lastrow [lindex $rows end] if {[regexp {^\s*(\d+)\s+(\d+)\s+\S+} $lastrow a b c] == 1} { if {[info exists c] && $c <= 3500000} { return TIMIT } } } wavesurfer-1.8.8p5/src/plugins/transcription_format_waves.plug000066400000000000000000000107361325326000200250030ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (c) 2000-2017 Jonas Beskow and Kare Sjolander # # This file is part of the WaveSurfer package. # The latest version can be found at http://sourceforge.net/projects/wavesurfer # # wsurf::RegisterPlugin transcription_format_waves \ -description "ESPS/Waves+ transcription format handler\ used by the transcription plug-in." # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) WAVES \ transcription_format_waves::load \ transcription_format_waves::save \ transcription_format_waves::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_waves { } proc transcription_format_waves::sortCmd {a b} { expr [string trimleft $a tmpend,] > [string trimleft $b tmpend,] } proc transcription_format_waves::load {w pane} { upvar ::wsurf::trans::${pane}::var v set map {} set i 0 set header "" set rate [[$w cget -sound] cget -rate] set end 0 # If the sound file is in ESPS format, subtract start_time from each boundary if {[string match SD [[$w cget -sound] cget -fileformat]]} { set offset [[$w cget -sound] config -start_time] } else { set offset 0.0 } if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in # Format decoding loop set getHead 1 foreach row [split $labelfile \n] { if {$getHead == 1} { set header [lappend header $row] if {[string match "#" $row]} { set getHead 0 } continue } set rest "" if {[regexp -nocase -expanded -line -- \ {\s*([\d\.\+\-Ee]*)\s+([-\d]*)\s+([^;]*)(.*)} $row \ all end color label rest]} { set end [expr {$end - $offset}] set v(tmp,$i,end) $end set v(tmp,$i,label) $label set v(tmp,$i,color) $color set v(tmp,$i,rest) $rest set v(tmpend,$end) $i incr i } } } set i 0 foreach e [lsort -command [namespace code sortCmd] [array names v tmpend,*]] { set index $v(tmpend,[lindex [split $e ,] end]) set v(t1,$i,end) $v(tmp,$index,end) set end $v(tmp,$index,end) set v(t1,$i,label) $v(tmp,$index,label) set v(t1,$i,color) $v(tmp,$index,color) set v(t1,$i,rest) $v(tmp,$index,rest) lappend map $i incr i } array unset v tmp,* array unset v tmpend,* if {$i == 0} { set header "" } set v(t1,end) $end set v(t1,start) 0.0 set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) WAVES } proc transcription_format_waves::save {w pane} { upvar ::wsurf::trans::${pane}::var v # If the sound file is in ESPS format, add start_time to each boundary if {[string match SD [[$w cget -sound] cget -fileformat]]} { set offset [[$w cget -sound] config -start_time] } else { set offset 0.0 } if {[catch {open $v(fileName) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} if {[string compare $v(format) $v(headerFmt)] == 0 && $v(header) != ""} { puts $out [join $v(header) \n] } else { set name [file tail [file rootname $v(fileName)]] set date [clock format [clock seconds] -format "%a %b %d %H:%M:%S %Y"] puts $out "signal $name" puts $out "type 0\ncolor 121" puts $out "comment created using WaveSurfer $date" puts $out "font -misc-*-bold-*-*-*-15-*-*-*-*-*-*-*" puts $out "separator ;\nnfields 1\n#" } for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [expr {$v(t1,$ind,end) + $offset}] set label $v(t1,$ind,label) if {[info exists v(t1,$ind,color)]} { set color $v(t1,$ind,color) } else { set color 121 } if {[info exists v(t1,$ind,rest)] && $v(t1,$ind,rest) != ""} { set rest $v(t1,$ind,rest) set end [format " %.6f " $end] puts $out "$end $color $label $rest" } else { set end [format " %.6f " $end] puts $out "$end $color $label" } } close $out } set v(headerFmt) WAVES $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_waves::test {w pane rows} { for {set i 0} {$i < [llength $rows]} {incr i} { if {[string equal "\#" [lindex $rows $i]]} { return WAVES } } } wavesurfer-1.8.8p5/src/plugins/transcription_format_ws.plug000066400000000000000000000146061325326000200243070ustar00rootroot00000000000000# -*-Mode:Tcl-*- # # Copyright (C) 2002-2005 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_format_ws \ -description "Format handler for the native WaveSurfer transcription format. This is used by the transcription plug-in to import and export transcription files in this format. The WaveSurfer format consists of the fields \'start_time end_time label\', where the time boundaries are in seconds (decimal) and label is the rest of the line." \ -getoptproc transcription_format_ws::getopt \ -before transcription # ----------------------------------------------------------------------------- namespace eval trans { lappend Info(formats) WaveSurfer \ transcription_format_ws::load \ transcription_format_ws::save \ transcription_format_ws::test } # ----------------------------------------------------------------------------- namespace eval transcription_format_ws { variable Info set Info(tfas) {} } proc transcription_format_ws::load {w pane} { variable Info upvar ::wsurf::trans::${pane}::var v set map {} set i 0 set header "" set end 0 set tfa "" set labelfile "" set v(source) "" if {$Info(tfas) != ""} { set paneNo -1 foreach pane2 [$w _getPanes] { upvar ::wsurf::trans::${pane2}::var u if {$u(drawTranscription)} { if {$u(format) == "WaveSurfer"} { incr paneNo } if {$pane == $pane2} break } } if {[llength $Info(tfas)] > 1} { if {[lindex $Info(tfas) $paneNo] != ""} { set tfa [lindex $Info(tfas) $paneNo] } } else { set tfa [lindex $Info(tfas) 0] } } # First try reading label file if it exists if {[file readable $v(fileName)] && \ [file isfile $v(fileName)]} { if {[catch {open $v(fileName)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } if {[catch {set labelfile [read $in]}]} { return 0 } close $in } set v(source) labelfile } elseif {$tfa != ""} { # Otherwise, if a TFA has been specified, search it # If it seems to be a pipe proceed to open it, otherwise make sure it # is a readable file if {[string match {|*} $tfa] == 0} { if {!([file readable $tfa] && \ [file isfile $tfa])} { return } } if {[catch {open $tfa} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } gets $in row set nComponents [expr [regexp -all {/} $row] - 1] set v(nComponents) $nComponents if {[regexp -all {/} $v(fileName)] == 0 && $nComponents > 0 && \ $v(fullName) != ""} { set name [eval file join [lrange [file split $v(fullName)] \ end-$nComponents end-1]] append name "/$v(fileName)" set exp *$name? } else { set exp *$v(fileName)? } while {[string match $exp $row] == 0 && \ [eof $in] == 0} { gets $in row } gets $in row while {[string match {"*"} $row] == 0 && [eof $in] == 0} { append labelfile $row append labelfile \n gets $in row } if {[string match {|*} $tfa] == 1} { while {[eof $in] == 0} { gets $in row } } close $in set v(source) tfafile set v(tfa) $tfa } } # Format decoding loop set lastend -1 foreach row [split $labelfile \n] { if {[scan $row {%f %f %[^\]} start end label] >= 3} { # Next label not contiguous with last one, insert empty label if {$lastend != $start && $lastend != -1} { set v(t1,$i,end) $start set v(t1,$i,label) "" set v(t1,$i,rest) "" lappend map $i incr i } set v(t1,$i,end) $end set v(t1,$i,label) $label set v(t1,$i,rest) "" lappend map $i if {$i == 0} { set v(t1,start) $start } set lastend $end incr i if {$start > $end} { puts "Error in label file, line $i: $row" # return "Error in label file, line $i: $row" } } } if {$end > 7200} { set end 7200 } set v(t1,end) $end set v(nLabels) $i set v(map) $map set v(header) $header set v(headerFmt) WaveSurfer } proc transcription_format_ws::save {w pane} { upvar ::wsurf::trans::${pane}::var v set outlines {} set start 0.0000000 for {set i 0} {$i < $v(nLabels)} {incr i} { set ind [lindex $v(map) $i] set end [format "%.7f" $v(t1,$ind,end)] set label $v(t1,$ind,label) # Empty labels are removed, will generate "holes" in the transcription file if {$label != ""} { lappend outlines "$start $end $label" } set start $end } # Save label file if {[info exists v(source)] && [string match tfafile $v(source)]} { if {[catch {open $v(tfa)} in]} { return $in } else { if {[info command encoding] != ""} { fconfigure $in -encoding $v(encoding) } set lines [split [read -nonewline $in] \n] close $in if {[catch {open $v(tfa) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} set copyLine 1 foreach line $lines { set name [eval file join [lrange [file split $v(fullName)] \ end-$v(nComponents) end-1]] append name "/[lindex [file split $v(fileName)] end]" set exp *$name? if {[string match $exp $line] == 1} { set copyLine 0 puts $out $line puts $out [join $outlines \n] set line junk } if {$copyLine == 0 && [string match \"* $line]} { set copyLine 1 } if {$copyLine} { puts $out $line } } close $out } } } else { if {[catch {open $v(fileName) w} out]} { return $out } else { if {[info command encoding] != ""} { fconfigure $out -encoding $v(encoding) } fconfigure $out -translation {auto lf} puts $out [join $outlines \n] close $out } } set v(headerFmt) WaveSurfer $w messageProc \ "Wrote $v(fileName) in $v(headerFmt) format" return } proc transcription_format_ws::test {w pane rows} { set lastrow [lindex $rows end] if {[regexp {(\d+\.\d+)\s+(\d+\.\d+)\s+\S+} $lastrow a b c] == 1} { if {[info exists c]} { return WaveSurfer } } } proc transcription_format_ws::getopt {arglistVar} { variable Info upvar 1 $arglistVar argv while {1} { if {[cmdline::getopt argv {tfa.arg} opt arg] == 1} { lappend Info(tfas) $arg continue } break } } wavesurfer-1.8.8p5/src/wsurf/000077500000000000000000000000001325326000200161145ustar00rootroot00000000000000wavesurfer-1.8.8p5/src/wsurf/cmdline.tcl000066400000000000000000000167521325326000200202460ustar00rootroot00000000000000# cmdline.tcl -- # # This package provides a utility for parsing command line # arguments that are processed by our various applications. # It also includes a utility routine to determine the app # name for use in command line errors. # # Copyright (c) 1998-2000 by Ajuba Solutions. # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: cmdline.tcl,v 1.1 2001/01/16 10:29:06 kare Exp $ package provide cmdline 1.1 namespace eval cmdline { namespace export getArgv0 getopt getfiles getoptions usage } # Load the typed versions of these functions #source [file join [file dirname [info script]] typedCmdline.tcl] # cmdline::getopt -- # # The cmdline::getopt works in a fashion like the standard # C based getopt function. Given an option string and a # pointer to an array or args this command will process the # first argument and return info on how to procede. # # Arguments: # argvVar Name of the argv list that you # want to process. If options are found the # arg list is modified and the processed arguments # are removed from the start of the list. # optstring A list of command options that the application # will accept. If the option ends in ".arg" the # getopt routine will use the next argument as # an argument to the option. Otherwise the option # is a boolean that is set to 1 if present. # optVar The variable pointed to by optVar # contains the option that was found (without the # leading '-' and without the .arg extension). # valVar Upon success, the variable pointed to by valVar # contains the value for the specified option. # This value comes from the command line for .arg # options, otherwise the value is 1. # If getopt fails, the valVar is filled with an # error message. # # Results: # The getopt function returns 1 if an option was found, 0 if no more # options were found, and -1 if an error occurred. proc cmdline::getopt {argvVar optstring optVar valVar} { upvar 1 $argvVar argsList upvar 1 $optVar option upvar 1 $valVar value # default settings for a normal return set value "" set option "" set result 0 # check if we're past the end of the args list if {[llength $argsList] != 0} { # if we got -- or an option that doesn't begin with -, return (skipping # the --). otherwise process the option arg. switch -glob -- [set arg [lindex $argsList 0]] { "--" { set argsList [lrange $argsList 1 end] } "-*" { set option [string range $arg 1 end] if {[lsearch -exact $optstring $option] != -1} { # Booleans are set to 1 when present set value 1 set result 1 set argsList [lrange $argsList 1 end] } elseif {[lsearch -exact $optstring "$option.arg"] != -1} { set result 1 set argsList [lrange $argsList 1 end] if {[llength $argsList] != 0} { set value [lindex $argsList 0] set argsList [lrange $argsList 1 end] } else { set value "Option \"$option\" requires an argument" set result -1 } } else { set value "Illegal option \"$option\"" set result -1 } } } } return $result } # cmdline::getoptions -- # # Process a set of command line options, filling in defaults # for those not specified. This also generates an error message # that lists the allowed flags if an incorrect flag is specified. # # Arguments: # arglistVar The name of the argument list, typically argv # optlist A list-of-lists where each element specifies an option # in the form: # flag default comment # If flag ends in ".arg" then the value is taken from the # command line. Otherwise it is a boolean and appears in # the result if present on the command line. If flag ends # in ".secret", it will not be displayed in the usage. # usage Text to include in the usage display. Defaults to # "options:" # # Results # Name value pairs suitable for using with array set. proc cmdline::getoptions {arglistVar optlist {usage options:}} { upvar 1 $arglistVar argv set opts {? help} foreach opt $optlist { set name [lindex $opt 0] if {[regsub .secret$ $name {} name] == 1} { # Need to hide this from the usage display and getopt } lappend opts $name if {[regsub .arg$ $name {} name] == 1} { # Set defaults for those that take values. set default [lindex $opt 1] set result($name) $default } else { # The default for booleans is false set result($name) 0 } } set argc [llength $argv] while {[set err [cmdline::getopt argv $opts opt arg]]} { if {$err < 0} { error [cmdline::usage $optlist $usage] } set result($opt) $arg } if {[info exist result(?)] || [info exists result(help)]} { error [cmdline::usage $optlist $usage] } return [array get result] } # cmdline::usage -- # # Generate an error message that lists the allowed flags. # # Arguments: # optlist As for cmdline::getoptions # usage Text to include in the usage display. Defaults to # "options:" # # Results # A formatted usage message proc cmdline::usage {optlist {usage {options:}}} { set str "[cmdline::getArgv0] $usage\n" foreach opt [concat $optlist \ {{help "Print this message"} {? "Print this message"}}] { set name [lindex $opt 0] if {[regsub .secret$ $name {} name] == 1} { # Hidden option continue } if {[regsub .arg$ $name {} name] == 1} { set default [lindex $opt 1] set comment [lindex $opt 2] append str [format " %-20s %s <%s>\n" "-$name value" \ $comment $default] } else { set comment [lindex $opt 1] append str [format " %-20s %s\n" "-$name" $comment] } } return $str } # cmdline::getfiles -- # # Given a list of file arguments from the command line, compute # the set of valid files. On windows, file globbing is performed # on each argument. On Unix, only file existence is tested. If # a file argument produces no valid files, a warning is optionally # generated. # # This code also uses the full path for each file. If not # given it prepends [pwd] to the filename. This ensures that # these files will never comflict with files in our zip file. # # Arguments: # patterns The file patterns specified by the user. # quiet If this flag is set, no warnings will be generated. # # Results: # Returns the list of files that match the input patterns. proc cmdline::getfiles {patterns quiet} { set result {} if {$::tcl_platform(platform) == "windows"} { foreach pattern $patterns { regsub -all {\\} $pattern {\\\\} pat set files [glob -nocomplain -- $pat] if {$files == {}} { if {! $quiet} { puts stdout "warning: no files match \"$pattern\"" } } else { foreach file $files { lappend result $file } } } } else { set result $patterns } set files {} foreach file $result { # Make file an absolute path so that we will never conflict # with files that might be contained in our zip file. set fullPath [file join [pwd] $file] if {[file isfile $fullPath]} { lappend files $fullPath } elseif {! $quiet} { puts stdout "warning: no files match \"$file\"" } } return $files } # cmdline::getArgv0 -- # # This command returns the "sanitized" version of argv0. It will strip # off the leading path and remove the ".bin" extensions that our apps # use because they must be wrapped by a shell script. # # Arguments: # None. # # Results: # The application name that can be used in error messages. proc cmdline::getArgv0 {} { global argv0 set name [file tail $argv0] return [file rootname $name] } wavesurfer-1.8.8p5/src/wsurf/htmllib.tcl000066400000000000000000001241011325326000200202520ustar00rootroot00000000000000package provide wsurf 1.8 # Simple HTML display library by Stephen Uhler (stephen.uhler@sun.com) # Copyright (c) 1995 by Sun Microsystems # Version 0.3 Fri Sep 1 10:47:17 PDT 1995 # # Modified to support some 8.0 and 8.1 font conventions by Clif Flynt # (clif@cflynt.com) # Modifications copyright (c) 1998 by Flynt Consulting Services, # Version 0.3.1 Jan 10, 1999 # # Modified rendering of ,
, and