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"
43 samplingFrequency = 44100
46 # Pop-Up window colors
47 sgc2.popUp_bordercolor$ = "{0.5,0.5,1}"
48 sgc2.popUp_backgroundcolor$ = "{0.9,0.9,1}"
50 # If running in a packed script binary
51 if index_regex(preferencesDirectory$, "(?i'sgc2.demoAppName$')$")
52 preferencesAppDir$ = preferencesDirectory$
53 elsif index_regex(preferencesDirectory$, "[pP]raat(\-dir| Prefs)?$")
54 # If running as a Praat script, create a new preferences directory
56 preferencesAppDir$ = "'preferencesDirectory$'/../.'sgc2.demoAppName$'"
58 preferencesAppDir$ = "'preferencesDirectory$'/../'sgc2.demoAppName$'"
61 # It has to go somewhere. Make a subdirectory in the current preferences directory
62 preferencesAppDir$ = "'preferencesDirectory$'/'sgc2.demoAppName$'"
66 # Parameters for isolating recorded speech from noise
67 # Should be mostly left alone unless you are using ultra clean
68 # or very noisy recordings
74 # Set up button height
80 defaultFont$ = "Helvetica"
86 # Load supporting scripts
87 # Load tables in script format
88 include CreateTables.praat
89 include CreateWordlists.praat
90 # Set up system and load preferences
91 include InitialiseSGC2.praat
92 # Include the main page buttons and procedures
93 include MainPage.praat
94 # Include the configuration page buttons and procedures
97 # Start instruction loop
98 while demoWaitForInput()
106 call buttonClicked 'buttons$' '.clickX' '.clickY'
107 .label$ = buttonClicked.label$
108 elsif demoKeyPressed()
109 .pressed$ = demoKey$()
110 call keyPressed 'buttons$' '.pressed$'
111 .label$ = keyPressed.label$
114 # You cannot select a text field
115 if startsWith(.label$, "$")
122 call Draw_button 'buttons$' '.label$' 1
123 call process_label '.label$' '.clickX' '.clickY' '.pressed$'
125 call Draw_button 'buttons$' '.label$' 0
132 ########################################################
134 # Definitions of procedures
136 ########################################################
139 procedure process_label .label$ .clickX .clickY .pressed$
140 # Log raw commands to replay in file
141 call log_command 'buttons$' '.label$' '.clickX' '.clickY' '.pressed$'
143 # Prcoess the command
144 if .label$ <> "" and not startsWith(.label$,"!")
145 .label$ = replace$(.label$, "_", " ", 0)
146 call process'buttons$''.label$' '.clickX' '.clickY' '.pressed$'
151 procedure init_buttons
153 call Draw_all_buttons 'buttons$'
159 procedure Draw_all_buttons .table$
160 .varPrefix$ = replace_regex$(.table$, "^(.)", "\l\1", 0)
161 select Table '.table$'
162 .numRows = Get number of rows
165 .label$ = Get value... '.row' Label
166 if not startsWith(.label$, "!")
168 # Determine the "pressed" state of a button
169 # A variable with the same name as the button will act as a
171 .variableName$ = .varPrefix$+"."+(replace_regex$(.label$, "^(.)", "\l\1", 0))
172 # Simple boolean vairables
173 if index(.variableName$, "_") <= 0 and variableExists(.variableName$)
175 if '.variableName$' > 0
178 elsif '.variableName$' < 0
181 # Complex buttons with an variableName+'_'+value structure
182 # varableName$ -> name of button, e.g., "language"
183 elsif index(.variableName$, "_")
184 .generalVar$ = left$(.variableName$, rindex(.variableName$, "_") - 1)
185 .currentVariableName$ = .generalVar$
187 if variableExists(.generalVar$+"$")
188 .currentVariableName$ = .generalVar$ + "$"
190 # Remove one level of indirection
191 if variableExists(.currentVariableName$)
192 if index(.currentVariableName$, "$")
193 .currentVariableName$ = '.currentVariableName$'
195 .currentValue = '.currentVariableName$'
196 .currentVariableName$ = "'.currentValue'"
198 # Remove next level of indirection
199 .currentContent$ = "'.currentVariableName$'"
200 if .currentContent$ = "_DISABLED_"
203 # Reconstruct label from current values
204 .currentLabelValue$ = .generalVar$ + "_" + .currentContent$
205 # Set PRESSED from label
206 if .variableName$ = .currentLabelValue$
211 # You did erase everything before you started here? So do not do that again
212 call Draw_button_internal 0 '.table$' '.label$' '.pressed'
217 # Draw a button from a predefined button table
218 # Normally, erase the area around a button
219 procedure Draw_button .table$ .label$ .push
220 call Draw_button_internal 1 '.table$' '.label$' '.push'
223 # Use this function if you want to control erasing
224 procedure Draw_button_internal .erase_button_area .table$ .label$ .push
225 # Scale rounding of rounded rectangles
227 .mm = demo Horizontal wc to mm... '.wc'
228 # Allow to overide ! skip directive
230 if startsWith(.label$, "+")
231 .label$ = right$(.label$, length(.label$)-1)
235 select Table '.table$'
236 .row = Search column... Label '.label$'
238 call emergency_table_exit Button Table '.table$' does not have a row with label '.label$'
241 # Perspective shift sizes
251 # Set drawing parameters
252 .topBackGroundColorUp$ = "{0.93,0.93,0.93}"
253 .topLineColorUp$ = "Black"
254 .topLineWidthUp = 1.5
255 .topBackGroundColorDown$ = "{0.89,0.89,0.94}"
256 .topLineColorDown$ = "{0.3,0.3,0.3}"
257 .topLineWidthDown = 1.5
258 .topBackGroundColorDisabled$ = "{0.85,0.85,0.85}"
259 .topLineColorDisabled$ = "{0.70,0.70,0.70}"
260 .topLineWidthDisabled = 1.5
261 .flankBackGroundColorUp$ = "{0.6,0.6,0.6}"
262 .flankLineColorUp$ = "{0.2,0.2,0.2}"
263 .flankLineWidthUp = 1.5
264 .flankBackGroundColorDown$ = "{0.75,0.75,0.75}"
265 .flankLineColorDown$ = .flankLineColorUp$
266 .flankLineWidthDown = 1.5
267 .buttonFontSize = defaultFontSize
270 .leftX = Get value... '.row' LeftX
271 .rightX = Get value... '.row' RightX
272 .lowY = Get value... '.row' LowY
273 .highY = Get value... '.row' HighY
274 .buttonText$ = Get value... '.row' Text
275 .buttonColor$ = Get value... '.row' Color
276 .buttonDraw$ = Get value... '.row' Draw
277 .buttonKey$ = Get value... '.row' Key
280 if index_regex(.buttonText$, "^![0-9\.]+!")
281 .rotation = extractNumber(.buttonText$, "!")
282 .buttonText$ = replace_regex$(.buttonText$, "^![0-9\.]+!", "", 0)
285 goto NOBUTTON startsWith(.label$, "!") and not .forceDraw
287 # Replace button text with ALERT
289 .buttonText$ = alertText$
292 # Adapt font size to button size
293 .maxWidth = (.rightX - .leftX) - 2
294 .maxHeight = (.highY - .lowY) - 1
296 # Adapt size of button to length of text if necessary
297 call adjustFontSizeOnWidth 'defaultFont$' '.buttonFontSize' '.maxWidth' '.buttonText$'
298 .buttonFontSize = adjustFontSizeOnWidth.newFontSize
299 if adjustFontSizeOnWidth.diff > 0
300 .rightX += adjustFontSizeOnWidth.diff/2
301 .leftX -= adjustFontSizeOnWidth.diff/2
303 call set_font_size '.buttonFontSize'
305 # Adapt size of button to length of text
306 call adjustFontSizeOnHeight 'defaultFont$' '.buttonFontSize' '.maxHeight'
307 if adjustFontSizeOnHeight.diff > 0
308 .lowY -= adjustFontSizeOnHeight.diff/2
309 .highY += adjustFontSizeOnHeight.diff/2
311 .buttonFontSize = adjustFontSizeOnHeight.newFontSize
313 # With non-horizontal text, only change font size
314 call adjustRotatedFontSizeOnBox 'defaultFont$' '.buttonFontSize' '.maxWidth' '.maxHeight' '.rotation' '.buttonText$'
315 .buttonFontSize = adjustRotatedFontSizeOnBox.newFontSize
318 # Reset and erase button area
320 demo Line width... 'defaultLineWidth'
321 .shiftLeftX = .leftX - .shiftX
322 .shiftRightX = .rightX
323 .shiftLowY = .lowY - .shiftY
325 if .erase_button_area
326 # Make erase area minutely larger
327 .eraseLeft = .shiftLeftX - 0.01
328 .eraseRight = .shiftRightX + 0.01
329 .eraseBottom = .shiftLowY - 0.01
330 .eraseTop = .shiftHighY + 0.01
331 demo Paint rectangle... White .eraseLeft .eraseRight .eraseBottom .eraseTop
334 # If label starts with "$", it is a text field. Then do not draw the button
335 if not startsWith(.label$, "$")
336 # Give some depth to button: Draw flank outline
337 if .shiftDown or .shiftX or .shiftY
339 demo Paint rounded rectangle... '.flankBackGroundColorUp$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
340 demo Colour... '.flankLineColorUp$'
341 demo Line width... '.flankLineWidthUp'
343 demo Paint rounded rectangle... '.flankBackGroundColorDown$' .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
344 demo Colour... '.flankLineColorDown$'
345 demo Line width... '.flankLineWidthDown'
347 demo Draw rounded rectangle... .shiftLeftX .shiftRightX .shiftLowY .shiftHighY '.mm'
350 # Button Down will shift the top perspective
352 # Draw the button top
354 demo Paint rounded rectangle... '.topBackGroundColorUp$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
355 demo Colour... '.topLineColorUp$'
356 demo Line width... '.topLineWidthUp'
358 demo Paint rounded rectangle... '.topBackGroundColorDisabled$' '.leftX' '.rightX' '.lowY' '.highY' '.mm'
359 demo Colour... '.topLineColorDisabled$'
360 demo Line width... '.topLineWidthDisabled'
364 .rightX -= .shiftDown
368 demo Paint rounded rectangle... '.topBackGroundColorDown$' .leftX .rightX .lowY .highY '.mm'
369 demo Colour... '.topLineColorDown$'
370 demo Line width... '.topLineWidthDown'
372 demo Draw rounded rectangle... '.leftX' '.rightX' '.lowY' '.highY' '.mm'
375 # The button text and symbol
376 .horWC = demo Horizontal mm to wc... 10.0
377 .verWC = demo Vertical mm to wc... 10.0
379 .verCoeff = .horWC / .verWC
384 .centerX = (.leftX + .rightX)/2
385 .centerY = .lowY + 0.6*(.highY-.lowY)
386 .radius = min(.verCoeff * (.highY - .lowY ), (.rightX - .leftX))/3
387 .buttonKey$ = replace$(.buttonKey$, "\", "\\", 0)
388 .buttonKey$ = replace$(.buttonKey$, """", "\""""", 0)
389 .newText$ = replace_regex$(.buttonText$, "['.buttonKey$']", "#%&", 1)
391 .newText$ = .buttonText$
393 if .push = 1 or .push = -1
395 if .buttonColor$ = "Red"
396 .buttonColor$ = "Pink"
397 elsif .buttonColor$ = "Blue"
398 .buttonColor$ = "{0.5,0.5,1}"
400 .buttonColor$ = "Grey"
403 .buttonColor$ = "Maroon"
408 call '.buttonDraw$' '.buttonColor$' '.centerX' '.centerY' '.radius'
409 call set_font_size '.buttonFontSize'
410 demo Colour... '.buttonColor$'
413 .verticalAlignment$ = "Bottom"
415 .anchorY = .lowY + 0.5*(.highY-.lowY)
416 .verticalAlignment$ = "Half"
418 demo Text special... '.centerX' Centre '.anchorY' '.verticalAlignment$' 'defaultFont$' '.buttonFontSize' '.rotation' '.newText$'
422 call set_font_size 'defaultFontSize'
424 demo Line width... 'defaultLineWidth'
429 procedure set_window_title .table$ .addedText$
430 select Table '.table$'
431 .row = Search column... Label !WindowTitle
433 call emergency_table_exit Button Table '.table$' does not have a row with label !WindowTitle
435 .windowText$ = Get value... '.row' Text
436 call convert_praat_to_latin1 '.windowText$'
437 .windowText$ = convert_praat_to_latin1.text$
439 demoWindowTitle(.windowText$+ .addedText$)
442 # Handle language setting
443 procedure processLanguageCodes .table$ .label$
445 call Draw_button 'config$' Language_'config.language$' 0
446 call Draw_button 'config$' '.label$' 2
447 # Someone might have to use more than 2 chars for the language code
448 .numChars = length(.label$) - length("Language_")
449 .lang$ = right$(.label$, .numChars)
451 call set_language '.lang$'
455 procedure set_language .lang$
459 select Table 'buttons$'
464 select Table 'config$'
470 call checkTable 'buttonsTableName$'_'.lang$'
471 if checkTable.available
472 config.language$ = .lang$
474 config.language$ = "EN"
477 # Load buttons tables
478 call loadTable 'buttonsTableName$'
479 buttons$ = selected$("Table")
480 Append column... Text
482 Append column... Helptext
483 .numLabels = Get number of rows
484 call loadTable 'buttonsTableName$'_'config.language$'
485 .buttonsLang$ = selected$("Table")
486 for .row to .numLabels
487 select Table 'buttons$'
488 .label$ = Get value... '.row' Label
489 call findLabel '.buttonsLang$' '.label$'
491 select Table '.buttonsLang$'
492 .valueText$ = Get value... 'findLabel.row' Text
493 .valueKey$ = Get value... 'findLabel.row' Key
494 .valueHelp$ = Get value... 'findLabel.row' Helptext
495 select Table 'buttons$'
496 Set string value... '.row' Text '.valueText$'
497 Set string value... '.row' Key '.valueKey$'
498 Set string value... '.row' Helptext '.valueHelp$'
499 elsif index(.label$, "_")
500 # Load alternative language table
501 .startChar = rindex(.label$, "_")
502 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
503 call loadTable 'buttonsTableName$'_'.otherLanguage$'
504 .otherbuttonsLang$ = selected$("Table")
505 call findLabel '.otherbuttonsLang$' '.label$'
507 select Table '.buttonsLang$'
508 .valueText$ = Get value... 'findLabel.row' Text
509 .valueKey$ = Get value... 'findLabel.row' Key
510 .valueHelp$ = Get value... 'findLabel.row' Helptext
511 select Table 'buttons$'
512 Set string value... '.row' Text '.valueText$'
513 Set string value... '.row' Key '.valueKey$'
514 Set string value... '.row' Helptext '.valueHelp$'
516 call emergency_table_exit Cannot find Label: '.otherbuttonsLang$' '.label$'
518 select Table '.otherbuttonsLang$'
521 call emergency_table_exit Cannot find Label: '.buttonsLang$' '.label$'
524 select Table '.buttonsLang$'
527 # Load configuration table
528 call loadTable 'configTableName$'
529 config$ = selected$("Table")
530 Append column... Text
532 Append column... Helptext
533 .numLabels = Get number of rows
534 call loadTable 'configTableName$'_'config.language$'
535 .configLang$ = selected$("Table")
536 for .row to .numLabels
537 select Table 'config$'
538 .label$ = Get value... '.row' Label
539 call findLabel '.configLang$' '.label$'
541 select Table '.configLang$'
542 .valueText$ = Get value... 'findLabel.row' Text
543 .valueKey$ = Get value... 'findLabel.row' Key
544 .valueHelp$ = Get value... 'findLabel.row' Helptext
545 select Table 'config$'
546 Set string value... '.row' Text '.valueText$'
547 Set string value... '.row' Key '.valueKey$'
548 Set string value... '.row' Helptext '.valueHelp$'
549 elsif index(.label$, "_")
550 .startChar = rindex(.label$, "_")
551 .otherLanguage$ = right$(.label$, length(.label$) - .startChar)
552 call loadTable 'configTableName$'_'.otherLanguage$'
553 .otherconfigLang$ = selected$("Table")
554 call findLabel '.otherconfigLang$' '.label$'
556 select Table '.otherconfigLang$'
557 .valueText$ = Get value... 'findLabel.row' Text
558 .valueKey$ = Get value... 'findLabel.row' Key
559 .valueHelp$ = Get value... 'findLabel.row' Helptext
560 select Table 'config$'
561 Set string value... '.row' Text '.valueText$'
562 Set string value... '.row' Key '.valueKey$'
563 Set string value... '.row' Helptext '.valueHelp$'
565 call emergency_table_exit Cannot find Label: '.otherconfigLang$' '.label$'
567 select Table '.otherconfigLang$'
570 call emergency_table_exit Cannot find Label: '.configLang$' '.label$'
573 select Table '.configLang$'
576 # Make language change visible
578 call Draw_config_page
583 ###############################################################
585 # Button Drawing Routines
587 ###############################################################
589 # A stub for buttons that do not have a drawing routine (yet)
590 procedure DrawNull .color$ .x .y .size
593 procedure DrawHelp .color$ .x .y .size
594 .currentFontSize = 24
597 call adjustFontSizeOnHeight 'defaultFont$' '.currentFontSize' '.maxHeight'
598 .currentFontSize = adjustFontSizeOnHeight.currentFontSize
599 call set_font_size '.currentFontSize'
600 demo Colour... '.color$'
601 demo Text... '.x' Centre '.y' Bottom ?
602 call set_font_size 'defaultFontSize'
605 ###############################################################
607 # Button Processing Routines
609 ###############################################################
611 # Search row in table on label
612 procedure findKey .table$ .label$
614 select Table '.table$'
615 .to$ = selected$("Table")
617 .numRows = Get number of rows
619 .currentKey$ = '.to$'$[.i, "Key"]
620 if .label$ = .currentKey$
626 if .row <= 0 and index(.label$, "_") <= 0
627 printline "'.label$'" is not a key in '.table$'
631 procedure findLabel .table$ .label$
633 select Table '.table$'
634 .to$ = selected$("Table")
636 .numRows = Get number of rows
638 .currentKey$ = '.to$'$[.i, "Label"]
639 if .label$ = .currentKey$
645 if .row <= 0 and index(.label$, "_") <= 0
646 call emergency_table_exit "'.label$'" is not a key in '.table$'
651 procedure buttonClicked table$ .x .y
653 select Table 'table$'
654 .bo$ = selected$("Table")
656 .numRows = Get number of rows
659 .leftX = '.bo$'[.i, "LeftX"]
660 .rightX = '.bo$'[.i, "RightX"]
661 .lowY = '.bo$'[.i, "LowY"]
662 .highY = '.bo$'[.i, "HighY"]
663 if .x > .leftX and .x < .rightX and .y > .lowY and .y < .highY
664 .label$ = '.bo$'$[.i, "Label"]
670 procedure keyPressed table$ .pressed$
673 if .pressed$ = "" and not demoShiftKeyPressed()
676 .lowerPressed$ = replace_regex$(.pressed$, ".", "\L&", 0)
677 .upperPressed$ = replace_regex$(.pressed$, ".", "\U&", 0)
678 select Table 'table$'
679 .bo$ = selected$("Table")
681 .numRows = Get number of rows
684 .key$ = '.bo$'$[.i, "Key"]
685 if index(.key$, .lowerPressed$) or index(.key$, .upperPressed$)
686 .label$ = '.bo$'$[.i, "Label"]
693 procedure play_sound .sound$
695 select Sound '.sound$'
700 procedure record_sound
701 if recordedSound$ != ""
702 select Sound 'recordedSound$'
706 if sgc2.alignedTextGrid > 0
707 select sgc2.alignedTextGrid
709 sgc2.alignedTextGrid = -1
712 # There is a very nasty delay before the first recording starts, do a dummy record
713 if not variableExists("recordingInitialized")
714 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 0.1
716 recordingInitialized = 1
719 demo Paint circle... Red 5 95 2
721 # In Windows interaction between demoWaitForInput and Record Sound blocks drawing the feedback
722 if windows and endsWith(build_SHA$, " XP")
723 # Display a pause window to flush the graphics buffer
724 beginPause ("DESTROY WINDOW ")
726 endPause ("DESTROY WINDOW ", 1)
728 demo Paint circle... Red 5 95 2
731 noprogress nowarn Record Sound (fixed time)... 'config.input$' 0.99 0.5 'samplingFrequency' 'recordingTime'
732 demo Paint circle... White 5 95 2.5
733 call wipeArea 'wipeFeedbackArea$'
735 # Feedback on recording level
736 .extremum = Get absolute extremum... 0 0 None
737 .radius = 2 * .extremum
746 elsif .extremum >= 0.49
749 .green = .extremum / 0.5
751 .color$ = "{'.red','.green','.blue'}"
752 demo Colour... '.color$'
754 demo Draw circle... 5 95 '.radius'
758 demo Line width... 'defaultLineWidth'
762 Rename... Pronunciation
763 recordedSound$ = selected$("Sound")
766 select Sound 'recordedSound$'
768 # Cut out real sound from silences/noise
769 call sound_detection 'recordedSound$' 'soundMargin'
770 select Sound 'recordedSound$'
774 # Select real sound from recording
775 # Uses some global variable
776 procedure sound_detection .sound$ .margin
777 select Sound '.sound$'
778 .soundlength = Get total duration
779 .internalSilence = 2*.margin
781 # Silence and remove noise, DANGEROUS
782 To TextGrid (silences)... 'minimumPitch' 0 'noiseThresshold' '.internalSilence' 0.1 silent sounding
783 Rename... Input'.sound$'
785 select TextGrid Input'.sound$'
786 .numberofIntervals = Get number of intervals... 1
787 if .numberofIntervals < 2
788 .numberofIntervals = 0
791 # Remove buzzing and other obnoxious sounds (if switched on)
792 for .i from 1 to .numberofIntervals
793 select TextGrid Input'.sound$'
794 .value$ = Get label of interval... 1 '.i'
795 .begintime = Get starting point... 1 '.i'
796 .endtime = Get end point... 1 '.i'
799 if .value$ = "silent"
800 select Sound '.sound$'
801 Set part to zero... '.begintime' '.endtime' at nearest zero crossing
805 # Select target sound
806 .maximumIntensity = -1
808 for i from 1 to .numberofIntervals
809 select TextGrid Input'.sound$'
811 .value$ = Get label of interval... 1 'i'
812 .begintime = Get starting point... 1 'i'
813 .endtime = Get end point... 1 'i'
815 if .value$ != "silent"
816 if .begintime > .margin
817 .begintime -= .margin
821 if .endtime + .margin < .soundlength
824 .endtime = .soundlength
827 select Sound '.sound$'
828 Extract part... '.begintime' '.endtime' Rectangular 1.0 no
829 Rename... Tmp'.sound$'
831 .newIntensity = Get intensity (dB)
832 if .newIntensity > .maximumIntensity
833 if .maximumIntensity > 0
834 select Sound New'.sound$'
837 select Sound Tmp'.sound$'
838 Rename... New'.sound$'
839 .maximumIntensity = .newIntensity
841 select Sound Tmp'.sound$'
847 if .maximumIntensity > minimumIntensity
848 select Sound '.sound$'
850 select Sound New'.sound$'
852 elsif .maximumIntensity > -1
853 select Sound New'.sound$'
856 select TextGrid Input'.sound$'
860 procedure end_program
861 call write_preferences ""
868 ######################################################
872 ######################################################
873 procedure config_page
875 demoWindowTitle("Speak Good Chinese: Change settings")
877 call Draw_config_page
879 while (.label$ <> "Return") and demoWaitForInput()
887 call buttonClicked 'config$' '.clickX' '.clickY'
888 .label$ = buttonClicked.label$
889 elsif demoKeyPressed()
890 .pressed$ = demoKey$()
891 call keyPressed 'config$' '.pressed$'
892 .label$ = keyPressed.label$
895 # You cannot select a text field
896 if startsWith(.label$, "$")
902 # Handle push button in process_config
903 call process_config '.label$' '.clickX' '.clickY' '.pressed$'
906 if .label$ = "Return"
916 procedure Draw_config_page
919 if config.showBackground
920 call draw_background Background
923 call Draw_all_buttons 'config$'
924 call set_window_title 'config$'
925 # Set correct buttons (alert)
926 call setConfigMainPage
930 procedure process_config .label$ .clickX .clickY .pressed$
931 if .label$ = "!Logging"
932 config.logPerformance = not config.logPerformance
933 .displayButton = config.logPerformance
934 call Draw_button 'config$' +'.label$' '.displayButton'
935 if config.logPerformance
938 elsif .label$ <> "" and not startsWith(.label$,"!")
939 .label$ = replace$(.label$, "_", " ", 0)
940 call process'config$''.label$' '.clickX' '.clickY' '.pressed$'
944 ###############################################################
946 # Presenting help texts
948 ###############################################################
951 procedure help_loop .table$ .redrawProc$
953 call write_help_title '.table$'
956 call Draw_button '.table$' Help 2
958 while (.label$ <> "Help") and demoWaitForInput()
963 call buttonClicked '.table$' '.clickX' '.clickY'
964 .label$ = buttonClicked.label$
965 elsif demoKeyPressed()
966 .pressed$ = demoKey$()
967 call keyPressed '.table$' '.pressed$'
968 .label$ = keyPressed.label$
971 if .label$ != "" and .label$ <> "Help"
979 call Draw_button '.table$' Help 2
980 call write_help_title '.table$'
982 # Handle push button in process_config
983 call write_help_text '.table$' '.label$'
989 call Draw_button '.table$' Help 0
995 procedure write_help_text .table$ .label$
996 call findLabel '.table$' '.label$'
998 select Table '.table$'
1001 call findLabel '.table$' Help
1002 .row = findLabel.row
1003 select Table '.table$'
1005 .helpText$ = Get value... '.row' Helptext
1006 .helpKey$ = Get value... '.row' Key
1007 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1008 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1009 if index_regex(.helpKey$, "\S")
1010 .helpText$ = .helpText$+" ("+.helpKey$+")"
1013 .leftX = Get value... '.row' LeftX
1014 .rightX = Get value... '.row' RightX
1015 .lowY = Get value... '.row' LowY
1016 .highY = Get value... '.row' HighY
1019 .currentHelpFontSize = defaultFontSize
1020 call set_font_size '.currentHelpFontSize'
1021 .helpTextSize = demo Text width (wc)... '.helpText$'
1025 .htXright = .htXleft + .helpTextSize + 5
1029 .htXleft = .htXright - .helpTextSize - 5
1034 .htYhigh = .htYlow + 7
1039 .htYlow = .htYhigh - 7
1044 # Adapt font size to horizontal dimensions
1046 call adjustFontSizeOnWidth 'defaultFont$' '.currentHelpFontSize' '.maxWidth' '.helpText$'
1047 .currentHelpFontSize = adjustFontSizeOnWidth.newFontSize
1048 if .htXleft < 0 or .htXright > 100
1050 .htXright = .htXleft + adjustFontSizeOnWidth.textWidth + 5
1052 call set_font_size '.currentHelpFontSize'
1054 # Adapt vertical dimensions to font height
1055 call points_to_wc '.currentHelpFontSize'
1056 .lineHeight = points_to_wc.wc
1057 if .lineHeight > .htYhigh - .htYlow - 4
1058 .htYhigh = .htYlow + .lineHeight + 4
1061 # Determine arrow endpoints
1063 if abs(.htXleft - .xstart) > abs(.htXright - .xstart)
1066 if abs((.htXleft+.htXright)/2 - .xstart) < min(abs(.htXright - .xstart),abs(.htXleft - .xstart))
1067 .xend = (.htXleft+.htXright)/2
1070 .xtext = .htXleft + 2
1071 .ytext = .htYlow + 1
1074 .mm2wc = demo Horizontal mm to wc... 1
1075 .lineWidth = 2/.mm2wc
1076 demo Line width... '.lineWidth'
1077 demo Arrow size... '.lineWidth'
1078 demo Colour... 'sgc2.popUp_bordercolor$'
1079 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1080 demo Draw rectangle... '.htXleft' '.htXright' '.htYlow' '.htYhigh'
1081 demo Draw arrow... '.xstart' '.ystart' '.xend' '.yend'
1082 demo Line width... 'defaultLineWidth'
1083 demo Arrow size... 1
1085 demo Text... '.xtext' Left '.ytext' Bottom '.helpText$'
1087 call set_font_size 'defaultFontSize'
1091 procedure write_help_title .table$
1092 # Set help text title
1094 call findLabel '.table$' Help
1095 .row = findLabel.row
1096 select Table '.table$'
1097 .helpTitle$ = Get value... '.row' Helptext
1098 .helpKey$ = Get value... '.row' Key
1099 .helpKey$ = replace$(.helpKey$, "\", "", 0)
1100 .helpKey$ = replace$(.helpKey$, "_", "\_ ", 0)
1101 .helpTitle$ = .helpTitle$+" ("+.helpKey$+")"
1104 .helpTitleFontSize = 14
1105 # Adapt size of button to length of text
1107 call adjustFontSizeOnWidth 'defaultFont$' '.helpTitleFontSize' '.maxWidth' '.helpTitle$'
1108 .helpTitleFontSize = adjustFontSizeOnWidth.newFontSize
1109 call set_font_size '.helpTitleFontSize'
1112 demo Select inner viewport... 0 100 0 100
1113 demo Axes... 0 100 0 100
1114 demo Text... 50 Centre '.helpTop' Top '.helpTitle$'
1115 call set_font_size 'defaultFontSize'
1119 ###############################################################
1121 # Miscelaneous procedures
1123 ###############################################################
1124 procedure printPageToPrinter
1126 demo Print... 'printerName$' 'printerPresets$'
1130 procedure getOpenFile .openDialogue$
1131 call convert_praat_to_latin1 '.openDialogue$'
1132 .openDialogue$ = convert_praat_to_latin1.text$
1133 .filename$ = chooseReadFile$ (.openDialogue$)
1134 if .filename$ <> "" and fileReadable(.filename$)
1135 Read from file... '.filename$'
1136 call log_fileOpen '.filename$'
1138 # Get only the filename
1139 .startName = rindex_regex(.filename$, "[/\\:]") + 1
1140 .nameLength = rindex(.filename$, ".") - .startName
1141 currentSoundName$ = mid$(.filename$, .startName, .nameLength)
1143 Create Sound from formula... Speech Mono 0 1 44100 0
1145 recordedSound$ = selected$("Sound")
1146 currentStartTime = 0
1147 currentEndTime = Get total duration
1148 # Reset selected window
1149 selectedStartTime = currentStartTime
1150 selectedEndTime = currentEndTime
1153 procedure points_to_wc .points
1154 .mm = .points * 0.3527777778
1155 .wc = demo Vertical mm to wc... '.mm'
1158 procedure reset_viewport
1159 .low = viewportMargin
1160 .high = 100 - viewportMargin
1161 demo Select inner viewport... '.low' '.high' '.low' '.high'
1162 demo Axes... 0 100 0 100
1165 procedure set_font_size .fontSize
1167 demo Font size... '.fontSize'
1171 procedure wipeArea .areaCommand$
1176 procedure adjustFontSizeOnWidth .font$ .currentFontSize .maxWidth .text$
1178 call set_font_size '.currentFontSize'
1179 .textWidth = demo Text width (wc)... '.text$'
1180 while .textWidth > .maxWidth and .currentFontSize > 2
1181 .currentFontSize -= 0.5
1182 call set_font_size '.currentFontSize'
1183 .textWidth = demo Text width (wc)... '.text$'
1185 .diff = .textWidth - .maxWidth
1186 .newFontSize = .currentFontSize
1190 procedure adjustRotatedFontSizeOnBox .font$ .currentFontSize .maxWidth .maxHeight .rotation .text$
1192 .radians = .rotation/360 * 2 * pi
1193 .horWC = demo Horizontal mm to wc... 10.0
1194 .verWC = demo Vertical mm to wc... 10.0
1196 .verCoeff = .verWC / .horWC
1200 call set_font_size '.currentFontSize'
1201 .textLength = demo Text width (wc)... '.text$'
1202 while (.textLength * .verCoeff * sin(.radians) > .maxHeight or .textLength * cos(.radians) > .maxWidth) and .currentFontSize > 2
1203 .currentFontSize -= 0.5
1204 call set_font_size '.currentFontSize'
1205 .textLength = demo Text width (wc)... '.text$'
1207 .diff = .textLength - .maxHeight
1208 .newFontSize = .currentFontSize
1212 procedure adjustFontSizeOnHeight .font$ .currentFontSize .maxHeight
1214 call points_to_wc '.currentFontSize'
1215 .lineHeight = points_to_wc.wc
1216 while .lineHeight > .maxHeight and .currentFontSize > 2
1217 .currentFontSize -= 0.5
1218 call points_to_wc '.currentFontSize'
1219 .lineHeight = points_to_wc.wc
1221 .diff = .lineHeight - .maxHeight
1222 .newFontSize = .currentFontSize
1226 # Load a table with button info etc.
1227 # Load local tables if present. Else load
1228 # build-in scripted tables
1229 procedure loadTable .tableName$
1230 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1231 # Search for the table in local, preference, and global directories
1232 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1233 Read from file... 'localTableDir$'/'.tableName$'.Table
1234 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1235 Read from file... 'preferencesTableDir$'/'.tableName$'.Table
1236 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1237 Read from file... 'globaltablelists$'/'.tableName$'.Table
1238 # Load them from script
1239 elsif variableExists("procCreate'.tableVariableName$'$")
1240 call Create'.tableVariableName$'
1242 call write_text_popup Helvetica 14 '.tableName$' cannot be found
1244 exit '.tableName$' cannot be found
1248 procedure testLoadTable .tableName$
1250 .tableVariableName$ = replace_regex$(.tableName$, "[^\w]", "_", 0);
1251 # Search for the table in local, preference, and global directories
1252 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1254 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1256 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1258 # Load them from script
1259 elsif variableExists("procCreate'.tableVariableName$'$")
1266 procedure checkTable .tableName$
1268 if fileReadable("'localTableDir$'/'.tableName$'.Table")
1270 elsif fileReadable("'preferencesTableDir$'/'.tableName$'.Table")
1272 elsif fileReadable("'globaltablelists$'/'.tableName$'.Table")
1274 # Load them from script
1275 elsif variableExists("procCreate'.tableName$'$")
1282 # Create a pop-up window with text from a Text Table
1283 procedure write_text_table .table$
1290 # Get table with text and longest line
1292 call testLoadTable '.table$'
1293 if testLoadTable.table > 0
1294 call loadTable '.table$'
1295 .instructionText = selected()
1296 .numLines = Get number of rows
1298 .instructionFontSize = 14
1299 .referenceText$ = ""
1305 select '.instructionText'
1306 .currentText$ = Get value... '.l' text
1307 # Expand variables, eg, 'praatVersion$'
1308 call expand_praat_variables '.currentText$'
1309 .currentText$ = expand_praat_variables.text$
1311 .font$ = Get value... '.l' font
1312 .fontSize = Get value... '.l' size
1313 call set_font_size '.fontSize'
1314 .textWidth = demo Text width (wc)... '.currentText$'
1315 if .fontSize > .maxFontSize
1316 .maxFontSize = .fontSize
1318 if .textWidth > .maxWidth
1319 .maxWidth = .textWidth
1320 .instructionFontSize = .fontSize
1324 select '.instructionText'
1325 .referenceText$ = Get value... '.maxLine' text
1326 .maxLineFont$ = Get value... '.maxLine' font
1327 .instructionFontSize = Get value... '.maxLine' size
1328 call set_font_size '.maxFontSize'
1330 # Adapt size of button to length of text
1331 .maxWidth = (.xright - .xleft) - 4
1332 .origFontSize = .instructionFontSize
1333 call adjustFontSizeOnWidth 'defaultFont$' '.instructionFontSize' '.maxWidth' '.referenceText$'
1334 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1335 .instructionFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1336 if adjustFontSizeOnWidth.diff > 0
1337 .xright += adjustFontSizeOnWidth.diff/4
1338 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1340 call set_font_size '.instructionFontSize'
1341 .fontSizeFactor = .instructionFontSize / .origFontSize
1343 .numRows = Get number of rows
1344 # Calculate length from number of lines.
1346 .midY = .yhigh - (.yhigh - .ylow)/2
1347 .yhigh = .midY + (.numRows+1) * .dy / 2
1348 .ylow = .yhigh - (.numRows+1) * .dy
1349 .textleft = .xleft + 2
1351 demo Line width... 8
1352 demo Colour... 'sgc2.popUp_bordercolor$'
1353 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1354 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1355 demo Line width... 'defaultLineWidth'
1357 .ytext = .yhigh - 2 - .dy
1359 select '.instructionText'
1360 .font$ = Get value... '.i' font
1361 .fontSize = Get value... '.i' size
1362 .font$ = extractWord$(.font$, "")
1364 .fontSize = floor(.fontSize*.fontSizeFactor)
1368 .line$ = Get value... '.i' text
1369 # Expand variables, eg, 'praatVersion$'
1370 call expand_praat_variables '.line$'
1371 .line$ = expand_praat_variables.text$
1374 demo Text special... '.textleft' Left '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1378 call set_font_size 'defaultFontSize'
1380 select '.instructionText'
1383 label ESCAPEwrite_text_table
1387 # Create a pop-up window with text from an existing Table object
1388 procedure write_tabbed_table .table$ .labelTextTable$
1395 # Get table with text and longest line
1396 call testLoadTable '.table$'
1397 if testLoadTable.table <= 0
1398 call loadTable '.labelTextTable$'
1399 .labelText$ = selected$("Table")
1402 select Table '.table$'
1403 .tabbedText = selected()
1404 .numLines = Get number of rows
1405 .numCols = Get number of columns
1406 .font$ = defaultFont$
1407 .fontSize = defaultFontSize
1409 .widthCanvas = .xright - .xleft
1410 .dx = (.widthCanvas - 4) / (.numCols)
1414 call set_font_size '.fontSize'
1416 for .i from 0 to .numLines
1417 .xtext = .xleft + .dx / 2
1419 select '.tabbedText'
1420 .currentLabel$ = Get column label... '.j'
1422 .line$ = Get value... '.i' '.currentLabel$'
1424 .line$ = .currentLabel$
1425 select Table '.labelText$'
1426 call findLabel '.labelText$' '.line$'
1427 select Table '.labelText$'
1428 .line$ = Get value... 'findLabel.row' Text
1430 # Expand variables, eg, 'praatVersion$'
1431 call expand_praat_variables '.line$'
1432 .line$ = expand_praat_variables.text$
1433 .textWidth = demo Text width (wc)... '.line$'
1434 if .textWidth > .maxWidth
1435 .maxWidth = .textWidth
1439 if .dx > 1.2 * .maxWidth
1440 .widthCanvas = 1.2 * .maxWidth * .numCols + 4
1441 .xleft = 50 - .widthCanvas / 2
1442 .xright = 50 + .widthCanvas / 2
1443 .dx = (.widthCanvas - 4) / (.numCols)
1448 # Calculate length from number of lines.
1449 .dy = .lineHeight + 0.5
1450 .midY = .yhigh - (.yhigh - .ylow)/2
1451 .yhigh = .midY + (.numLines+2) * .dy / 2
1452 .ylow = .yhigh - (.numLines+2) * .dy
1453 .textleft = .xleft + 2
1455 demo Line width... 8
1456 demo Colour... 'sgc2.popUp_bordercolor$'
1457 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1458 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1459 demo Line width... 'defaultLineWidth'
1461 .ytext = .yhigh - 2 - .dy
1462 # First the column names, then the items
1463 for .i from 0 to .numLines
1464 .xtext = .textleft + .dx / 2
1466 select '.tabbedText'
1467 .currentLabel$ = Get column label... '.j'
1469 .line$ = Get value... '.i' '.currentLabel$'
1471 .line$ = .currentLabel$
1472 select Table '.labelText$'
1473 call findLabel '.labelText$' '.line$'
1474 select Table '.labelText$'
1475 .line$ = Get value... 'findLabel.row' Text
1477 # Expand variables, eg, 'praatVersion$'
1478 call expand_praat_variables '.line$'
1479 .line$ = expand_praat_variables.text$
1480 call adjustFontSizeOnWidth '.font$' '.fontSize' '.maxWidth' '.line$'
1481 .currentFontSize = adjustFontSizeOnWidth.newFontSize
1484 demo Text special... '.xtext' Centre '.ytext' Bottom '.font$' '.currentFontSize' 0 '.line$'
1490 call set_font_size 'defaultFontSize'
1491 select Table '.labelText$'
1494 label ESCAPEwrite_tabbed_table
1497 # Create a pop-up window with a given text
1498 procedure write_text_popup .font$ .size .text$
1505 # Adapt size of button to length of text
1506 .maxWidth = (.xright - .xleft) - 4
1507 call adjustFontSizeOnWidth 'defaultFont$' '.size' '.maxWidth' '.text$'
1508 call adjustFontSizeOnHeight 'defaultFont$' '.size' '.lineHeight'
1509 .popupFontSize = min(adjustFontSizeOnWidth.newFontSize, adjustFontSizeOnHeight.newFontSize)
1510 if adjustFontSizeOnWidth.diff > 0
1511 .xright += adjustFontSizeOnWidth.diff/4
1512 .xleft -= 3*adjustFontSizeOnWidth.diff/4
1514 .xleft = ((.xright + .xleft) - adjustFontSizeOnWidth.textWidth)/2 - 2
1515 .xright = ((.xright + .xleft) + adjustFontSizeOnWidth.textWidth)/2 + 2
1519 # Calculate length from number of lines.
1521 .midY = .yhigh - (.yhigh - .ylow)/2
1522 .yhigh = .midY + (.numRows+1) * .dy / 2
1523 .ylow = .yhigh - (.numRows+1) * .dy
1524 .textleft = .xleft + 2
1525 .xmid = (.textleft + .xright - 2)/2
1527 demo Line width... 8
1528 demo Colour... 'sgc2.popUp_bordercolor$'
1529 demo Paint rectangle... 'sgc2.popUp_backgroundcolor$' '.xleft' '.xright' '.ylow' '.yhigh'
1530 demo Draw rectangle... '.xleft' '.xright' '.ylow' '.yhigh'
1531 demo Line width... 'defaultLineWidth'
1533 .ytext = .yhigh - 2 - .dy
1535 demo Text special... '.xmid' Centre '.ytext' Bottom '.font$' '.popupFontSize' 0 '.text$'
1539 call set_font_size 'defaultFontSize'
1542 # Write the background from a Text Table
1543 procedure draw_background .table$
1549 .defaultColour$ = "{0.9,0.9,0.9}"
1550 .defaultAlign$ = "centre"
1552 # Get table with text and longest line
1553 call loadTable '.table$'
1554 .backgroundText = selected()
1555 .numLines = Get number of rows
1556 .backgroundFontSize = 28
1557 .referenceText$ = ""
1564 select '.backgroundText'
1565 .currentText$ = Get value... '.l' text
1566 # Expand variables, eg, 'praatVersion$'
1567 call expand_praat_variables '.currentText$'
1568 .currentText$ = expand_praat_variables.text$
1570 .font$ = Get value... '.l' font
1571 .fontSize = Get value... '.l' size
1572 if .fontSize > .maxFontSize
1573 .maxFontSize = .fontSize
1575 if not startsWith(.font$, "!")
1576 call set_font_size '.fontSize'
1577 .textWidth = demo Text width (wc)... '.currentText$'
1578 if .textWidth > .maxWidth
1579 .maxWidth = .textWidth
1580 .backgroundFontSize = .fontSize
1588 select '.backgroundText'
1589 .referenceText$ = Get value... '.maxLine' text
1590 .maxLineFont$ = Get value... '.maxLine' font
1591 .backgroundFontSize = Get value... '.maxLine' size
1592 .backgroundFontColour$ = Get value... '.maxLine' colour
1593 call set_font_size '.maxFontSize'
1595 .maxFontSize = .backgroundFontSize
1598 # Adapt size of button to length of text
1599 .maxWidth = (.xright - .xleft) - 4
1600 .origFontSize = .backgroundFontSize
1601 call adjustFontSizeOnWidth 'defaultFont$' '.backgroundFontSize' '.maxWidth' '.referenceText$'
1602 .fontSizeFactor = adjustFontSizeOnWidth.newFontSize / .backgroundFontSize
1603 .backgroundFontSize = adjustFontSizeOnWidth.newFontSize
1604 call set_font_size '.backgroundFontSize'
1606 call adjustFontSizeOnHeight 'defaultFont$' '.backgroundFontSize' '.lineHeight'
1607 .lineHeight /= adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1608 if adjustFontSizeOnHeight.newFontSize >= .origFontSize and (.textLines+1) * .lineHeight > (.yhigh - .ylow - 4)
1609 .lineHeight = (.yhigh - .ylow - 4)/(.textLines + 1)
1610 call adjustFontSizeOnHeight 'defaultFont$' '.maxFontSize' '.lineHeight'
1611 .fontSizeFactor = adjustFontSizeOnHeight.newFontSize / .backgroundFontSize
1614 .numRows = Get number of rows
1615 # Calculate length from number of lines.
1617 .midY = .yhigh - (.yhigh - .ylow)/2
1618 .yhigh = .midY + (.textLines+1) * .dy / 2
1619 .ylow = .yhigh - (.textLines+1) * .dy
1620 .textleft = .xleft + 2
1621 .textright = .xright - 2
1622 .textmid = (.xright - .xleft)/2
1625 .ytext = .yhigh - 2 - .dy
1627 select '.backgroundText'
1628 .font$ = Get value... '.i' font
1629 .fontSize = Get value... '.i' size
1630 .fontColour$ = Get value... '.i' colour
1631 .fontColour$ = replace_regex$(.fontColour$, "^[\- ]$", ".defaultColour$", 1)
1632 .fontAlign$ = Get value... '.i' align
1633 .fontAlign$ = replace_regex$(.fontAlign$, "^[\- ]$", ".defaultAlign$", 1)
1634 .line$ = Get value... '.i' text
1635 # Expand variables, eg, 'praatVersion$'
1636 call expand_praat_variables '.line$'
1637 .line$ = expand_praat_variables.text$
1640 .fontSize = floor(.fontSize*.fontSizeFactor)
1641 if not startsWith(.font$, "!")
1642 .font$ = extractWord$(.font$, "")
1644 if .fontAlign$ = "centre"
1646 elsif .fontAlign$ = "right"
1655 demo Colour... '.fontColour$'
1656 demo Text special... '.xtext' '.fontAlign$' '.ytext' Bottom '.font$' '.fontSize' 0 '.line$'
1658 elsif .font$ = "!demo command"
1659 demo Colour... '.fontColour$'
1660 .line$ = replace_regex$(.line$, "\{FONTSIZE\$\}", "'.fontSize'", 0)
1661 .line$ = replace_regex$(.line$, "\{XTEXT\$\}", "'.xtext'", 0)
1662 .line$ = replace_regex$(.line$, "\{YTEXT\$\}", "'.ytext'", 0)
1663 .line$ = replace_regex$(.line$, "\{DY\$\}", "'.dy'", 0)
1664 .line$ = replace_regex$(.line$, "\{[^\}]*\}", "", 0)
1665 while index(.line$, "[[")
1666 .nextBracketOpen = index(.line$, "[[")
1667 .nextBracketOpen += 2
1668 .nextBracketClose = index(.line$, "]]")
1669 .bracketLength = .nextBracketClose - .nextBracketOpen
1671 if .bracketLength > 0
1672 .expression$ = mid$(.line$, .nextBracketOpen, .bracketLength)
1673 .expression$ = replace_regex$(.expression$, "\s", "", 0)
1674 if length(.expression$) > 0
1675 # Test expression for security, only allow explicitely defined functions
1676 .allowedStrings$ = "e|pi|not|and|or|div|mod|abs|round|floor|ceiling"
1677 .allowedStrings$ = .allowedStrings$ + "|sqrt|min|max|imin|imax|sin|cos|tan|arcsin|arccos|arctan|arctan2|sinc|sincpi"
1678 .allowedStrings$ = .allowedStrings$ + "|exp|ln|log10|log2|sinh|cosh|tanh|arcsinh|arccosh|arctanh"
1679 .allowedStrings$ = .allowedStrings$ + "|sigmoid|invSigmoid|erf|erfc|randomUniform|randomInteger|randomGauss|randomPoisson"
1680 .allowedStrings$ = .allowedStrings$ + "|lnGamma|gaussP|gaussQ|invGaussQ|chiSquareP|chiSquareQ"
1681 .allowedStrings$ = .allowedStrings$ + "|invChiSquareP|invChiSquareQ|studentP|studentQ|invStudentP|invStudentQ"
1682 .allowedStrings$ = .allowedStrings$ + "|beta|besselI|besselK"
1683 .testExpression$ = replace_regex$(.expression$, "(^|\W)('.allowedStrings$')(?=$|\W)", "\1\3", 0)
1684 .testExpression$ = replace_regex$(.testExpression$, "[0-9\.,\-+/*^()<>= ]", "", 0)
1685 if .testExpression$ = ""
1686 .calc = '.expression$'
1687 .result$ = "'.calc'"
1692 # Replace expression by result
1693 .lastLeft = .nextBracketOpen - 3
1694 .newLine$ = left$(.line$, .lastLeft)
1695 .newLine$ = .newLine$ + .result$
1696 .numCopy = length(.line$) - .nextBracketClose - 1
1697 .newLine$ = .newLine$ + right$(.line$, .numCopy)
1705 call set_font_size 'defaultFontSize'
1707 select '.backgroundText'
1711 procedure convert_praat_to_utf8 .text$
1712 .text$ = replace_regex$(.text$, "\\a""", "\xc3\xa4", 0)
1713 .text$ = replace_regex$(.text$, "\\A""", "\xc3\x84", 0)
1714 .text$ = replace_regex$(.text$, "\\o""", "\xc3\xb6", 0)
1715 .text$ = replace_regex$(.text$, "\\O""", "\xc3\x96", 0)
1716 .text$ = replace_regex$(.text$, "\\u""", "\xc3\xbc", 0)
1717 .text$ = replace_regex$(.text$, "\\U""", "\xc3\x9c", 0)
1718 .text$ = replace_regex$(.text$, "\\i""", "\xc3\xaf", 0)
1719 .text$ = replace_regex$(.text$, "\\I""", "\xc3\x8f", 0)
1720 .text$ = replace_regex$(.text$, "\\e""", "\xc3\xab", 0)
1721 .text$ = replace_regex$(.text$, "\\E""", "\xc3\x8b", 0)
1722 .text$ = replace_regex$(.text$, "\\y""", "\xc3\xbf", 0)
1723 .text$ = replace_regex$(.text$, "\\e'", "\xc3\xa9", 0)
1724 .text$ = replace_regex$(.text$, "\\E'", "\xc3\x89", 0)
1725 .text$ = replace_regex$(.text$, "\\ss", "\xc3\x9f", 0)
1728 procedure convert_praat_to_latin1 .text$
1729 .text$ = replace_regex$(.text$, "\\a""", "\xe4", 0)
1730 .text$ = replace_regex$(.text$, "\\A""", "\xc4", 0)
1731 .text$ = replace_regex$(.text$, "\\o""", "\xf6", 0)
1732 .text$ = replace_regex$(.text$, "\\O""", "\xd6", 0)
1733 .text$ = replace_regex$(.text$, "\\u""", "\xfc", 0)
1734 .text$ = replace_regex$(.text$, "\\U""", "\xdc", 0)
1735 .text$ = replace_regex$(.text$, "\\i""", "\xef", 0)
1736 .text$ = replace_regex$(.text$, "\\I""", "\xcf", 0)
1737 .text$ = replace_regex$(.text$, "\\e""", "\xeb", 0)
1738 .text$ = replace_regex$(.text$, "\\E""", "\xcb", 0)
1739 .text$ = replace_regex$(.text$, "\\y""", "\xff", 0)
1740 .text$ = replace_regex$(.text$, "\\Y""", "Y", 0)
1741 .text$ = replace_regex$(.text$, "\\e'", "\xe9", 0)
1742 .text$ = replace_regex$(.text$, "\\E'", "\xc9", 0)
1743 .text$ = replace_regex$(.text$, "\\ss", "\xdf", 0)
1746 # Expand 'variable$' into the value of variable$.
1747 # Eg, 'praatVersion$' becomes 5.1.45 or whatever is the current version
1748 # Single quotes can be protected by \'
1749 procedure expand_praat_variables .text$
1750 if index(.text$, "'")
1751 .tempText$ = replace_regex$(.text$, "(^|[^\\])'([\w\$\.]+)'", "\1""+\2+""", 0)
1752 .tempText$ = replace_regex$(.tempText$, "[\\]'", "'", 0)
1753 .tempText$ = """"+.tempText$+""""
1754 # Check whether all the variables actually exist. Ignore any variable that does not exist
1755 .checkVars$ = .tempText$
1756 while length(.checkVars$) > 0 and index(.checkVars$, "+")
1757 .start = index(.checkVars$, "+")
1758 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .start)
1759 .end = index(.checkVars$, "+")
1761 .variable$ = left$(.checkVars$, .end - 1)
1762 if not variableExists(.variable$)
1763 .tempText$ = replace$(.tempText$, """+'.variable$'+""", "'"+.variable$+"'", 0)
1765 .checkVars$ = right$(.checkVars$, length(.checkVars$) - .end)
1770 .text$ = '.tempText$'
1774 # Get a time stamp in normalized format
1775 procedure getTimeStamp
1776 .currentDateTime$ = date$()
1777 .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)
1780 # A table error, can be insiduously caused by an outdate preferences file!
1781 procedure emergency_table_exit .message$
1782 # If you come here as a user, your preferences file is borked
1783 if preferencesAppFile$ <> "" and fileReadable(preferencesAppFile$)
1784 deleteFile(preferencesAppFile$)