6 # SpeakGoodChinese: sgc2.praat is the master GUI of SpeakGoodChinese
7 # It is written in Praat script for the Demo window
9 # Copyright (C) 2007-2010 R.J.J.H. van Son and 2010 the Netherlands Cancer Institute
10 # The SpeakGoodChinese team are:
11 # Guangqin Chen, Zhonyan Chen, Stefan de Koning, Eveline van Hagen,
12 # Rob van Son, Dennis Vierkant, David Weenink
14 # This program is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
28 # The real application name
29 sgc2.demoAppName$ = "SpeakGoodChinese2"
31 # Define variable that might be reset in Initialise*.praat
32 if not variableExists("build_SHA$")
36 # These are simply "useful" defaults
37 localTableDir$ = "Data"
38 buttonsTableName$ = "MainPage"
39 configTableName$ = "Config"
45 te.buttonPressValue = 0
46 samplingFrequency = 44100
49 # Pop-Up window colors
50 sgc2.popUp_bordercolor$ = "{0.5,0.5,1}"
51 sgc2.popUp_backgroundcolor$ = "{0.9,0.9,1}"
53 # If running in a packed script binary
54 if index_regex(preferencesDirectory$, "(?i'sgc2.demoAppName$')$")
55 preferencesAppDir$ = preferencesDirectory$
56 elsif index_regex(preferencesDirectory$, "[pP]raat(\-dir| Prefs)?$")
57 # If running as a Praat script, create a new preferences directory
59 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
61 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
64 # It has to go somewhere. Make a subdirectory in the current preferences directory
65 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
69 # Parameters for isolating recorded speech from noise
70 # Should be mostly left alone unless you are using ultra clean
71 # or very noisy recordings
77 # Set up button height
83 defaultFont$ = "Helvetica"
89 # Load supporting scripts
90 # Load tables in script format
91 include CreateTables.praat
92 include CreateWordlists.praat
93 # Set up system and load preferences
94 include InitialiseSGC2.praat
95 # Include the main page buttons and procedures
96 include MainPage.praat
97 # Include the configuration page buttons and procedures
100 # Start instruction loop
101 while demoWaitForInput()
109 call buttonClicked 'buttons$' '.clickX' '.clickY'
110 .label$ = buttonClicked.label$
111 elsif demoKeyPressed()
112 .pressed$ = demoKey$()
113 call keyPressed 'buttons$' '.pressed$'
114 .label$ = keyPressed.label$
117 # You cannot select a text field
118 if startsWith(.label$, "$")
124 te.buttonPressValue = 0
126 call Draw_button 'buttons$' '.label$' 1
127 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
129 call Draw_button 'buttons$' '.label$' 'te.buttonPressValue'
136 ########################################################
138 # Definitions of procedures
140 ########################################################
143 procedure process_label .label$ .clickX .clickY .pressed$
144 # Prcoess the command
145 if .label$ <> "" and not startsWith(.label$,"!")
146 .label$ = replace_regex$(.label$, "^[#]", "", 0)
147 .label$ = replace$(.label$, "_", " ", 0)
148 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
153 procedure init_buttons
155 call Draw_all_buttons 'buttons$'
161 procedure Draw_all_buttons .table$
162 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
163 select Table '.table$'
164 .numRows = Get number of rows
167 .label$ = Get value... '.row' Label
168 if not startsWith(.label$, "!")
170 # Determine the "pressed" state of a button
171 # A variable with the same name as the button will act as a
173 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
174 # Simple boolean variables
175 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
177 if '.variableName$' > 0
180 elsif '.variableName$' < 0
183 # Complex buttons with an variableName+'_'+value structure
184 # varableName$ -> name of button, e.g., "language"
185 elsif index(.variableName$, "_")
186 .generalVar$ = left$(.variableName$, rindex(.variableName$, "_") - 1)
187 .currentVariableName$ = .generalVar$
189 if variableExists(.generalVar$+"$")
190 .currentVariableName$ = .generalVar$ + "$"
192 # Remove one level of indirection
193 if variableExists(.currentVariableName$)
194 if index(.currentVariableName$, "$")
195 .currentVariableName$ = '.currentVariableName$'
197 .currentValue = '.currentVariableName$'
198 .currentVariableName$ = "'.currentValue'"
200 # Remove next level of indirection
201 .currentContent$ = "'.currentVariableName$'"
202 if .currentContent$ = "_DISABLED_"
205 # Reconstruct label from current values
206 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
207 # Set PRESSED from label
208 if .variableName$ = .currentLabelValue$
213 # You did erase everything before you started here? So do not do that again
214 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
219 # Draw a button from a predefined button table
220 # Normally, erase the area around a button
221 procedure Draw_button .table$ .label$ .push
222 call Draw_button_internal 1 '.table$' '.label$' '.push'
225 # Use this function if you want to control erasing
226 procedure Draw_button_internal .erase_button_area .table$ .label$ .push
227 # Do not draw invisible buttons starting with #
228 goto NOBUTTON startsWith(.label$, "#")
230 # Scale rounding of rounded rectangles
232 .mm = demo Horizontal wc to mm... '.wc'
233 # Allow to overide ! skip directive
235 if startsWith(.label$, "+")
236 .label$ = right$(.label$, length(.label$)-1)
240 select Table '.table$'
241 .row = Search column... Label '.label$'
243 call emergency_table_exit Button Table '.table$' does not have a row with label '.label$'
246 # Perspective shift sizes
251 .shiftDown = 0.1*buttonbevel
252 .shiftX = -0.2*buttonbevel
253 .shiftY = 0.40*buttonbevel
256 # Set drawing parameters
257 .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
258 .topLineColorUp$ = "Black"
259 .topLineWidthUp = 1.5
260 .topBackGroundColorDown$ = "{0.89,0.89,0.94}"
261 .topLineColorDown$ = "{0.2,0.2,0.2}"
262 .topLineWidthDown = 2.0
263 .topBackGroundColorDisabled$ = "{0.85,0.85,0.85}"
264 .topLineColorDisabled$ = "{0.70,0.70,0.70}"
265 .topLineWidthDisabled = 1.5
266 .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
267 .flankLineColorUp$ = "{0.2,0.2,0.2}"
268 .flankLineWidthUp = 1.5
269 .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
270 .flankLineColorDown$ = .flankLineColorUp$
271 .flankLineWidthDown = 1.5
272 .buttonFontSize = defaultFontSize
275 .leftX = Get value... '.row' LeftX
276 .rightX = Get value... '.row' RightX
277 .lowY = Get value... '.row' LowY
278 .highY = Get value... '.row' HighY
279 .buttonText$ = Get value... '.row' Text
280 .buttonColor$ = Get value... '.row' Color
281 .buttonDraw$ = Get value... '.row' Draw
282 .buttonKey$ = Get value... '.row' Key
284 .noDraw = startsWith(.label$, "!") or (.leftX < 0) or (.rightX < 0) or (.lowY < 0) or (.highY < 0)
287 if index_regex(.buttonText$, "^![0-9\.]+!")
288 .rotation = extractNumber(.buttonText$, "!")
289 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
292 goto NOBUTTON .noDraw and not .forceDraw
294 # Replace button text with ALERT
296 .buttonText$ = alertText$
299 # Adapt font size to button size
300 .maxWidth = (.rightX - .leftX) - 2
301 .maxHeight = (.highY - .lowY) - 1
303 # Adapt size of button to length of text if necessary
304 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
305 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
306 if adjustFontSizeOnWidth.diff > 0
307 .rightX += adjustFontSizeOnWidth.diff/2
308 .leftX -= adjustFontSizeOnWidth.diff/2
310 call set_font_size '.buttonFontSize'
312 # Adapt size of button to length of text
313 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
314 if adjustFontSizeOnHeight.diff > 0
315 .lowY -= adjustFontSizeOnHeight.diff/2
316 .highY += adjustFontSizeOnHeight.diff/2
318 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
320 # With non-horizontal text, only change font size
321 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
322 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
325 # Reset and erase button area
327 demo Line width... 'defaultLineWidth'
329 .shiftRightX = .rightX - .shiftX
330 .shiftLowY = .lowY - .shiftY
332 if .erase_button_area
333 # Make erase area minutely larger
334 .eraseLeft = .shiftLeftX - 0.01
335 .eraseRight = .shiftRightX + 0.01
336 .eraseBottom = .shiftLowY - 0.01
337 .eraseTop = .shiftHighY + 0.01
338 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
341 # If label starts with "$", it is a text field. Then do not draw the button
342 if not startsWith(.label$, "$")
343 # Give some depth to button: Draw flank outline
344 if .shiftDown or .shiftX or .shiftY
346 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
347 demo Colour... '.flankLineColorUp$'
348 demo Line width... '.flankLineWidthUp'
350 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
351 demo Colour... '.flankLineColorDown$'
352 demo Line width... '.flankLineWidthDown'
354 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
357 # Button Down will shift the top perspective
359 # Draw the button top
361 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
362 demo Colour... '.topLineColorUp$'
363 demo Line width... '.topLineWidthUp'
365 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
366 demo Colour... '.topLineColorDisabled$'
367 demo Line width... '.topLineWidthDisabled'
371 .rightX += .shiftDown
375 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
376 demo Colour... '.topLineColorDown$'
377 demo Line width... '.topLineWidthDown'
379 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
382 # The button text and symbol
383 .horWC = demo Horizontal mm to wc... 10.0
384 .verWC = demo Vertical mm to wc... 10.0
386 .verCoeff = .horWC / .verWC
391 .centerX = (.leftX + .rightX)/2
392 .centerY = .lowY + 0.6*(.highY-.lowY)
393 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
394 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
395 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
396 .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
398 .newText$ = .buttonText$
400 # Variable text field, read corresponding variable
401 if index(.newText$, "$$$")
402 .fieldName$ = replace_regex$(.label$, "^[!$#]", "", 0)
403 .fieldName$ = replace_regex$(.fieldName$, "^(.)", "\l\1", 0)
404 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
405 .newText$ = replace$(.newText$, "$$$", '.varPrefix$'.'.fieldName$'$, 0)
407 if .push = 1 or .push = -1
409 if .buttonColor$ = "Red"
410 .buttonColor$ = "Pink"
411 elsif .buttonColor$ = "Blue"
412 .buttonColor$ = "{0.5,0.5,1}"
414 .buttonColor$ = "Grey"
417 .buttonColor$ = "Maroon"
422 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
423 call set_font_size '.buttonFontSize'
424 demo Colour... '.buttonColor$'
427 .verticalAlignment$ = "Bottom"
429 .anchorY = .lowY + 0.5*(.highY-.lowY)
430 .verticalAlignment$ = "Half"
432 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
436 call set_font_size 'defaultFontSize'
438 demo Line width... 'defaultLineWidth'
443 procedure set_window_title .table$ .addedText$
444 select Table '.table$'
445 .row = Search column... Label !WindowTitle
447 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
449 .windowText$ = Get value... '.row' Text
450 call convert_praat_to_latin1 '.windowText$'
451 .windowText$ = convert_praat_to_latin1.text$
453 demoWindowTitle(.windowText$+ .addedText$)
456 # Handle language setting
457 procedure processLanguageCodes .table$ .label$
459 call Draw_button 'config$' Language_'config.language$' 0
460 call Draw_button 'config$' '.label$' 2
461 # Someone might have to use more than 2 chars for the language code
462 .numChars = length(.label$) - length("Language_")
463 .lang$ = right$(.label$, .numChars)
465 call set_language '.lang$'
469 procedure set_language .lang$
473 select Table 'buttons$'
478 select Table 'config$'
484 call checkTable 'buttonsTableName$'_'.lang$'
485 if checkTable.available
486 config.language$ = .lang$
488 config.language$ = "EN"
491 # Load buttons tables
492 call loadTable 'buttonsTableName$'
493 buttons$ = selected$("Table")
494 Append column... Text
496 Append column... Helptext
497 .numLabels = Get number of rows
498 call loadTable 'buttonsTableName$'_'config.language$'
499 .buttonsLang$ = selected$("Table")
500 for .row to .numLabels
501 select Table 'buttons$'
502 .label$ = Get value... '.row' Label
503 call findLabel '.buttonsLang$' '.label$'
505 select Table '.buttonsLang$'
506 .valueText$ = Get value... 'findLabel.row' Text
507 .valueKey$ = Get value... 'findLabel.row' Key
508 .valueHelp$ = Get value... 'findLabel.row' Helptext
509 select Table 'buttons$'
510 Set string value... '.row' Text '.valueText$'
511 Set string value... '.row' Key '.valueKey$'
512 Set string value... '.row' Helptext '.valueHelp$'
513 elsif index(.label$, "_")
514 # Load alternative language table
515 .startChar = rindex(.label$, "_")
516 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
517 call loadTable 'buttonsTableName$'_'.otherLanguage$'
518 .otherbuttonsLang$ = selected$("Table")
519 call findLabel '.otherbuttonsLang$' '.label$'
521 select Table '.buttonsLang$'
522 .valueText$ = Get value... 'findLabel.row' Text
523 .valueKey$ = Get value... 'findLabel.row' Key
524 .valueHelp$ = Get value... 'findLabel.row' Helptext
525 select Table 'buttons$'
526 Set string value... '.row' Text '.valueText$'
527 Set string value... '.row' Key '.valueKey$'
528 Set string value... '.row' Helptext '.valueHelp$'
530 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
532 select Table '.otherbuttonsLang$'
535 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
538 select Table '.buttonsLang$'
541 # Load configuration table
542 call loadTable 'configTableName$'
543 config$ = selected$("Table")
544 Append column... Text
546 Append column... Helptext
547 .numLabels = Get number of rows
548 call loadTable 'configTableName$'_'config.language$'
549 .configLang$ = selected$("Table")
550 for .row to .numLabels
551 select Table 'config$'
552 .label$ = Get value... '.row' Label
553 call findLabel '.configLang$' '.label$'
555 select Table '.configLang$'
556 .valueText$ = Get value... 'findLabel.row' Text
557 .valueKey$ = Get value... 'findLabel.row' Key
558 .valueHelp$ = Get value... 'findLabel.row' Helptext
559 select Table 'config$'
560 Set string value... '.row' Text '.valueText$'
561 Set string value... '.row' Key '.valueKey$'
562 Set string value... '.row' Helptext '.valueHelp$'
563 elsif index(.label$, "_")
564 .startChar = rindex(.label$, "_")
565 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
566 call loadTable 'configTableName$'_'.otherLanguage$'
567 .otherconfigLang$ = selected$("Table")
568 call findLabel '.otherconfigLang$' '.label$'
570 select Table '.otherconfigLang$'
571 .valueText$ = Get value... 'findLabel.row' Text
572 .valueKey$ = Get value... 'findLabel.row' Key
573 .valueHelp$ = Get value... 'findLabel.row' Helptext
574 select Table 'config$'
575 Set string value... '.row' Text '.valueText$'
576 Set string value... '.row' Key '.valueKey$'
577 Set string value... '.row' Helptext '.valueHelp$'
579 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
581 select Table '.otherconfigLang$'
584 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
587 select Table '.configLang$'
590 # Make language change visible
592 call Draw_config_page
597 ###############################################################
599 # Button Drawing Routines
601 ###############################################################
603 # A stub for buttons that do not have a drawing routine (yet)
604 procedure DrawNull .color$ .x .y .size
607 procedure DrawHelp .color$ .x .y .size
608 .currentFontSize = 24
611 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
612 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
613 call set_font_size '.currentFontSize'
614 demo Colour... '.color$'
615 demo Text... '.x' Centre '.y' Bottom ?
616 call set_font_size 'defaultFontSize'
619 ###############################################################
621 # Button Processing Routines
623 ###############################################################
625 # Search row in table on label
626 procedure findKey .table$ .label$
628 select Table '.table$'
629 .to$ = selected$("Table")
631 .numRows = Get number of rows
633 .currentKey$ = '.to$'$[.i, "Key"]
634 if .label$ = .currentKey$
640 if .row <= 0 and index(.label$, "_") <= 0
641 printline "'.label$'" is not a key in '.table$'
645 procedure findLabel .table$ .label$
647 select Table '.table$'
648 .to$ = selected$("Table")
650 .numRows = Get number of rows
652 .currentKey$ = '.to$'$[.i, "Label"]
653 if .label$ = .currentKey$
659 if .row <= 0 and index(.label$, "_") <= 0
660 call emergency_table_exit "'.label$'" is not a key in '.table$'
665 procedure buttonClicked table$ .x .y
667 select Table 'table$'
668 .bo$ = selected$("Table")
670 .numRows = Get number of rows
673 .leftX = '.bo$'[.i, "LeftX"]
674 .rightX = '.bo$'[.i, "RightX"]
675 .lowY = '.bo$'[.i, "LowY"]
676 .highY = '.bo$'[.i, "HighY"]
677 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
678 .label$ = '.bo$'$[.i, "Label"]
684 procedure keyPressed table$ .pressed$
687 if .pressed$ = "" and not demoShiftKeyPressed()
690 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
691 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
692 select Table 'table$'
693 .bo$ = selected$("Table")
695 .numRows = Get number of rows
698 .key$ = '.bo$'$[.i, "Key"]
699 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
700 .label$ = '.bo$'$[.i, "Label"]
706 procedure count_syllables
709 select Table 'wordlist$'
710 if te.currentWord > 0 and te.currentWord <= te.numberOfWords
711 .sound$ = Get value... 'te.currentWord' Sound
712 .pinyin$ = Get value... 'te.currentWord' Pinyin
714 call add_missing_neutral_tones '.pinyin$'
715 .pinyin$ = add_missing_neutral_tones.pinyin$
716 if index_regex(.pinyin$, "[0-9]") > 0
717 .number = length(replace_regex$(.pinyin$, "[^\d]+([\d]+)", "1", 0))
723 procedure play_sound .sound$
725 select Sound '.sound$'
730 procedure record_sound .recordingTime
731 if .recordingTime <= 0
732 .recordingTime = recordingTime
735 if sgc2.alignedTextGrid > 0
736 select sgc2.alignedTextGrid
738 sgc2.alignedTextGrid = -1
741 # There is a very nasty delay before the first recording starts, do a dummy record
742 if not variableExists("recordingInitialized")
743 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 0.1
745 recordingInitialized = 1
748 demo Paint circle... Red 5 95 2
750 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' '.recordingTime'
751 demo Paint circle... White 5 95 2.5
752 call wipeArea 'wipeFeedbackArea$'
754 # Feedback on recording level
755 .extremum = Get absolute extremum... 0 0 None
756 .radius = 2 * .extremum
765 elsif .extremum >= 0.49
768 .green = .extremum / 0.5
770 .color$ = "{'.red','.green','.blue'}"
771 demo Colour... '.color$'
773 demo Draw circle... 5 95 '.radius'
777 demo Line width... 'defaultLineWidth'
781 Rename... Pronunciation
782 recordedSound$ = selected$("Sound")
783 te.recordedSound = selected("Sound")
786 select Sound 'recordedSound$'
787 te.recordedSound = selected("Sound")
789 # Cut out real sound from silences/noise
790 call sound_detection 'recordedSound$' 'soundMargin'
791 select Sound 'recordedSound$'
792 te.recordedSound = selected("Sound")
794 # Store audio if requested
795 if sgc.saveAudioOn and sgc.saveAudio$ <> ""
796 if sgc.savePerf$ <> "" and fileReadable(sgc.savePerf$)
798 select Table 'wordlist$'
799 if te.currentWord > 0 and te.currentWord <= te.numberOfWords
800 .pinyin$ = Get value... 'te.currentWord' Pinyin
801 .outputName$ = "'sgc.saveAudio$'/'.pinyin$'.wav"
802 select te.recordedSound
803 Save as WAV file: .outputName$
806 # The Audio directory disappeared
812 config.clearSummary = 0
813 config.audioName$ = ""
820 # Select real sound from recording
821 # Uses some global variable
822 procedure sound_detection .sound$ .margin
823 select Sound '.sound$'
824 .soundlength = Get total duration
825 .internalSilence = 2*.margin
827 # Silence and remove noise, DANGEROUS
828 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
829 Rename... Input'.sound$'
831 select TextGrid Input'.sound$'
832 .numberofIntervals = Get number of intervals... 1
833 if .numberofIntervals < 2
834 .numberofIntervals = 0
837 # Remove buzzing and other obnoxious sounds (if switched on)
838 for .i from 1 to .numberofIntervals
839 select TextGrid Input'.sound$'
840 .value$ = Get label of interval... 1 '.i'
841 .begintime = Get starting point... 1 '.i'
842 .endtime = Get end point... 1 '.i'
845 if .value$ = "silent"
846 select Sound '.sound$'
847 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
851 # Select target sound
852 .maximumIntensity = -1
854 for i from 1 to .numberofIntervals
855 select TextGrid Input'.sound$'
857 .value$ = Get label of interval... 1 'i'
858 .begintime = Get starting point... 1 'i'
859 .endtime = Get end point... 1 'i'
861 if .value$ != "silent"
862 if .begintime > .margin
863 .begintime -= .margin
867 if .endtime + .margin < .soundlength
870 .endtime = .soundlength
873 select Sound '.sound$'
874 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
875 Rename... Tmp'.sound$'
877 .newIntensity = Get intensity (dB)
878 if .newIntensity > .maximumIntensity
879 if .maximumIntensity > 0
880 select Sound New'.sound$'
883 select Sound Tmp'.sound$'
884 Rename... New'.sound$'
885 .maximumIntensity = .newIntensity
887 select Sound Tmp'.sound$'
893 if .maximumIntensity > minimumIntensity
894 select Sound '.sound$'
896 select Sound New'.sound$'
898 elsif .maximumIntensity > -1
899 select Sound New'.sound$'
902 select TextGrid Input'.sound$'
905 select Sound '.sound$'
908 procedure end_program
909 call write_preferences ""
916 ######################################################
920 ######################################################
921 procedure config_page
923 demoWindowTitle("Speak Good Chinese: Change settings")
925 call Draw_config_page
927 while (.label$ <> "Return") and demoWaitForInput()
935 call buttonClicked 'config$' '.clickX' '.clickY'
936 .label$ = buttonClicked.label$
937 elsif demoKeyPressed()
938 .pressed$ = demoKey$()
939 call keyPressed 'config$' '.pressed$'
940 .label$ = keyPressed.label$
943 # You cannot select a text field
944 if startsWith(.label$, "$")
950 # Handle push button in process_config
951 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
954 if .label$ = "Return"
964 procedure Draw_config_page
967 if config.showBackground
968 call draw_background Background
971 call Draw_all_buttons 'config$'
972 call set_window_title 'config$'
973 # Set correct buttons (alert)
974 call setConfigMainPage
978 procedure process_config .label$ .clickX .clickY .pressed$
979 if .label$ <> "" and not startsWith(.label$,"!")
980 .label$ = replace_regex$(.label$, "^[#]", "", 0)
981 .label$ = replace$(.label$, "_", " ", 0)
982 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
986 ###############################################################
988 # Presenting help texts
990 ###############################################################
993 procedure help_loop .table$ .redrawProc$
995 call write_help_title '.table$'
998 call Draw_button '.table$' Help 2
1000 while (.label$ <> "Help") and demoWaitForInput()
1005 call buttonClicked '.table$' '.clickX' '.clickY'
1006 .label$ = buttonClicked.label$
1007 elsif demoKeyPressed()
1008 .pressed$ = demoKey$()
1009 call keyPressed '.table$' '.pressed$'
1010 .label$ = keyPressed.label$
1013 if .label$ != "" and .label$ <> "Help"
1021 call Draw_button '.table$' Help 2
1022 call write_help_title '.table$'
1024 # Handle push button in process_config
1025 call write_help_text '.table$' '.label$'
1031 call Draw_button '.table$' Help 0
1037 procedure write_help_text .table$ .label$
1038 call findLabel '.table$' '.label$'
1039 .row = findLabel.row
1040 select Table '.table$'
1043 call findLabel '.table$' Help
1044 .row = findLabel.row
1045 select Table '.table$'
1047 .helpText$ = Get value... '.row' Helptext
1048 .helpKey$ = Get value... '.row' Key
1049 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1050 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1051 if index_regex(.helpKey$, "\S")
1052 .helpText$ = .helpText$+" ("+.helpKey$+")"
1055 .leftX = Get value... '.row' LeftX
1056 .rightX = Get value... '.row' RightX
1057 .lowY = Get value... '.row' LowY
1058 .highY = Get value... '.row' HighY
1061 .currentHelpFontSize = defaultFontSize
1062 call set_font_size '.currentHelpFontSize'
1063 .helpTextSize = demo Text width (wc)... '.helpText$'
1067 .htXright = .htXleft + .helpTextSize + 5
1071 .htXleft = .htXright - .helpTextSize - 5
1076 .htYhigh = .htYlow + 7
1081 .htYlow = .htYhigh - 7
1086 # Adapt font size to horizontal dimensions
1088 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1089 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1090 if .htXleft < 0 or .htXright > 100
1092 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1094 call set_font_size '.currentHelpFontSize'
1096 # Adapt vertical dimensions to font height
1097 call points_to_wc '.currentHelpFontSize'
1098 .lineHeight = points_to_wc.wc
1099 if .lineHeight > .htYhigh - .htYlow - 4
1100 .htYhigh = .htYlow + .lineHeight + 4
1103 # Determine arrow endpoints
1105 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1108 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1109 .xend = (.htXleft+.htXright)/2
1112 .xtext = .htXleft + 2
1113 .ytext = .htYlow + 1
1116 .mm2wc = demo Horizontal mm to wc... 1
1117 .lineWidth = 2/.mm2wc
1118 demo Line width... '.lineWidth'
1119 demo Arrow size... '.lineWidth'
1120 demo Colour... 'sgc2.popUp_bordercolor$'
1121 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1122 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1123 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1124 demo Line width... 'defaultLineWidth'
1125 demo Arrow size... 1
1127 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1129 call set_font_size 'defaultFontSize'
1133 procedure write_help_title .table$
1134 # Set help text title
1136 call findLabel '.table$' Help
1137 .row = findLabel.row
1138 select Table '.table$'
1139 .helpTitle$ = Get value... '.row' Helptext
1140 .helpKey$ = Get value... '.row' Key
1141 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1142 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1143 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1146 .helpTitleFontSize = 14
1147 # Adapt size of button to length of text
1149 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1150 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1151 call set_font_size '.helpTitleFontSize'
1154 demo Select inner viewport... 0 100 0 100
1155 demo Axes... 0 100 0 100
1156 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1157 call set_font_size 'defaultFontSize'
1161 ###############################################################
1163 # Miscelaneous procedures
1165 ###############################################################
1166 procedure printPageToPrinter
1168 demo Print... 'printerName$' 'printerPresets$'
1172 procedure getOpenFile .openDialogue$
1175 call convert_praat_to_latin1 '.openDialogue$'
1176 .openDialogue$ = convert_praat_to_latin1.text$
1177 .filename$ = chooseReadFile$ (.openDialogue$)
1179 if .filename$ <> "" and fileReadable(.filename$)
1180 .tmp = nocheck Read from file... '.filename$'
1181 if .tmp !- undefined and .tmp > 0
1182 call log_fileOpen '.filename$'
1184 # Get only the filename
1185 .startName = rindex_regex(.filename$, "[/\\:]") + 1
1186 .nameLength = rindex(.filename$, ".") - .startName
1187 currentSoundName$ = mid$(.filename$, .startName, .nameLength)
1193 Create Sound from formula... Speech Mono 0 1 44100 0
1195 recordedSound$ = selected$("Sound")
1196 te.recordedSound = selected("Sound")
1197 currentStartTime = 0
1198 currentEndTime = Get total duration
1199 # Reset selected window
1200 selectedStartTime = currentStartTime
1201 selectedEndTime = currentEndTime
1204 procedure points_to_wc .points
1205 .mm = .points * 0.3527777778
1206 .wc = demo Vertical mm to wc... '.mm'
1209 procedure reset_viewport
1210 .low = viewportMargin
1211 .high = 100 - viewportMargin
1212 demo Select inner viewport... '.low' '.high' '.low' '.high'
1213 demo Axes... 0 100 0 100
1216 procedure set_font_size .fontSize
1218 demo Font size... '.fontSize'
1222 procedure wipeArea .areaCommand$
1227 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1229 call set_font_size '.currentFontSize'
1230 .textWidth = demo Text width (wc)... '.text$'
1231 while .textWidth > .maxWidth and .currentFontSize > 2
1232 .currentFontSize -= 0.5
1233 call set_font_size '.currentFontSize'
1234 .textWidth = demo Text width (wc)... '.text$'
1236 .diff = .textWidth - .maxWidth
1237 .newFontSize = .currentFontSize
1241 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1243 .radians = .rotation/360 * 2 * pi
1244 .horWC = demo Horizontal mm to wc... 10.0
1245 .verWC = demo Vertical mm to wc... 10.0
1247 .verCoeff = .verWC / .horWC
1251 call set_font_size '.currentFontSize'
1252 .textLength = demo Text width (wc)... '.text$'
1253 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1254 .currentFontSize -= 0.5
1255 call set_font_size '.currentFontSize'
1256 .textLength = demo Text width (wc)... '.text$'
1258 .diff = .textLength - .maxHeight
1259 .newFontSize = .currentFontSize
1263 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1265 call points_to_wc '.currentFontSize'
1266 .lineHeight = points_to_wc.wc
1267 while .lineHeight > .maxHeight and .currentFontSize > 2
1268 .currentFontSize -= 0.5
1269 call points_to_wc '.currentFontSize'
1270 .lineHeight = points_to_wc.wc
1272 .diff = .lineHeight - .maxHeight
1273 .newFontSize = .currentFontSize
1277 # Load a table with button info etc.
1278 # Load local tables if present. Else load
1279 # build-in scripted tables
1280 procedure loadTable .tableName$
1281 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1282 # Search for the table in local, preference, and global directories
1283 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1284 Read from file... 'localTableDir$'/'.tableName$'.Table
1285 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1286 Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1287 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1288 Read from file... 'globaltablelists$'/'.tableName$'.Table
1289 # Load them from script
1290 elsif variableExists("procCreate'.tableVariableName$'$")
1291 call Create'.tableVariableName$'
1293 call write_text_popup 'defaultFont$' 14 '.tableName$' cannot be found
1295 exit '.tableName$' cannot be found
1299 procedure testLoadTable .tableName$
1301 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1302 # Search for the table in local, preference, and global directories
1303 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1305 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1307 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1309 # Load them from script
1310 elsif variableExists("procCreate'.tableVariableName$'$")
1317 procedure checkTable .tableName$
1319 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1321 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1323 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1325 # Load them from script
1326 elsif variableExists("procCreate'.tableName$'$")
1333 # Create a pop-up window with text from a Text Table
1334 procedure write_text_table .table$
1341 # Get table with text and longest line
1343 call testLoadTable '.table$'
1344 if testLoadTable.table > 0
1345 call loadTable '.table$'
1346 .instructionText = selected()
1347 .numLines = Get number of rows
1349 .instructionFontSize = 14
1350 .referenceText$ = ""
1356 select '.instructionText'
1357 .currentText$ = Get value... '.l' text
1358 # Expand variables, eg, 'praatVersion$'
1359 call expand_praat_variables '.currentText$'
1360 .currentText$ = expand_praat_variables.text$
1362 .font$ = Get value... '.l' font
1363 .fontSize = Get value... '.l' size
1364 call set_font_size '.fontSize'
1365 .textWidth = demo Text width (wc)... '.currentText$'
1366 if .fontSize > .maxFontSize
1367 .maxFontSize = .fontSize
1369 if .textWidth > .maxWidth
1370 .maxWidth = .textWidth
1371 .instructionFontSize = .fontSize
1375 select '.instructionText'
1376 .referenceText$ = Get value... '.maxLine' text
1377 .maxLineFont$ = Get value... '.maxLine' font
1378 .instructionFontSize = Get value... '.maxLine' size
1379 call set_font_size '.maxFontSize'
1381 # Adapt size of button to length of text
1382 .maxWidth = (.xright - .xleft) - 4
1383 .origFontSize = .instructionFontSize
1384 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1385 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1386 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1387 if adjustFontSizeOnWidth.diff > 0
1388 .xright += adjustFontSizeOnWidth.diff/4
1389 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1391 call set_font_size '.instructionFontSize'
1392 .fontSizeFactor = .instructionFontSize / .origFontSize
1394 .numRows = Get number of rows
1395 # Calculate length from number of lines.
1397 .midY = .yhigh - (.yhigh - .ylow)/2
1398 .yhigh = .midY + (.numRows+1) * .dy / 2
1399 .ylow = .yhigh - (.numRows+1) * .dy
1400 .textleft = .xleft + 2
1402 demo Line width... 8
1403 demo Colour... 'sgc2.popUp_bordercolor$'
1404 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1405 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1406 demo Line width... 'defaultLineWidth'
1408 .ytext = .yhigh - 2 - .dy
1410 select '.instructionText'
1411 .font$ = Get value... '.i' font
1412 .fontSize = Get value... '.i' size
1413 .font$ = extractWord$(.font$, "")
1415 .fontSize = floor(.fontSize*.fontSizeFactor)
1419 .line$ = Get value... '.i' text
1420 # Expand variables, eg, 'praatVersion$'
1421 call expand_praat_variables '.line$'
1422 .line$ = expand_praat_variables.text$
1425 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1429 call set_font_size 'defaultFontSize'
1431 select '.instructionText'
1434 label ESCAPEwrite_text_table
1438 # Create a pop-up window with text from an existing Table object
1439 procedure write_tabbed_table .table$ .labelTextTable$
1446 # Get table with text and longest line
1447 call testLoadTable '.table$'
1448 if testLoadTable.table <= 0
1449 call loadTable '.labelTextTable$'
1450 .labelText$ = selected$("Table")
1453 select Table '.table$'
1454 .tabbedText = selected()
1455 .numLines = Get number of rows
1456 .numCols = Get number of columns
1457 .font$ = defaultFont$
1458 .fontSize = defaultFontSize
1460 .widthCanvas = .xright - .xleft
1461 .dx = (.widthCanvas - 4) / (.numCols)
1465 call set_font_size '.fontSize'
1467 for .i from 0 to .numLines
1468 .xtext = .xleft + .dx / 2
1470 select '.tabbedText'
1471 .currentLabel$ = Get column label... '.j'
1473 .line$ = Get value... '.i' '.currentLabel$'
1475 .line$ = .currentLabel$
1476 select Table '.labelText$'
1477 call findLabel '.labelText$' '.line$'
1478 select Table '.labelText$'
1479 .line$ = Get value... 'findLabel.row' Text
1481 # Expand variables, eg, 'praatVersion$'
1482 call expand_praat_variables '.line$'
1483 .line$ = expand_praat_variables.text$
1484 .textWidth = demo Text width (wc)... '.line$'
1485 if .textWidth > .maxWidth
1486 .maxWidth = .textWidth
1490 if .dx > 1.2 * .maxWidth
1491 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1492 .xleft = 50 - .widthCanvas / 2
1493 .xright = 50 + .widthCanvas / 2
1494 .dx = (.widthCanvas - 4) / (.numCols)
1499 # Calculate length from number of lines.
1500 .dy = .lineHeight + 0.5
1501 .midY = .yhigh - (.yhigh - .ylow)/2
1502 .yhigh = .midY + (.numLines+2) * .dy / 2
1503 .ylow = .yhigh - (.numLines+2) * .dy
1504 .textleft = .xleft + 2
1506 demo Line width... 8
1507 demo Colour... 'sgc2.popUp_bordercolor$'
1508 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1509 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1510 demo Line width... 'defaultLineWidth'
1512 .ytext = .yhigh - 2 - .dy
1513 # First the column names, then the items
1514 for .i from 0 to .numLines
1515 .xtext = .textleft + .dx / 2
1517 select '.tabbedText'
1518 .currentLabel$ = Get column label... '.j'
1520 .line$ = Get value... '.i' '.currentLabel$'
1522 .line$ = .currentLabel$
1523 select Table '.labelText$'
1524 call findLabel '.labelText$' '.line$'
1525 select Table '.labelText$'
1526 .line$ = Get value... 'findLabel.row' Text
1528 # Expand variables, eg, 'praatVersion$'
1529 call expand_praat_variables '.line$'
1530 .line$ = expand_praat_variables.text$
1531 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1532 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1535 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1541 call set_font_size 'defaultFontSize'
1542 select Table '.labelText$'
1545 label ESCAPEwrite_tabbed_table
1548 # Create a pop-up window with a given text
1549 procedure write_text_popup .font$ .size .text$
1556 # Adapt size of button to length of text
1557 .maxWidth = (.xright - .xleft) - 4
1558 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1559 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1560 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1561 if adjustFontSizeOnWidth.diff > 0
1562 .xright += adjustFontSizeOnWidth.diff/4
1563 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1565 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1566 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1570 # Calculate length from number of lines.
1572 .midY = .yhigh - (.yhigh - .ylow)/2
1573 .yhigh = .midY + (.numRows+1) * .dy / 2
1574 .ylow = .yhigh - (.numRows+1) * .dy
1575 .textleft = .xleft + 2
1576 .xmid = (.textleft + .xright - 2)/2
1578 demo Line width... 8
1579 demo Colour... 'sgc2.popUp_bordercolor$'
1580 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1581 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1582 demo Line width... 'defaultLineWidth'
1584 .ytext = .yhigh - 2 - .dy
1586 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1590 call set_font_size 'defaultFontSize'
1593 # Write the background from a Text Table
1594 procedure draw_background .table$
1600 .defaultColour$ = "{0.9,0.9,0.9}"
1601 .defaultAlign$ = "centre"
1603 # Get table with text and longest line
1604 call loadTable '.table$'
1605 .backgroundText = selected()
1606 .numLines = Get number of rows
1607 .backgroundFontSize = 28
1608 .referenceText$ = ""
1615 select '.backgroundText'
1616 .currentText$ = Get value... '.l' text
1617 # Expand variables, eg, 'praatVersion$'
1618 call expand_praat_variables '.currentText$'
1619 .currentText$ = expand_praat_variables.text$
1621 .font$ = Get value... '.l' font
1622 .fontSize = Get value... '.l' size
1623 if .fontSize > .maxFontSize
1624 .maxFontSize = .fontSize
1626 if not startsWith(.font$, "!")
1627 call set_font_size '.fontSize'
1628 .textWidth = demo Text width (wc)... '.currentText$'
1629 if .textWidth > .maxWidth
1630 .maxWidth = .textWidth
1631 .backgroundFontSize = .fontSize
1639 select '.backgroundText'
1640 .referenceText$ = Get value... '.maxLine' text
1641 .maxLineFont$ = Get value... '.maxLine' font
1642 .backgroundFontSize = Get value... '.maxLine' size
1643 .backgroundFontColour$ = Get value... '.maxLine' colour
1644 call set_font_size '.maxFontSize'
1646 .maxFontSize = .backgroundFontSize
1649 # Adapt size of button to length of text
1650 .maxWidth = (.xright - .xleft) - 4
1651 .origFontSize = .backgroundFontSize
1652 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1653 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1654 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1655 call set_font_size '.backgroundFontSize'
1657 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1658 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1659 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1660 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1661 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1662 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1665 .numRows = Get number of rows
1666 # Calculate length from number of lines.
1668 .midY = .yhigh - (.yhigh - .ylow)/2
1669 .yhigh = .midY + (.textLines+1) * .dy / 2
1670 .ylow = .yhigh - (.textLines+1) * .dy
1671 .textleft = .xleft + 2
1672 .textright = .xright - 2
1673 .textmid = (.xright - .xleft)/2
1676 .ytext = .yhigh - 2 - .dy
1678 select '.backgroundText'
1679 .font$ = Get value... '.i' font
1680 .fontSize = Get value... '.i' size
1681 .fontColour$ = Get value... '.i' colour
1682 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1683 .fontAlign$ = Get value... '.i' align
1684 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1685 .line$ = Get value... '.i' text
1686 # Expand variables, eg, 'praatVersion$'
1687 call expand_praat_variables '.line$'
1688 .line$ = expand_praat_variables.text$
1691 .fontSize = floor(.fontSize*.fontSizeFactor)
1692 if not startsWith(.font$, "!")
1693 .font$ = extractWord$(.font$, "")
1695 if .fontAlign$ = "centre"
1697 elsif .fontAlign$ = "right"
1706 demo Colour... '.fontColour$'
1707 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1709 elsif .font$ = "!demo command"
1710 demo Colour... '.fontColour$'
1711 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1712 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1713 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1714 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1715 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1716 while index(.line$, "[[")
1717 .nextBracketOpen = index(.line$, "[[")
1718 .nextBracketOpen += 2
1719 .nextBracketClose = index(.line$, "]]")
1720 .bracketLength = .nextBracketClose - .nextBracketOpen
1722 if .bracketLength > 0
1723 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1724 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1725 if length(.expression$) > 0
1726 # Test expression for security, only allow explicitely defined functions
1727 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1728 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1729 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1730 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1731 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1732 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1733 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1734 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1735 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1736 if .testExpression$ = ""
1737 .calc = '.expression$'
1738 .result$ = "'.calc'"
1743 # Replace expression by result
1744 .lastLeft = .nextBracketOpen - 3
1745 .newLine$ = left$(.line$, .lastLeft)
1746 .newLine$ = .newLine$ + .result$
1747 .numCopy = length(.line$) - .nextBracketClose - 1
1748 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1756 call set_font_size 'defaultFontSize'
1758 select '.backgroundText'
1762 procedure convert_praat_to_utf8 .text$
1763 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1764 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1765 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1766 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1767 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1768 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1769 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1770 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1771 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1772 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1773 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1774 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1775 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1776 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1779 procedure convert_praat_to_latin1 .text$
1780 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1781 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1782 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1783 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1784 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1785 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1786 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1787 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1788 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1789 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1790 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1791 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1792 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1793 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1794 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1797 # Expand 'variable$' into the value of variable$.
1798 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1799 # Single quotes can be protected by \'
1800 procedure expand_praat_variables .text$
1801 if index(.text$, "'")
1802 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1803 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1804 .tempText$ = """"+.tempText$+""""
1805 # Check whether all the variables actually exist. Ignore any variable that does not exist
1806 .checkVars$ = .tempText$
1807 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1808 .start = index(.checkVars$, "+")
1809 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1810 .end = index(.checkVars$, "+")
1812 .variable$ = left$(.checkVars$, .end - 1)
1813 if not variableExists(.variable$)
1814 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1816 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1821 .text$ = '.tempText$'
1825 # Get a time stamp in normalized format
1826 procedure getTimeStamp
1827 .currentDateTime$ = date$()
1828 .string$ = replace_regex$(.currentDateTime$, "[A-Z][a-z]+\s+([A-Z][a-z]+)\s+(\d+)\s+(\d+)\W(\d+)\W(\d+)\s+(\d+)$", "\6-\1-\2T\3-\4-\5", 0)
1831 # A table error, can be insiduously caused by an outdate preferences file!
1832 procedure emergency_table_exit .message$
1833 # If you come here as a user, your preferences file is borked
1834 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
1835 deleteFile(preferencesAppFile$)
1840 # Remove previous files from system
1841 procedure clean_up_sound
1842 if recordedSound$ = ""
1843 te.recordedSound = 0
1845 if te.recordedSound > 0
1846 select te.recordedSound
1849 te.recordedSound = 0
1851 if te.recordedPitch > 0
1852 select te.recordedPitch
1854 te.recordedPitch = 0
1858 # Safely read a table
1859 procedure readTable .filename$
1861 if .filename$ <> "" and fileReadable(.filename$) and index_regex(.filename$, "(?i\.(tsv|table|csv))$") > 0
1862 .tableID = nocheck Read from file... '.filename$'
1863 if .tableID = undefined or .tableID <= 0
1866 .fullName$ = selected$ ()
1867 .type$ = extractWord$(.fullName$, "")
1868 if .type$ <> "Table"
1876 # Read feedback table and get keyed text
1877 procedure get_feedback_text .language$ .key$
1878 if not endsWith(feedbackTableName$, "_'.language$'")
1879 if feedbackTableName$ <> ""
1880 select Table 'feedbackTableName$'
1883 call loadTable 'feedbackTablePrefix$'_'.language$'
1884 feedbackTableName$ = selected$("Table")
1886 call findKey 'feedbackTableName$' '.key$'
1888 select Table 'feedbackTableName$'
1889 .text$ = Get value... '.row' Text
1890 # Expand variables, eg, 'praatVersion$'
1891 call expand_praat_variables '.text$'
1892 .text$ = expand_praat_variables.text$